commit 6b8e9b74bd2343b26c73f41f61a34ebfd1b11a9d (HEAD, refs/remotes/origin/master) Author: Phillip Lord Date: Fri Nov 17 22:57:32 2017 +0000 Rebrand Uninstaller * admin/nt/dist-build/emacs.nsi: Add MUI_UNICON diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi index 492e4cd97d..8138272377 100644 --- a/admin/nt/dist-build/emacs.nsi +++ b/admin/nt/dist-build/emacs.nsi @@ -16,6 +16,7 @@ Var StartMenuFolder !define MUI_WELCOMEFINISHPAGE_BITMAP "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp" !define MUI_ICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico" +!define MUI_UNICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico" !insertmacro MUI_PAGE_WELCOME @@ -49,7 +50,6 @@ function .onInit ${Endif} ${EndIf} - MessageBox MB_OK "Installdir is $INSTDIR" functionend commit d20eab9831c920a1d0807bdc833a74185c4637b1 Author: Phillip Lord Date: Thu Nov 16 22:08:35 2017 +0000 Fix install location for windows installer diff --git a/admin/nt/dist-build/build-zips.sh b/admin/nt/dist-build/build-zips.sh index 138ef4d469..ce4a11dc1e 100755 --- a/admin/nt/dist-build/build-zips.sh +++ b/admin/nt/dist-build/build-zips.sh @@ -69,7 +69,9 @@ function build_installer { cd $HOME/emacs-build/install/emacs-$VERSION echo Calling makensis in `pwd` cp ../../git/$BRANCH/admin/nt/dist-build/emacs.nsi . - makensis -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ + + makensis -v4 \ + -DARCH=$ARCH -DEMACS_VERSION=$ACTUAL_VERSION \ -DOUT_VERSION=$VERSION emacs.nsi rm emacs.nsi mv Emacs-$ARCH-$VERSION-installer.exe ~/emacs-upload @@ -104,7 +106,7 @@ while getopts "36ghsiV:" opt; do GIT_UP=1 ;; i) - BUILD=1 + BUILD=0 ;; V) VERSION=$OPTARG @@ -117,6 +119,7 @@ while getopts "36ghsiV:" opt; do echo " -3 32 bit build only" echo " -6 64 bit build only" echo " -g git update and worktree only" + echo " -i build installer only" exit 0 ;; \?) diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi index ec33dc03da..492e4cd97d 100644 --- a/admin/nt/dist-build/emacs.nsi +++ b/admin/nt/dist-build/emacs.nsi @@ -1,14 +1,12 @@ !include MUI2.nsh - +!include LogicLib.nsh +!include x64.nsh Outfile "Emacs-${ARCH}-${OUT_VERSION}-installer.exe" - -InstallDir "$DESKTOP\Emacs-${EMACS_VERSION}" SetCompressor /solid lzma - Var StartMenuFolder @@ -36,6 +34,25 @@ Var StartMenuFolder !insertmacro MUI_LANGUAGE "English" Name Emacs-${EMACS_VERSION} +function .onInit + ${If} ${RunningX64} + ${If} ${ARCH} == "x86_64" + StrCpy $INSTDIR "$PROGRAMFILES64\Emacs" + ${Else} + StrCpy $INSTDIR "$PROGRAMFILES32\Emacs" + ${Endif} + ${Else} + ${If} ${ARCH} == "x86_64" + Quit + ${Else} + StrCpy $INSTDIR "$PROGRAMFILES\Emacs" + ${Endif} + ${EndIf} + + MessageBox MB_OK "Installdir is $INSTDIR" +functionend + + Section SetOutPath $INSTDIR commit 345c7d9c7b84c0c03ef1d0f32e9e0f39029be44a Author: Michael Albinus Date: Fri Nov 17 13:38:52 2017 +0100 ; * test/lisp/net/tramp-tests.el (tramp-test24-file-acl): Instrument test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 68236daf49..6d5cc5df8f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2942,14 +2942,23 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-acl tmp-name1)) (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions) (should (file-acl tmp-name2)) + (tramp--test-message + "tmp-name1:\n%stmp-name2:\n%s" + (file-acl tmp-name1) (file-acl tmp-name2)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) ;; Different permissions mean different ACLs. (set-file-modes tmp-name1 #o777) (set-file-modes tmp-name2 #o444) + (tramp--test-message + "tmp-name1:\n%stmp-name2:\n%s" + (file-acl tmp-name1) (file-acl tmp-name2)) (should-not (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) ;; Copy ACL. (should (set-file-acl tmp-name2 (file-acl tmp-name1))) + (tramp--test-message + "tmp-name1:\n%stmp-name2:\n%s" + (file-acl tmp-name1) (file-acl tmp-name2)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) ;; An invalid ACL does not harm. (should-not (set-file-acl tmp-name2 "foo"))) @@ -2968,28 +2977,46 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-acl tmp-name1)) (copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions) (should (file-acl tmp-name3)) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Different permissions mean different ACLs. (set-file-modes tmp-name1 #o777) (set-file-modes tmp-name3 #o444) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should-not (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Copy ACL. (set-file-acl tmp-name3 (file-acl tmp-name1)) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Two files with same ACLs. (delete-file tmp-name1) (copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions) (should (file-acl tmp-name1)) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Different permissions mean different ACLs. (set-file-modes tmp-name1 #o777) (set-file-modes tmp-name3 #o444) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should-not (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Copy ACL. (set-file-acl tmp-name1 (file-acl tmp-name3)) + (tramp--test-message + "tmp-name1:\n%stmp-name3:\n%s" + (file-acl tmp-name1) (file-acl tmp-name3)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3)))) ;; Cleanup. commit bc462efec89c3317a6ee3ef9404356c1c7e52bda Author: Phillip Lord Date: Mon Nov 13 23:00:12 2017 +0000 Rebrand Windows installer * admin/nt/dist-build/emacs.nsi: Use two icons. * etc/images/splash.bmp,etc/images/icons/hicolor/scalable/apps/emacs.ico: New files. diff --git a/admin/nt/dist-build/emacs.nsi b/admin/nt/dist-build/emacs.nsi index 947ac9ac18..ec33dc03da 100644 --- a/admin/nt/dist-build/emacs.nsi +++ b/admin/nt/dist-build/emacs.nsi @@ -17,6 +17,7 @@ Var StartMenuFolder !define MUI_WELCOMEPAGE_TEXT "Welcome to Emacs -- the editor of a lifetime." !define MUI_WELCOMEFINISHPAGE_BITMAP "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\splash.bmp" +!define MUI_ICON "${ARCH}\share\emacs\${EMACS_VERSION}\etc\images\icons\hicolor\scalable\apps\emacs.ico" !insertmacro MUI_PAGE_WELCOME diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.ico b/etc/images/icons/hicolor/scalable/apps/emacs.ico new file mode 100644 index 0000000000..7059127521 Binary files /dev/null and b/etc/images/icons/hicolor/scalable/apps/emacs.ico differ diff --git a/etc/images/splash.bmp b/etc/images/splash.bmp index 1e8332665e..3ec4c276d5 100644 Binary files a/etc/images/splash.bmp and b/etc/images/splash.bmp differ commit 52d822f31bc7cb57694c1e209b2d02e5efb8f48c Merge: 13248f7444 796c7f7a94 Author: Glenn Morris Date: Tue Nov 14 17:43:06 2017 -0500 Merge from origin/emacs-26 796c7f7 (origin/emacs-26) ; Fix last fix of 'mouse-drag-and-drop-region' 40d41dd (emacs-26) Fix Bug#28139 a5ec644 Fix Bug#29291 8b900e5 Fix Bug#2928 ff7bd84 Make 'mouse-drag-and-drop-region' work with 'mouse-autoselect... 0491de8 * etc/PROBLEMS: Remove fixed xterm-mouse-mode problems caa39f4 Fix cookie handling (bug#29282) 93304e3 Improve documentation of Edebug and macros commit 796c7f7a949c83d64ae37cadb9a0ca28a2f1823a Author: Martin Rudalics Date: Tue Nov 14 18:36:12 2017 +0100 ; Fix last fix of 'mouse-drag-and-drop-region' * lisp/mouse.el (mouse-drag-and-drop-region): Use 'car-safe' instead of 'car' to ignore 'select-window' events. Thanks to Stefan Monnier for spotting this. diff --git a/lisp/mouse.el b/lisp/mouse.el index 545a7ff2a0..17d1732e50 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2382,7 +2382,7 @@ is copied instead of being cut." (setq event (read-event)) (or (mouse-movement-p event) ;; Handle `mouse-autoselect-window'. - (eq (car event) 'select-window))) + (eq (car-safe event) 'select-window))) (unless value-selection ; initialization (delete-overlay mouse-secondary-overlay) (setq value-selection (buffer-substring start end)) commit 40d41dd4971a880b30b505e6f0da797048983954 Author: Daniel Pittman Date: Tue Nov 14 11:38:30 2017 +0100 Fix Bug#28139 * tramp-sh.el: Set TERM and INSIDE_EMACS environment earlier. (tramp-remote-process-environment): Remove TERM and INSIDE_EMACS. (tramp-remote-process-environment): Document their special handling. (tramp-open-shell): Set TERM and INSIDE_EMACS prior to starting the initial remote shell, so that it is also aware of the environment in which it is operating. (Bug#28139) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 52a6b8fac0..acb5a12ba2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -533,9 +533,7 @@ the list by the special value `tramp-own-remote-path'." ;;;###tramp-autoload (defcustom tramp-remote-process-environment - `("ENV=''" "TMOUT=0" "LC_CTYPE=''" - ,(format "TERM=%s" tramp-terminal-type) - ,(format "INSIDE_EMACS='%s,tramp:%s'" emacs-version tramp-version) + '("ENV=''" "TMOUT=0" "LC_CTYPE=''" "CDPATH=" "HISTORY=" "MAIL=" "MAILCHECK=" "MAILPATH=" "PAGER=cat" "autocorrect=" "correct=") "List of environment variables to be set on the remote host. @@ -544,8 +542,15 @@ Each element should be a string of the form ENVVARNAME=VALUE. An entry ENVVARNAME= disables the corresponding environment variable, which might have been set in the init files like ~/.profile. -Special handling is applied to the PATH environment, which should -not be set here. Instead, it should be set via `tramp-remote-path'." +Special handling is applied to some environment variables, +which should not be set here: + +The PATH environment variable should be set via `tramp-remote-path'. + +The TERM environment variable should be set via `tramp-terminal-type'. + +The INSIDE_EMACS environment variable will automatically be set +based on the TRAMP and Emacs versions, and should not be set here." :group 'tramp :version "26.1" :type '(repeat string) @@ -3948,9 +3953,17 @@ file exists and nonzero exit status otherwise." ;; file clobbering $PS1. $PROMPT_COMMAND is another way to set ;; the prompt in /bin/bash, it must be discarded as well. ;; $HISTFILE is set according to `tramp-histfile-override'. + ;; $TERM and $INSIDE_EMACS set here to ensure they have the + ;; correct values when the shell starts, not just processes + ;; run within the shell. (Which processes include our + ;; initial probes to ensure the remote shell is usable.) (tramp-send-command vec (format - "exec env ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s" + (concat + "exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' " + "ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s") + tramp-terminal-type + emacs-version tramp-version ; INSIDE_EMACS (or (getenv-internal "ENV" tramp-remote-process-environment) "") (if (stringp tramp-histfile-override) (format "HISTFILE=%s" commit a5ec644caa746092a9a1d002f565d4fb260f9567 Author: Michael Albinus Date: Tue Nov 14 10:38:41 2017 +0100 Fix Bug#29291 * test/lisp/net/tramp-tests.el (tramp-test24-file-acl): Preserve permissions when copying. (Bug#29291) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index a43ac73949..68236daf49 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2940,7 +2940,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-acl tmp-name1)) - (copy-file tmp-name1 tmp-name2) + (copy-file tmp-name1 tmp-name2 nil nil nil 'preserve-permissions) (should (file-acl tmp-name2)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name2))) ;; Different permissions mean different ACLs. @@ -2966,7 +2966,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-acl tmp-name1)) - (copy-file tmp-name1 tmp-name3) + (copy-file tmp-name1 tmp-name3 nil nil nil 'preserve-permissions) (should (file-acl tmp-name3)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Different permissions mean different ACLs. @@ -2980,7 +2980,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Two files with same ACLs. (delete-file tmp-name1) - (copy-file tmp-name3 tmp-name1) + (copy-file tmp-name3 tmp-name1 nil nil nil 'preserve-permissions) (should (file-acl tmp-name1)) (should (string-equal (file-acl tmp-name1) (file-acl tmp-name3))) ;; Different permissions mean different ACLs. commit 8b900e5ba2052898d98f7bd4ff3151389c10ab02 Author: Michael Albinus Date: Tue Nov 14 10:21:55 2017 +0100 Fix Bug#2928 * test/lisp/net/tramp-tests.el (tramp-test25-file-selinux): Enhance test. (Bug#29287) (tramp-test44-delay-load): Fix for older Emacsen. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7a7cf933fa..a43ac73949 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2921,6 +2921,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) +;; This test is inspired by Bug#29149. (ert-deftest tramp-test24-file-acl () "Check that `file-acl' and `set-file-acl' work proper." (skip-unless (tramp--test-enabled)) @@ -2995,8 +2996,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-file tmp-name1)) (ignore-errors (delete-file tmp-name3)))))) -;; TODO: This test didn't run in reality yet. Pls report if it -;; doesn't work as expected. (ert-deftest tramp-test25-file-selinux () "Check `file-selinux-context' and `set-file-selinux-context'." (skip-unless (tramp--test-enabled)) @@ -3013,7 +3012,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Both files are remote. (unwind-protect (progn - ;; Two files with same SELINUX context. + ;; Two files with same SELinux context. (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-selinux-context tmp-name1)) @@ -3023,14 +3022,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (equal (file-selinux-context tmp-name1) (file-selinux-context tmp-name2))) - ;; Different permissions mean different SELINUX context. - (set-file-modes tmp-name1 #o777) - (set-file-modes tmp-name2 #o444) - (should-not - (equal - (file-selinux-context tmp-name1) - (file-selinux-context tmp-name2))) - ;; Copy SELINUX context. + ;; Check different SELinux context. We cannot support + ;; different ranges in this test; let's assume the most + ;; likely one. + (let ((context (file-selinux-context tmp-name1))) + (when (and (string-equal (nth 3 context) "s0") + (setcar (nthcdr 3 context) "s0:c0") + (set-file-selinux-context tmp-name1 context)) + (should-not + (equal + (file-selinux-context tmp-name1) + (file-selinux-context tmp-name2))))) + ;; Copy SELinux context. (should (set-file-selinux-context tmp-name2 (file-selinux-context tmp-name1))) @@ -3038,7 +3041,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (equal (file-selinux-context tmp-name1) (file-selinux-context tmp-name2))) - ;; An invalid SELINUX context does not harm. + ;; An invalid SELinux context does not harm. (should-not (set-file-selinux-context tmp-name2 "foo"))) ;; Cleanup. @@ -3047,52 +3050,83 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Remote and local file. (unwind-protect - (when (not (or (equal (file-selinux-context temporary-file-directory) - '(nil nil nil nil)) - (tramp--test-windows-nt-or-smb-p))) - ;; Two files with same SELINUX context. + (when (and (not + (or (equal (file-selinux-context temporary-file-directory) + '(nil nil nil nil)) + (tramp--test-windows-nt-or-smb-p))) + ;; Both users shall use the same SELinux context. + (string-equal + (let ((default-directory temporary-file-directory)) + (shell-command-to-string "id -Z")) + (let ((default-directory + tramp-test-temporary-file-directory)) + (shell-command-to-string "id -Z")))) + + ;; Two files with same SELinux context. (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (should (file-selinux-context tmp-name1)) (copy-file tmp-name1 tmp-name3) (should (file-selinux-context tmp-name3)) + ;; We cannot expect that copying over file system + ;; boundaries keeps SELinux context. So we copy it + ;; explicitely. + (should + (set-file-selinux-context + tmp-name3 (file-selinux-context tmp-name1))) (should (equal (file-selinux-context tmp-name1) (file-selinux-context tmp-name3))) - ;; Different permissions mean different SELINUX context. - (set-file-modes tmp-name1 #o777) - (set-file-modes tmp-name3 #o444) - (should-not - (equal - (file-selinux-context tmp-name1) - (file-selinux-context tmp-name3))) - ;; Copy SELINUX context. - (set-file-selinux-context - tmp-name3 (file-selinux-context tmp-name1)) + ;; Check different SELinux context. We cannot support + ;; different ranges in this test; let's assume the most + ;; likely one. + (let ((context (file-selinux-context tmp-name1))) + (when (and (string-equal (nth 3 context) "s0") + (setcar (nthcdr 3 context) "s0:c0") + (set-file-selinux-context tmp-name1 context)) + (should-not + (equal + (file-selinux-context tmp-name1) + (file-selinux-context tmp-name3))))) + ;; Copy SELinux context. + (should + (set-file-selinux-context + tmp-name3 (file-selinux-context tmp-name1))) (should (equal (file-selinux-context tmp-name1) (file-selinux-context tmp-name3))) - ;; Two files with same SELINUX context. + ;; Two files with same SELinux context. (delete-file tmp-name1) (copy-file tmp-name3 tmp-name1) (should (file-selinux-context tmp-name1)) + ;; We cannot expect that copying over file system + ;; boundaries keeps SELinux context. So we copy it + ;; explicitely. + (should + (set-file-selinux-context + tmp-name1 (file-selinux-context tmp-name3))) (should (equal (file-selinux-context tmp-name1) (file-selinux-context tmp-name3))) - ;; Different permissions mean different SELINUX context. - (set-file-modes tmp-name1 #o777) - (set-file-modes tmp-name3 #o444) - (should-not - (equal - (file-selinux-context tmp-name1) - (file-selinux-context tmp-name3))) - ;; Copy SELINUX context. - (set-file-selinux-context - tmp-name1 (file-selinux-context tmp-name2)) + ;; Check different SELinux context. We cannot support + ;; different ranges in this test; let's assume the most + ;; likely one. + (let ((context (file-selinux-context tmp-name3))) + (when (and (string-equal (nth 3 context) "s0") + (setcar (nthcdr 3 context) "s0:c0") + (set-file-selinux-context tmp-name3 context)) + (should-not + (equal + (file-selinux-context tmp-name1) + (file-selinux-context tmp-name3))))) + ;; Copy SELinux context. + (should + (set-file-selinux-context + tmp-name1 (file-selinux-context tmp-name3))) (should (equal (file-selinux-context tmp-name1) @@ -3619,7 +3653,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (fboundp 'connection-local-set-profiles))) ;; `connection-local-set-profile-variables' and - ;; `connection-local-set-profiles' exist since Emacs 26. We don't + ;; `connection-local-set-profiles' exist since Emacs 26.1. We don't ;; want to see compiler warnings for older Emacsen. (let ((default-directory tramp-test-temporary-file-directory) explicit-shell-file-name kill-buffer-query-functions) @@ -3923,8 +3957,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory))) ;; `make-nearby-temp-file' and `temporary-file-directory' exists - ;; since Emacs 26. We don't want to see compiler warnings for older - ;; Emacsen. + ;; since Emacs 26.1. We don't want to see compiler warnings for + ;; older Emacsen. (let ((default-directory tramp-test-temporary-file-directory) tmp-file) ;; The remote host shall know a temporary file directory. @@ -4622,7 +4656,8 @@ process sentinels. They shall not disturb each other." (message \"Tramp loaded: %%s\" (featurep 'tramp)) \ (file-name-all-completions \"/foo:\" \"/\") \ (message \"Tramp loaded: %%s\" (featurep 'tramp)))")) - (dolist (tm '(t nil)) + ;; Tramp doesn't load when `tramp-mode' is nil since Emacs 26.1. + (dolist (tm (if (tramp--test-emacs26-p) '(t nil) '(nil))) (should (string-match (format commit ff7bd84b233888257b4b71214eb0a372168d0bae Author: Martin Rudalics Date: Tue Nov 14 10:09:24 2017 +0100 Make 'mouse-drag-and-drop-region' work with 'mouse-autoselect-window' non-nil * lisp/mouse.el (mouse-drag-and-drop-region): Ignore 'select-window' events to make it work with 'mouse-autoselect-window'. diff --git a/lisp/mouse.el b/lisp/mouse.el index 5eeee1ec52..545a7ff2a0 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -2380,7 +2380,9 @@ is copied instead of being cut." ;; When event was click instead of drag, skip loop (while (progn (setq event (read-event)) - (mouse-movement-p event)) + (or (mouse-movement-p event) + ;; Handle `mouse-autoselect-window'. + (eq (car event) 'select-window))) (unless value-selection ; initialization (delete-overlay mouse-secondary-overlay) (setq value-selection (buffer-substring start end)) commit 0491de8dad7b3e25e643f4556375a82b7e6ac445 Author: Alexander Gramiak Date: Sun Nov 12 18:06:32 2017 -0600 * etc/PROBLEMS: Remove fixed xterm-mouse-mode problems See: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29143#26 diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 3dd225302a..ac76230f69 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1117,14 +1117,6 @@ to happen in *.UTF-8 locales; zh_CN.GB2312 and zh_CN.GBK locales, for example, work fine. A bug report has been filed in the Gnome bugzilla: http://bugzilla.gnome.org/show_bug.cgi?id=357032 -*** Gnome: Emacs's xterm-mouse-mode doesn't work on the Gnome terminal. - -A symptom of this bug is that double-clicks insert a control sequence -into the buffer. The reason this happens is an apparent -incompatibility of the Gnome terminal with Xterm, which also affects -other programs using the Xterm mouse interface. A problem report has -been filed. - *** Gnome: GPaste clipboard manager causes erratic behavior of 'yank' The symptom is that 'kill-line' followed by 'yank' often (but not @@ -1496,22 +1488,6 @@ this, you can remove the X resource or put this in your init file: (xterm-remove-modify-other-keys) -** Emacs's xterm-mouse doesn't work well in Evil mode. - -Specifically, clicking mouse-1 doesn't work as expected: instead of -moving point where you click, it highlights the region between the -line beginning and the click location, and displays error messages -about unbound keys in the echo area. - -To work around this, put this in your .emacs file: - - (with-eval-after-load 'evil-maps - (define-key evil-motion-state-map [down-mouse-1] nil)) - -This appears to be a bug in Evil. -See discussions in https://github.com/emacs-evil/evil/issues/960 -and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29143 - ** Emacs spontaneously displays "I-search: " at the bottom of the screen. This means that Control-S/Control-Q (XON/XOFF) "flow control" is being commit 13248f7444630508cfc3b78a07e8d96613af11c8 Author: Eric Abrahamsen Date: Mon Nov 13 21:40:17 2017 -0800 Fix name of gnus-summary-sort-by-mark(s) * lisp/gnus/gnus-sum.el (gnus-summary-sort-by-marks): Needs the "s", according to docs and keymap both. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 79d38f1bfe..f1a3600288 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -11962,7 +11962,7 @@ Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'chars reverse)) -(defun gnus-summary-sort-by-mark (&optional reverse) +(defun gnus-summary-sort-by-marks (&optional reverse) "Sort the summary buffer by article marks. Argument REVERSE means reverse order." (interactive "P") commit caa39f495c0783dac2d5701100db83ea10f126c0 Author: Katsumi Yamaoka Date: Mon Nov 13 23:56:26 2017 +0000 Fix cookie handling (bug#29282) * lisp/url/url-cookie.el (url-cookie-handle-set-cookie): Regard a Set-Cookie header as it contains a single cookie; prefer Max-Age to Expires and convert it to Expires; remove support for old time string styles (bug#29282). diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index d922033d82..27c8dd70e0 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -241,7 +241,7 @@ telling Microsoft that." (defun url-cookie-handle-set-cookie (str) (setq url-cookies-changed-since-last-save t) - (let* ((args (url-parse-args str t)) + (let* ((args (nreverse (url-parse-args str t))) (case-fold-search t) (secure (and (assoc-string "secure" args t) t)) (domain (or (cdr-safe (assoc-string "domain" args t)) @@ -249,44 +249,16 @@ telling Microsoft that." (current-url (url-view-url t)) (trusted url-cookie-trusted-urls) (untrusted url-cookie-untrusted-urls) - (expires (cdr-safe (assoc-string "expires" args t))) + (max-age (cdr-safe (assoc-string "max-age" args t))) (localpart (or (cdr-safe (assoc-string "path" args t)) (file-name-directory (url-filename url-current-object)))) - (rest nil)) - (dolist (this args) - (or (member (downcase (car this)) '("secure" "domain" "expires" "path")) - (setq rest (cons this rest)))) - - ;; Sometimes we get dates that the timezone package cannot handle very - ;; gracefully - take care of this here, instead of in url-cookie-expired-p - ;; to speed things up. - (and expires - (string-match - (concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +" - "\\(..:..:..\\) +\\[*\\([^]]+\\)\\]*$") - expires) - (setq expires (concat (match-string 1 expires) " " - (match-string 2 expires) " " - (match-string 3 expires) " " - (match-string 4 expires) " [" - (match-string 5 expires) "]"))) - - ;; This one is for older Emacs/XEmacs variants that don't - ;; understand this format without tenths of a second in it. - ;; Wednesday, 30-Dec-2037 16:00:00 GMT - ;; - vs - - ;; Wednesday, 30-Dec-2037 16:00:00.00 GMT - (and expires - (string-match - "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)" - expires) - (setq expires (concat (match-string 1 expires) "-" ; day - (match-string 2 expires) "-" ; month - (match-string 3 expires) " " ; year - (match-string 4 expires) ".00 " ; hour:minutes:seconds - (match-string 6 expires)))) ":" ; timezone - + (expires nil)) + (if (and max-age (string-match "\\`-?[0-9]+\\'" max-age)) + (setq expires (format-time-string "%a %b %d %H:%M:%S %Y GMT" + (time-add nil (read max-age)) + t)) + (setq expires (cdr-safe (assoc-string "expires" args t)))) (while (consp trusted) (if (string-match (car trusted) current-url) (setq trusted (- (match-end 0) (match-beginning 0))) @@ -310,8 +282,9 @@ telling Microsoft that." (not trusted) (save-window-excursion (with-output-to-temp-buffer "*Cookie Warning*" - (dolist (x rest) - (princ (format "%s - %s" (car x) (cdr x))))) + (princ (format "%s=\"%s\"\n" (caar args) (cdar args))) + (dolist (x (cdr args)) + (princ (format " %s=\"%s\"\n" (car x) (cdr x))))) (prog1 (not (funcall url-confirmation-func (format "Allow %s to set these cookies? " @@ -322,8 +295,8 @@ telling Microsoft that." nil) ((url-cookie-host-can-set-p (url-host url-current-object) domain) ;; Cookie is accepted by the user, and passes our security checks. - (dolist (cur rest) - (url-cookie-store (car cur) (cdr cur) expires domain localpart secure))) + (url-cookie-store (caar args) (cdar args) + expires domain localpart secure)) (t (url-lazy-message "%s tried to set a cookie for domain %s - rejected." (url-host url-current-object) domain))))) commit 93304e31159ac4e123b26349429cdce0fbd23685 Author: Gemini Lasswell Date: Mon Nov 13 13:22:39 2017 -0800 Improve documentation of Edebug and macros * doc/lispref/edebug.texi (Instrumenting Macro Calls): Improve discussion of when it might be necessary to find and evaluate macro specifications before instrumenting. (Specification List): Clarify what "defining form" means to Edebug and when 'def-form' or 'def-body' should be used instead of 'form' or 'body'. diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index cebf0a3af3..62fd9f38cb 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -1144,9 +1144,12 @@ the @code{declare} form. @c automatically load the entire source file containing the function @c being instrumented. That would avoid this. Take care to ensure that the specifications are known to Edebug when -you instrument code. If you are instrumenting a function from a file -that uses @code{eval-when-compile} to require another file containing -macro definitions, you may need to explicitly load that file. +you instrument code. If you are instrumenting a function which uses a +macro defined in another file, you may first need to either evaluate +the @code{require} forms in the file containing your function, or +explicitly load the file containing the macro. If the definition of a +macro is wrapped by @code{eval-when-compile}, you may need to evaluate +it. You can also define an edebug specification for a macro separately from the macro definition with @code{def-edebug-spec}. Adding @@ -1231,13 +1234,17 @@ A single unevaluated Lisp object, which is not instrumented. @c an "expression" is not necessarily intended for evaluation. @item form -A single evaluated expression, which is instrumented. +A single evaluated expression, which is instrumented. If your macro +wraps the expression with @code{lambda} before it is evaluated, use +@code{def-form} instead. See @code{def-form} below. @item place A generalized variable. @xref{Generalized Variables}. @item body -Short for @code{&rest form}. See @code{&rest} below. +Short for @code{&rest form}. See @code{&rest} below. If your macro +wraps its body of code with @code{lambda} before it is evaluated, use +@code{def-body} instead. See @code{def-body} below. @item function-form A function form: either a quoted function symbol, a quoted lambda @@ -1292,11 +1299,16 @@ succeeds. @item &define @c @kindex &define @r{(Edebug)} -Indicates that the specification is for a defining form. The defining -form itself is not instrumented (that is, Edebug does not stop before and -after the defining form), but forms inside it typically will be -instrumented. The @code{&define} keyword should be the first element in -a list specification. + +Indicates that the specification is for a defining form. Edebug's +definition of a defining form is a form containing one or more code +forms which are saved and executed later, after the execution of the +defining form. + +The defining form itself is not instrumented (that is, Edebug does not +stop before and after the defining form), but forms inside it +typically will be instrumented. The @code{&define} keyword should be +the first element in a list specification. @item nil This is successful when there are no more arguments to match at the commit 99ceefa8ec4f9993663492cfcce6bb82a94569c1 Merge: a7b7b85567 79108894db Author: Paul Eggert Date: Mon Nov 13 10:54:20 2017 -0800 Merge from origin/emacs-26 79108894db Port to IBM xlc 12.01 d14956099d Simplify by removing HAVE_STRUCT_ATTRIBUTE_ALIGNED b1573a97e1 Use alignas to fix GCALIGN-related bugs 5d68dc9a2f Change vectorlike from struct to union 6aa0a26b46 Don't enable cursor-sensor-mode in mhtml-mode 2b8ef8dddf * lisp/files.el (abbreviate-file-name): Doc fix. (Bug#29267) fe85ce1e16 Unbreak interactive run of a flymake test (bug#29267) 48ad00390d Fix Bug#29225 42daf83f08 CC Mode: Fix defun-open being recognized as brace-list-ope... 7775c47298 Merge from Gnulib e470d16448 Pacify GCC when configured --with-x-toolkit=no 49450d0951 * lisp/find-dired.el (find-grep-dired): Doc fix. (Bug#29262) e286b3381f Fix more flymake-diag-region eob corner cases and add test... # Conflicts: # src/lisp.h commit 79108894dbcd642121466bb6af6c98c6a56e9233 Author: Paul Eggert Date: Mon Nov 13 10:06:50 2017 -0800 Port to IBM xlc 12.01 Work around a compiler bug by using a separate enum for alignment. * src/alloc.c (roundup_size): Declare in a separate enum. diff --git a/src/alloc.c b/src/alloc.c index 3b87195b70..88e24cfb73 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2922,19 +2922,16 @@ set_next_vector (struct Lisp_Vector *v, struct Lisp_Vector *p) #define VECTOR_BLOCK_SIZE 4096 -enum - { - /* Alignment of struct Lisp_Vector objects. Because pseudovectors - can contain any C type, align at least as strictly as - max_align_t. On x86 and x86-64 this can waste up to 8 bytes - for typical vectors, since alignof (max_align_t) is 16 but - typical vectors need only an alignment of 8. However, it is - not worth the hassle to avoid wasting those bytes. */ - vector_alignment = COMMON_MULTIPLE (alignof (max_align_t), GCALIGNMENT), - - /* Vector size requests are a multiple of this. */ - roundup_size = COMMON_MULTIPLE (vector_alignment, word_size) - }; +/* Alignment of struct Lisp_Vector objects. Because pseudovectors + can contain any C type, align at least as strictly as + max_align_t. On x86 and x86-64 this can waste up to 8 bytes + for typical vectors, since alignof (max_align_t) is 16 but + typical vectors need only an alignment of 8. However, it is + not worth the hassle to avoid wasting those bytes. */ +enum {vector_alignment = COMMON_MULTIPLE (alignof (max_align_t), GCALIGNMENT)}; + +/* Vector size requests are a multiple of this. */ +enum { roundup_size = COMMON_MULTIPLE (vector_alignment, word_size) }; /* Verify assumptions described above. */ verify (VECTOR_BLOCK_SIZE % roundup_size == 0); commit d14956099d0daf0faa132b20e0fb0d46cae001be Author: Paul Eggert Date: Mon Nov 13 08:51:41 2017 -0800 Simplify by removing HAVE_STRUCT_ATTRIBUTE_ALIGNED * configure.ac (HAVE_STRUCT_ATTRIBUTE_ALIGNED): Remove. No longer needed, since we no longer rely on __attribute__ ((aligned (8))). All uses removed. * src/emacs-module.c (HAVE_STRUCT_ATTRIBUTE_ALIGNED): Remove. (lisp_to_value): Simplify now that we no longer need to worry whether HAVE_STRUCT_ATTRIBUTE_ALIGNED is false. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 10b558d1ad..7a90b3dbe4 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -103,7 +103,6 @@ HAVE_ALARM HAVE_ALLOCA HAVE_ALLOCA_H HAVE_ALSA -HAVE_ATTRIBUTE_ALIGNED HAVE_BDFFONT HAVE_BOXES HAVE_C99_STRTOLD diff --git a/configure.ac b/configure.ac index 5579342c4e..3c72f168a3 100644 --- a/configure.ac +++ b/configure.ac @@ -5113,22 +5113,6 @@ else fi AC_SUBST(LIBXMENU) -AC_CACHE_CHECK([for struct alignment], - [emacs_cv_struct_alignment], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[#include - struct __attribute__ ((aligned (8))) s { char c; }; - struct t { char c; struct s s; }; - char verify[offsetof (struct t, s) == 8 ? 1 : -1]; - ]])], - [emacs_cv_struct_alignment=yes], - [emacs_cv_struct_alignment=no])]) -if test "$emacs_cv_struct_alignment" = yes; then - AC_DEFINE([HAVE_STRUCT_ATTRIBUTE_ALIGNED], 1, - [Define to 1 if 'struct __attribute__ ((aligned (N)))' aligns the - structure to an N-byte boundary.]) -fi - if test "${GNU_MALLOC}" = "yes" ; then AC_DEFINE(GNU_MALLOC, 1, [Define to 1 if you want to use the GNU memory allocator.]) diff --git a/src/emacs-module.c b/src/emacs-module.c index 6bc91a7e06..b351515c3b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -998,10 +998,6 @@ lisp_to_value_bits (Lisp_Object o) return (emacs_value) p; } -#ifndef HAVE_STRUCT_ATTRIBUTE_ALIGNED -enum { HAVE_STRUCT_ATTRIBUTE_ALIGNED = 0 }; -#endif - /* Convert O to an emacs_value. Allocate storage if needed; this can signal if memory is exhausted. Must be an injective function. */ static emacs_value @@ -1029,19 +1025,6 @@ lisp_to_value (emacs_env *env, Lisp_Object o) /* Package the incompressible object pointer inside a pair that is compressible. */ Lisp_Object pair = Fcons (o, ltv_mark); - - if (! HAVE_STRUCT_ATTRIBUTE_ALIGNED) - { - /* Keep calling Fcons until it returns a compressible pair. - This shouldn't take long. */ - while ((intptr_t) XCONS (pair) & (GCALIGNMENT - 1)) - pair = Fcons (o, pair); - - /* Plant the mark. The garbage collector will eventually - reclaim any just-allocated incompressible pairs. */ - XSETCDR (pair, ltv_mark); - } - v = (emacs_value) ((intptr_t) XCONS (pair) + Lisp_Cons); } commit b1573a97e17b518723ab3f906eb6d521caed196d Author: Paul Eggert Date: Mon Nov 13 08:51:41 2017 -0800 Use alignas to fix GCALIGN-related bugs Use alignas and unions to specify alignments of objects needing addresses that are at least a multiple of GCALIGNMENT. Using these standard C facilities should be safer than relying on ad hoc and poorly-understood features like GCC’s __attribute__ ((aligned (N))), the root cause for recent porting bugs like Bug#29040. The alignas macro was standardized by C11 and Gnulib supports alignas for pre-C11 platforms. I have tested this on Sun Studio 12 sparc (2007) and GCC 4.4.7 x86-64 (2012) as well as on more recent platforms like GCC 7.2.1 (2017) on Fedora 26 (both x86-64 and x86). * lib-src/make-docfile.c (close_emacs_globals): lispsym is now just an array of struct Lisp_Symbol, since struct Lisp_Symbol is now properly aligned. All uses changed. * src/alloc.c (NEXT_FREE_LISP_STRING): Just use the new u.next member; this is simpler and safer than casting a pointer that might not be aligned properly. (aligned_Lisp_Symbol): Remove. No longer needed, now that struct Lisp_Symbol is aligned properly. All uses replaced with struct Lisp_Symbol. * src/lisp.h (GCALIGNED): Remove, as it does not work as expected: it can cause the natural alignment to be ignored. All uses replaced by unions with a ‘char alignas (GCALIGNMENT)’ member as described below. (struct Lisp_Symbol, struct Lisp_Cons, struct Lisp_String): Change definition from ‘struct TAG { MEMBERS };’ to ‘struct TAG { union { struct { MEMBERS } s; char alignas (GCALIGNMENT) gcaligned; } u; };’. This guarantees ‘struct TAG’ to have an alignment that at least max (GCALIGNMENT, N) where N is its old alignment. All uses like ‘PTR->MEMBER’ changed to ‘PTR->u.s.MEMBER’; these uses were supposed to be mostly private anyway. Verify that the resulting ‘struct TAG’ is properly aligned for Emacs. (union vectorlike_header): New member ‘gcaligned’ to guarantee that this type, and its containing types like ‘struct Lisp_Subr’, ‘struct buffer’ and ‘struct thread_state’, are all properly aligned for Emacs. (struct Lisp_String): New union member ‘next’, for the benefit of NEXT_FREE_LISP_STRING. (union Aligned_Cons, union Aligned_String): Remove. All uses replaced by struct Lisp_Cons and struct Lisp_String, since they are now properly aligned. (USE_STACK_CONS, USE_STACK_STRING): Simplify now that we can assume struct Lisp_Cons and struct Lisp_String are properly aligned. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index ff84df94a6..9e4755b63a 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -667,9 +667,7 @@ close_emacs_globals (ptrdiff_t num_symbols) "#ifndef DEFINE_SYMBOLS\n" "extern\n" "#endif\n" - "struct {\n" - " struct GCALIGNED Lisp_Symbol s;\n" - "} lispsym[%td];\n"), + "struct Lisp_Symbol lispsym[%td];\n"), num_symbols); } diff --git a/src/alloc.c b/src/alloc.c index 5a44d7a9fc..3b87195b70 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -211,9 +211,9 @@ alloc_unexec_post (void) /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer to a struct Lisp_String. */ -#define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG) -#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG) -#define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0) +#define MARK_STRING(S) ((S)->u.s.size |= ARRAY_MARK_FLAG) +#define UNMARK_STRING(S) ((S)->u.s.size &= ~ARRAY_MARK_FLAG) +#define STRING_MARKED_P(S) (((S)->u.s.size & ARRAY_MARK_FLAG) != 0) #define VECTOR_MARK(V) ((V)->header.size |= ARRAY_MARK_FLAG) #define VECTOR_UNMARK(V) ((V)->header.size &= ~ARRAY_MARK_FLAG) @@ -1730,14 +1730,14 @@ static EMACS_INT total_string_bytes; string_free_list, return a pointer to its successor in the free-list. */ -#define NEXT_FREE_LISP_STRING(S) (*(struct Lisp_String **) (S)) +#define NEXT_FREE_LISP_STRING(S) ((S)->u.next) /* Return a pointer to the sdata structure belonging to Lisp string S. S must be live, i.e. S->data must not be null. S->data is actually a pointer to the `u.data' member of its sdata structure; the structure starts at a constant offset in front of that. */ -#define SDATA_OF_STRING(S) ((sdata *) ((S)->data - SDATA_DATA_OFFSET)) +#define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET)) #ifdef GC_CHECK_STRING_OVERRUN @@ -1818,9 +1818,10 @@ ptrdiff_t string_bytes (struct Lisp_String *s) { ptrdiff_t nbytes = - (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); + (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); - if (!PURE_P (s) && s->data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) + if (!PURE_P (s) && s->u.s.data + && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) emacs_abort (); return nbytes; } @@ -1926,7 +1927,7 @@ allocate_string (void) { s = b->strings + i; /* Every string on a free list should have NULL data pointer. */ - s->data = NULL; + s->u.s.data = NULL; NEXT_FREE_LISP_STRING (s) = string_free_list; string_free_list = s; } @@ -1965,10 +1966,10 @@ allocate_string (void) /* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes, - plus a NUL byte at the end. Allocate an sdata structure for S, and - set S->data to its `u.data' member. Store a NUL byte at the end of - S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free - S->data if it was initially non-null. */ + plus a NUL byte at the end. Allocate an sdata structure DATA for + S, and set S->u.s.data to SDATA->u.data. Store a NUL byte at the + end of S->u.s.data. Set S->u.s.size to NCHARS and S->u.s.size_byte + to NBYTES. Free S->u.s.data if it was initially non-null. */ void allocate_string_data (struct Lisp_String *s, @@ -1984,7 +1985,7 @@ allocate_string_data (struct Lisp_String *s, /* Determine the number of bytes needed to store NBYTES bytes of string data. */ needed = SDATA_SIZE (nbytes); - if (s->data) + if (s->u.s.data) { old_data = SDATA_OF_STRING (s); old_nbytes = STRING_BYTES (s); @@ -2043,13 +2044,13 @@ allocate_string_data (struct Lisp_String *s, MALLOC_UNBLOCK_INPUT; - s->data = SDATA_DATA (data); + s->u.s.data = SDATA_DATA (data); #ifdef GC_CHECK_STRING_BYTES SDATA_NBYTES (data) = nbytes; #endif - s->size = nchars; - s->size_byte = nbytes; - s->data[nbytes] = '\0'; + s->u.s.size = nchars; + s->u.s.size_byte = nbytes; + s->u.s.data[nbytes] = '\0'; #ifdef GC_CHECK_STRING_OVERRUN memcpy ((char *) data + needed, string_overrun_cookie, GC_STRING_OVERRUN_COOKIE_SIZE); @@ -2093,7 +2094,7 @@ sweep_strings (void) { struct Lisp_String *s = b->strings + i; - if (s->data) + if (s->u.s.data) { /* String was not on free-list before. */ if (STRING_MARKED_P (s)) @@ -2102,7 +2103,7 @@ sweep_strings (void) UNMARK_STRING (s); /* Do not use string_(set|get)_intervals here. */ - s->intervals = balance_intervals (s->intervals); + s->u.s.intervals = balance_intervals (s->u.s.intervals); ++total_strings; total_string_bytes += STRING_BYTES (s); @@ -2125,7 +2126,7 @@ sweep_strings (void) /* Reset the strings's `data' member so that we know it's free. */ - s->data = NULL; + s->u.s.data = NULL; /* Put the string on the free-list. */ NEXT_FREE_LISP_STRING (s) = string_free_list; @@ -2264,7 +2265,7 @@ compact_small_strings (void) { eassert (tb != b || to < from); memmove (to, from, nbytes + GC_STRING_EXTRA); - to->string->data = SDATA_DATA (to); + to->string->u.s.data = SDATA_DATA (to); } /* Advance past the sdata we copied to. */ @@ -2544,7 +2545,7 @@ make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) return empty_multibyte_string; s = allocate_string (); - s->intervals = NULL; + s->u.s.intervals = NULL; allocate_string_data (s, nchars, nbytes); XSETSTRING (string, s); string_chars_consed += nbytes; @@ -2729,8 +2730,8 @@ static struct Lisp_Cons *cons_free_list; void free_cons (struct Lisp_Cons *ptr) { - ptr->u.chain = cons_free_list; - ptr->car = Vdead; + ptr->u.s.u.chain = cons_free_list; + ptr->u.s.car = Vdead; cons_free_list = ptr; consing_since_gc -= sizeof *ptr; total_free_conses++; @@ -2749,7 +2750,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0, /* We use the cdr for chaining the free list so that we won't use the same field that has the mark bit. */ XSETCONS (val, cons_free_list); - cons_free_list = cons_free_list->u.chain; + cons_free_list = cons_free_list->u.s.u.chain; } else { @@ -2786,7 +2787,7 @@ check_cons_list (void) struct Lisp_Cons *tail = cons_free_list; while (tail) - tail = tail->u.chain; + tail = tail->u.s.u.chain; } #endif @@ -3543,27 +3544,17 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT Symbol Allocation ***********************************************************************/ -/* Like struct Lisp_Symbol, but padded so that the size is a multiple - of the required alignment. */ - -union aligned_Lisp_Symbol -{ - struct Lisp_Symbol s; - unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1) - & -GCALIGNMENT]; -}; - /* Each symbol_block is just under 1020 bytes long, since malloc really allocates in units of powers of two and uses 4 bytes for its own overhead. */ #define SYMBOL_BLOCK_SIZE \ - ((1020 - sizeof (struct symbol_block *)) / sizeof (union aligned_Lisp_Symbol)) + ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol)) struct symbol_block { /* Place `symbols' first, to preserve alignment. */ - union aligned_Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; + struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; struct symbol_block *next; }; @@ -3587,7 +3578,7 @@ static struct Lisp_Symbol *symbol_free_list; static void set_symbol_name (Lisp_Object sym, Lisp_Object name) { - XSYMBOL (sym)->name = name; + XSYMBOL (sym)->u.s.name = name; } void @@ -3596,15 +3587,15 @@ init_symbol (Lisp_Object val, Lisp_Object name) struct Lisp_Symbol *p = XSYMBOL (val); set_symbol_name (val, name); set_symbol_plist (val, Qnil); - p->redirect = SYMBOL_PLAINVAL; + p->u.s.redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (p, Qunbound); set_symbol_function (val, Qnil); set_symbol_next (val, NULL); - p->gcmarkbit = false; - p->interned = SYMBOL_UNINTERNED; - p->trapped_write = SYMBOL_UNTRAPPED_WRITE; - p->declared_special = false; - p->pinned = false; + p->u.s.gcmarkbit = false; + p->u.s.interned = SYMBOL_UNINTERNED; + p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; + p->u.s.declared_special = false; + p->u.s.pinned = false; } DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, @@ -3621,7 +3612,7 @@ Its value is void, and its function definition and property list are nil. */) if (symbol_free_list) { XSETSYMBOL (val, symbol_free_list); - symbol_free_list = symbol_free_list->next; + symbol_free_list = symbol_free_list->u.s.next; } else { @@ -3634,7 +3625,7 @@ Its value is void, and its function definition and property list are nil. */) symbol_block_index = 0; total_free_symbols += SYMBOL_BLOCK_SIZE; } - XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index].s); + XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]); symbol_block_index++; } @@ -4587,7 +4578,7 @@ live_string_holding (struct mem_node *m, void *p) if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0]) { struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; - if (s->data) + if (s->u.s.data) return make_lisp_ptr (s, Lisp_String); } } @@ -4621,7 +4612,7 @@ live_cons_holding (struct mem_node *m, void *p) || offset / sizeof b->conses[0] < cons_block_index)) { struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; - if (!EQ (s->car, Vdead)) + if (!EQ (s->u.s.car, Vdead)) return make_lisp_ptr (s, Lisp_Cons); } } @@ -4656,7 +4647,7 @@ live_symbol_holding (struct mem_node *m, void *p) || offset / sizeof b->symbols[0] < symbol_block_index)) { struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; - if (!EQ (s->function, Vdead)) + if (!EQ (s->u.s.function, Vdead)) return make_lisp_symbol (s); } } @@ -4984,7 +4975,7 @@ mark_memory (void *start, void *end) Lisp_Object obj = build_string ("test"); struct Lisp_String *s = XSTRING (obj); Fgarbage_collect (); - fprintf (stderr, "test '%s'\n", s->data); + fprintf (stderr, "test '%s'\n", s->u.s.data); return Qnil; } @@ -5484,16 +5475,16 @@ make_pure_string (const char *data, { Lisp_Object string; struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->data = (unsigned char *) find_string_data_in_pure (data, nbytes); - if (s->data == NULL) + s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes); + if (s->u.s.data == NULL) { - s->data = pure_alloc (nbytes + 1, -1); - memcpy (s->data, data, nbytes); - s->data[nbytes] = '\0'; + s->u.s.data = pure_alloc (nbytes + 1, -1); + memcpy (s->u.s.data, data, nbytes); + s->u.s.data[nbytes] = '\0'; } - s->size = nchars; - s->size_byte = multibyte ? nbytes : -1; - s->intervals = NULL; + s->u.s.size = nchars; + s->u.s.size_byte = multibyte ? nbytes : -1; + s->u.s.intervals = NULL; XSETSTRING (string, s); return string; } @@ -5506,10 +5497,10 @@ make_pure_c_string (const char *data, ptrdiff_t nchars) { Lisp_Object string; struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->size = nchars; - s->size_byte = -1; - s->data = (unsigned char *) data; - s->intervals = NULL; + s->u.s.size = nchars; + s->u.s.size_byte = -1; + s->u.s.data = (unsigned char *) data; + s->u.s.intervals = NULL; XSETSTRING (string, s); return string; } @@ -5620,7 +5611,7 @@ purecopy (Lisp_Object obj) || SUBRP (obj)) return obj; /* Already pure. */ - if (STRINGP (obj) && XSTRING (obj)->intervals) + if (STRINGP (obj) && XSTRING (obj)->u.s.intervals) message_with_string ("Dropping text-properties while making string `%s' pure", obj, true); @@ -5675,10 +5666,10 @@ purecopy (Lisp_Object obj) } else if (SYMBOLP (obj)) { - if (!XSYMBOL (obj)->pinned && !c_symbol_p (XSYMBOL (obj))) + if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (obj))) { /* We can't purify them, but they appear in many pure objects. Mark them as `pinned' so we know to mark them at every GC cycle. */ - XSYMBOL (obj)->pinned = true; + XSYMBOL (obj)->u.s.pinned = true; symbol_block_pinned = symbol_block; } /* Don't hash-cons it. */ @@ -5891,10 +5882,10 @@ mark_pinned_symbols (void) for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) { - union aligned_Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; + struct Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; for (; sym < end; ++sym) - if (sym->s.pinned) - mark_object (make_lisp_symbol (&sym->s)); + if (sym->u.s.pinned) + mark_object (make_lisp_symbol (sym)); lim = SYMBOL_BLOCK_SIZE; } @@ -6256,7 +6247,7 @@ mark_char_table (struct Lisp_Vector *ptr, enum pvec_type pvectype) { Lisp_Object val = ptr->contents[i]; - if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit)) + if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->u.s.gcmarkbit)) continue; if (SUB_CHAR_TABLE_P (val)) { @@ -6499,7 +6490,7 @@ mark_object (Lisp_Object arg) break; CHECK_ALLOCATED_AND_LIVE (live_string_p); MARK_STRING (ptr); - MARK_INTERVAL_TREE (ptr->intervals); + MARK_INTERVAL_TREE (ptr->u.s.intervals); #ifdef GC_CHECK_STRING_BYTES /* Check that the string size recorded in the string is the same as the one recorded in the sdata structure. */ @@ -6640,17 +6631,17 @@ mark_object (Lisp_Object arg) case Lisp_Symbol: { - register struct Lisp_Symbol *ptr = XSYMBOL (obj); + struct Lisp_Symbol *ptr = XSYMBOL (obj); nextsym: - if (ptr->gcmarkbit) + if (ptr->u.s.gcmarkbit) break; CHECK_ALLOCATED_AND_LIVE_SYMBOL (); - ptr->gcmarkbit = 1; + ptr->u.s.gcmarkbit = 1; /* Attempt to catch bogus objects. */ - eassert (valid_lisp_object_p (ptr->function)); - mark_object (ptr->function); - mark_object (ptr->plist); - switch (ptr->redirect) + eassert (valid_lisp_object_p (ptr->u.s.function)); + mark_object (ptr->u.s.function); + mark_object (ptr->u.s.plist); + switch (ptr->u.s.redirect) { case SYMBOL_PLAINVAL: mark_object (SYMBOL_VAL (ptr)); break; case SYMBOL_VARALIAS: @@ -6671,11 +6662,11 @@ mark_object (Lisp_Object arg) break; default: emacs_abort (); } - if (!PURE_P (XSTRING (ptr->name))) - MARK_STRING (XSTRING (ptr->name)); - MARK_INTERVAL_TREE (string_intervals (ptr->name)); + if (!PURE_P (XSTRING (ptr->u.s.name))) + MARK_STRING (XSTRING (ptr->u.s.name)); + MARK_INTERVAL_TREE (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ - po = ptr = ptr->next; + po = ptr = ptr->u.s.next; if (ptr) goto nextsym; } @@ -6729,14 +6720,14 @@ mark_object (Lisp_Object arg) CHECK_ALLOCATED_AND_LIVE (live_cons_p); CONS_MARK (ptr); /* If the cdr is nil, avoid recursion for the car. */ - if (EQ (ptr->u.cdr, Qnil)) + if (EQ (ptr->u.s.u.cdr, Qnil)) { - obj = ptr->car; + obj = ptr->u.s.car; cdr_count = 0; goto loop; } - mark_object (ptr->car); - obj = ptr->u.cdr; + mark_object (ptr->u.s.car); + obj = ptr->u.s.u.cdr; cdr_count++; if (cdr_count == mark_object_loop_halt) emacs_abort (); @@ -6797,7 +6788,7 @@ survives_gc_p (Lisp_Object obj) break; case Lisp_Symbol: - survives_p = XSYMBOL (obj)->gcmarkbit; + survives_p = XSYMBOL (obj)->u.s.gcmarkbit; break; case Lisp_Misc: @@ -6873,9 +6864,9 @@ sweep_conses (void) if (!CONS_MARKED_P (&cblk->conses[pos])) { this_free++; - cblk->conses[pos].u.chain = cons_free_list; + cblk->conses[pos].u.s.u.chain = cons_free_list; cons_free_list = &cblk->conses[pos]; - cons_free_list->car = Vdead; + cons_free_list->u.s.car = Vdead; } else { @@ -6894,7 +6885,7 @@ sweep_conses (void) { *cprev = cblk->next; /* Unhook from the free list. */ - cons_free_list = cblk->conses[0].u.chain; + cons_free_list = cblk->conses[0].u.s.u.chain; lisp_align_free (cblk); } else @@ -7018,39 +7009,39 @@ sweep_symbols (void) symbol_free_list = NULL; for (int i = 0; i < ARRAYELTS (lispsym); i++) - lispsym[i].s.gcmarkbit = 0; + lispsym[i].u.s.gcmarkbit = 0; for (sblk = symbol_block; sblk; sblk = *sprev) { int this_free = 0; - union aligned_Lisp_Symbol *sym = sblk->symbols; - union aligned_Lisp_Symbol *end = sym + lim; + struct Lisp_Symbol *sym = sblk->symbols; + struct Lisp_Symbol *end = sym + lim; for (; sym < end; ++sym) { - if (!sym->s.gcmarkbit) + if (!sym->u.s.gcmarkbit) { - if (sym->s.redirect == SYMBOL_LOCALIZED) + if (sym->u.s.redirect == SYMBOL_LOCALIZED) { - xfree (SYMBOL_BLV (&sym->s)); + xfree (SYMBOL_BLV (sym)); /* At every GC we sweep all symbol_blocks and rebuild the symbol_free_list, so those symbols which stayed unused between the two will be re-swept. So we have to make sure we don't re-free this blv next time we sweep this symbol_block (bug#29066). */ - sym->s.redirect = SYMBOL_PLAINVAL; + sym->u.s.redirect = SYMBOL_PLAINVAL; } - sym->s.next = symbol_free_list; - symbol_free_list = &sym->s; - symbol_free_list->function = Vdead; + sym->u.s.next = symbol_free_list; + symbol_free_list = sym; + symbol_free_list->u.s.function = Vdead; ++this_free; } else { ++num_used; - sym->s.gcmarkbit = 0; + sym->u.s.gcmarkbit = 0; /* Attempt to catch bogus objects. */ - eassert (valid_lisp_object_p (sym->s.function)); + eassert (valid_lisp_object_p (sym->u.s.function)); } } @@ -7062,7 +7053,7 @@ sweep_symbols (void) { *sprev = sblk->next; /* Unhook from the free list. */ - symbol_free_list = sblk->symbols[0].s.next; + symbol_free_list = sblk->symbols[0].u.s.next; lisp_free (sblk); } else @@ -7289,10 +7280,10 @@ symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) struct Lisp_Symbol *sym = XSYMBOL (symbol); Lisp_Object val = find_symbol_value (symbol); return (EQ (val, obj) - || EQ (sym->function, obj) - || (!NILP (sym->function) - && COMPILEDP (sym->function) - && EQ (AREF (sym->function, COMPILED_BYTECODE), obj)) + || EQ (sym->u.s.function, obj) + || (!NILP (sym->u.s.function) + && COMPILEDP (sym->u.s.function) + && EQ (AREF (sym->u.s.function, COMPILED_BYTECODE), obj)) || (!NILP (val) && COMPILEDP (val) && EQ (AREF (val, COMPILED_BYTECODE), obj))); @@ -7323,15 +7314,15 @@ which_symbols (Lisp_Object obj, EMACS_INT find_max) for (sblk = symbol_block; sblk; sblk = sblk->next) { - union aligned_Lisp_Symbol *aligned_sym = sblk->symbols; + struct Lisp_Symbol *asym = sblk->symbols; int bn; - for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, aligned_sym++) + for (bn = 0; bn < SYMBOL_BLOCK_SIZE; bn++, asym++) { if (sblk == symbol_block && bn >= symbol_block_index) break; - Lisp_Object sym = make_lisp_symbol (&aligned_sym->s); + Lisp_Object sym = make_lisp_symbol (asym); if (symbol_uses_obj (sym, obj)) { found = Fcons (sym, found); diff --git a/src/buffer.c b/src/buffer.c index edeed55e8b..4ae5e811b0 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -61,7 +61,7 @@ struct buffer *all_buffers; Setting the default value also goes through the alist of buffers and stores into each buffer that does not say it has a local value. */ -struct GCALIGNED buffer buffer_defaults; +struct buffer buffer_defaults; /* This structure marks which slots in a buffer have corresponding default values in buffer_defaults. @@ -84,7 +84,7 @@ struct buffer buffer_local_flags; /* This structure holds the names of symbols whose values may be buffer-local. It is indexed and accessed in the same way as the above. */ -struct GCALIGNED buffer buffer_local_symbols; +struct buffer buffer_local_symbols; /* Return the symbol of the per-buffer variable at offset OFFSET in the buffer structure. */ @@ -1021,7 +1021,8 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) newlist = Fcons (elt, newlist); } newlist = Fnreverse (newlist); - if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) + if (XSYMBOL (local_var)->u.s.trapped_write + == SYMBOL_TRAPPED_WRITE) notify_variable_watchers (local_var, newlist, Qmakunbound, Fcurrent_buffer ()); XSETCDR (XCAR (tmp), newlist); @@ -1034,7 +1035,7 @@ reset_buffer_local_variables (struct buffer *b, bool permanent_too) else XSETCDR (last, XCDR (tmp)); - if (XSYMBOL (local_var)->trapped_write == SYMBOL_TRAPPED_WRITE) + if (XSYMBOL (local_var)->u.s.trapped_write == SYMBOL_TRAPPED_WRITE) notify_variable_watchers (local_var, Qnil, Qmakunbound, Fcurrent_buffer ()); } @@ -1166,7 +1167,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break; @@ -2096,7 +2097,7 @@ void set_buffer_internal_2 (register struct buffer *b) { Lisp_Object var = XCAR (XCAR (tail)); struct Lisp_Symbol *sym = XSYMBOL (var); - if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure. */ + if (sym->u.s.redirect == SYMBOL_LOCALIZED /* Just to be sure. */ && SYMBOL_BLV (sym)->fwd) /* Just reference the variable to cause it to become set for this buffer. */ @@ -2752,7 +2753,7 @@ swap_out_buffer_local_variables (struct buffer *b) for (alist = oalist; CONSP (alist); alist = XCDR (alist)) { Lisp_Object sym = XCAR (XCAR (alist)); - eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED); + eassert (XSYMBOL (sym)->u.s.redirect == SYMBOL_LOCALIZED); /* Need not do anything if some other buffer's binding is now cached. */ if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer)) @@ -5423,8 +5424,8 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd, const char *namestring, bo_fwd->type = Lisp_Fwd_Buffer_Obj; bo_fwd->offset = offset; bo_fwd->predicate = predicate; - sym->declared_special = 1; - sym->redirect = SYMBOL_FORWARDED; + sym->u.s.declared_special = true; + sym->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (sym, (union Lisp_Fwd *) bo_fwd); XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym); diff --git a/src/bytecode.c b/src/bytecode.c index 50c7abe289..ebaf3c3a7f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -489,7 +489,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, { Lisp_Object v1 = vectorp[op], v2; if (!SYMBOLP (v1) - || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL + || XSYMBOL (v1)->u.s.redirect != SYMBOL_PLAINVAL || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound))) v2 = Fsymbol_value (v1); PUSH (v2); @@ -558,7 +558,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, /* Inline the most common case. */ if (SYMBOLP (sym) && !EQ (val, Qunbound) - && !XSYMBOL (sym)->redirect + && !XSYMBOL (sym)->u.s.redirect && !SYMBOL_TRAPPED_WRITE_P (sym)) SET_SYMBOL_VAL (XSYMBOL (sym), val); else diff --git a/src/casefiddle.c b/src/casefiddle.c index 8f564edeb9..7b34f78a5c 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -133,9 +133,9 @@ case_character_impl (struct casing_str_buf *buf, struct Lisp_String *str = XSTRING (prop); if (STRING_BYTES (str) <= sizeof buf->data) { - buf->len_chars = str->size; + buf->len_chars = str->u.s.size; buf->len_bytes = STRING_BYTES (str); - memcpy (buf->data, str->data, buf->len_bytes); + memcpy (buf->data, str->u.s.data, buf->len_bytes); return 1; } } diff --git a/src/cmds.c b/src/cmds.c index e4c0c86691..1788f22fe5 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -421,11 +421,11 @@ internal_self_insert (int c, EMACS_INT n) and the hook has a non-nil `no-self-insert' property, return right away--don't really self-insert. */ if (SYMBOLP (sym) && ! NILP (sym) - && ! NILP (XSYMBOL (sym)->function) - && SYMBOLP (XSYMBOL (sym)->function)) + && ! NILP (XSYMBOL (sym)->u.s.function) + && SYMBOLP (XSYMBOL (sym)->u.s.function)) { Lisp_Object prop; - prop = Fget (XSYMBOL (sym)->function, intern ("no-self-insert")); + prop = Fget (XSYMBOL (sym)->u.s.function, intern ("no-self-insert")); if (! NILP (prop)) return 1; } diff --git a/src/data.c b/src/data.c index ef7210fbfa..b4f6fd5c65 100644 --- a/src/data.c +++ b/src/data.c @@ -670,7 +670,7 @@ global value outside of any lexical scope. */) sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_PLAINVAL: valcontents = SYMBOL_VAL (sym); break; case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; @@ -704,10 +704,10 @@ global value outside of any lexical scope. */) expect `t' in particular, rather than any true value. */ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, doc: /* Return t if SYMBOL's function definition is not void. */) - (register Lisp_Object symbol) + (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return NILP (XSYMBOL (symbol)->function) ? Qnil : Qt; + return NILP (XSYMBOL (symbol)->u.s.function) ? Qnil : Qt; } DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, @@ -736,18 +736,18 @@ Return SYMBOL. */) DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0, doc: /* Return SYMBOL's function definition, or nil if that is void. */) - (register Lisp_Object symbol) + (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return XSYMBOL (symbol)->function; + return XSYMBOL (symbol)->u.s.function; } DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, doc: /* Return SYMBOL's property list. */) - (register Lisp_Object symbol) + (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return XSYMBOL (symbol)->plist; + return XSYMBOL (symbol)->u.s.plist; } DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, @@ -771,7 +771,7 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0, if (NILP (symbol)) xsignal1 (Qsetting_constant, symbol); - function = XSYMBOL (symbol)->function; + function = XSYMBOL (symbol)->u.s.function; if (!NILP (Vautoload_queue) && !NILP (function)) Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue); @@ -814,7 +814,7 @@ The return value is undefined. */) { /* Only add autoload entries after dumping, because the ones before are not useful and else we get loads of them from the loaddefs.el. */ - if (AUTOLOADP (XSYMBOL (symbol)->function)) + if (AUTOLOADP (XSYMBOL (symbol)->u.s.function)) /* Remember that the function was already an autoload. */ LOADHIST_ATTACH (Fcons (Qt, symbol)); LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol)); @@ -940,10 +940,10 @@ indirect_variable (struct Lisp_Symbol *symbol) hare = tortoise = symbol; - while (hare->redirect == SYMBOL_VARALIAS) + while (hare->u.s.redirect == SYMBOL_VARALIAS) { hare = SYMBOL_ALIAS (hare); - if (hare->redirect != SYMBOL_VARALIAS) + if (hare->u.s.redirect != SYMBOL_VARALIAS) break; hare = SYMBOL_ALIAS (hare); @@ -1247,7 +1247,7 @@ find_symbol_value (Lisp_Object symbol) sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); @@ -1310,7 +1310,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, CHECK_SYMBOL (symbol); sym = XSYMBOL (symbol); - switch (sym->trapped_write) + switch (sym->u.s.trapped_write) { case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) @@ -1336,7 +1336,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, } start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: SET_SYMBOL_VAL (sym , newval); return; @@ -1436,7 +1436,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where, if (voide) { /* If storing void (making the symbol void), forward only through buffer-local indicator, not through Lisp_Objfwd, etc. */ - sym->redirect = SYMBOL_PLAINVAL; + sym->u.s.redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (sym, newval); } else @@ -1452,9 +1452,9 @@ static void set_symbol_trapped_write (Lisp_Object symbol, enum symbol_trapped_write trap) { struct Lisp_Symbol *sym = XSYMBOL (symbol); - if (sym->trapped_write == SYMBOL_NOWRITE) + if (sym->u.s.trapped_write == SYMBOL_NOWRITE) xsignal1 (Qtrapping_constant, symbol); - sym->trapped_write = trap; + sym->u.s.trapped_write = trap; } static void @@ -1469,7 +1469,7 @@ harmonize_variable_watchers (Lisp_Object alias, Lisp_Object base_variable) if (!EQ (base_variable, alias) && EQ (base_variable, Findirect_variable (alias))) set_symbol_trapped_write - (alias, XSYMBOL (base_variable)->trapped_write); + (alias, XSYMBOL (base_variable)->u.s.trapped_write); } DEFUN ("add-variable-watcher", Fadd_variable_watcher, Sadd_variable_watcher, @@ -1583,7 +1583,7 @@ default_value (Lisp_Object symbol) sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return SYMBOL_VAL (sym); @@ -1653,7 +1653,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, CHECK_SYMBOL (symbol); sym = XSYMBOL (symbol); - switch (sym->trapped_write) + switch (sym->u.s.trapped_write) { case SYMBOL_NOWRITE: if (NILP (Fkeywordp (symbol)) @@ -1665,7 +1665,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, case SYMBOL_TRAPPED_WRITE: /* Don't notify here if we're going to call Fset anyway. */ - if (sym->redirect != SYMBOL_PLAINVAL + if (sym->u.s.redirect != SYMBOL_PLAINVAL /* Setting due to thread switching doesn't count. */ && bindflag != SET_INTERNAL_THREAD_SWITCH) notify_variable_watchers (symbol, value, Qset_default, Qnil); @@ -1677,7 +1677,7 @@ set_default_internal (Lisp_Object symbol, Lisp_Object value, } start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return; @@ -1829,7 +1829,7 @@ The function `default-value' gets the default value and `set-default' sets it. sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: @@ -1857,7 +1857,7 @@ The function `default-value' gets the default value and `set-default' sets it. if (!blv) { blv = make_blv (sym, forwarded, valcontents); - sym->redirect = SYMBOL_LOCALIZED; + sym->u.s.redirect = SYMBOL_LOCALIZED; SET_SYMBOL_BLV (sym, blv); } @@ -1897,7 +1897,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: @@ -1914,7 +1914,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default: emacs_abort (); } - if (sym->trapped_write == SYMBOL_NOWRITE) + if (sym->u.s.trapped_write == SYMBOL_NOWRITE) error ("Symbol %s may not be buffer-local", SDATA (SYMBOL_NAME (variable))); @@ -1930,7 +1930,7 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) if (!blv) { blv = make_blv (sym, forwarded, valcontents); - sym->redirect = SYMBOL_LOCALIZED; + sym->u.s.redirect = SYMBOL_LOCALIZED; SET_SYMBOL_BLV (sym, blv); } @@ -1987,7 +1987,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return variable; @@ -2014,7 +2014,7 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) default: emacs_abort (); } - if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) + if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE) notify_variable_watchers (variable, Qnil, Qmakunbound, Fcurrent_buffer ()); /* Get rid of this buffer's alist element, if any. */ @@ -2056,7 +2056,7 @@ BUFFER defaults to the current buffer. */) sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; @@ -2110,7 +2110,7 @@ value in BUFFER, or if VARIABLE is automatically buffer-local (see sym = XSYMBOL (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; @@ -2145,7 +2145,7 @@ If the current binding is global (the default), the value is nil. */) find_symbol_value (variable); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start; case SYMBOL_PLAINVAL: return Qnil; @@ -2163,7 +2163,7 @@ If the current binding is global (the default), the value is nil. */) buffer's or frame's value we are saving. */ if (!NILP (Flocal_variable_p (variable, Qnil))) return Fcurrent_buffer (); - else if (sym->redirect == SYMBOL_LOCALIZED + else if (sym->u.s.redirect == SYMBOL_LOCALIZED && blv_found (SYMBOL_BLV (sym))) return SYMBOL_BLV (sym)->where; else @@ -2234,12 +2234,12 @@ indirect_function (register Lisp_Object object) { if (!SYMBOLP (hare) || NILP (hare)) break; - hare = XSYMBOL (hare)->function; + hare = XSYMBOL (hare)->u.s.function; if (!SYMBOLP (hare) || NILP (hare)) break; - hare = XSYMBOL (hare)->function; + hare = XSYMBOL (hare)->u.s.function; - tortoise = XSYMBOL (tortoise)->function; + tortoise = XSYMBOL (tortoise)->u.s.function; if (EQ (hare, tortoise)) xsignal1 (Qcyclic_function_indirection, object); @@ -2261,7 +2261,7 @@ function chain of symbols. */) /* Optimize for no indirection. */ result = object; if (SYMBOLP (result) && !NILP (result) - && (result = XSYMBOL (result)->function, SYMBOLP (result))) + && (result = XSYMBOL (result)->u.s.function, SYMBOLP (result))) result = indirect_function (result); if (!NILP (result)) return result; @@ -3877,7 +3877,7 @@ syms_of_data (void) defsubr (&Sbool_vector_count_consecutive); defsubr (&Sbool_vector_count_population); - set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->function); + set_symbol_function (Qwholenump, XSYMBOL (Qnatnump)->u.s.function); DEFVAR_LISP ("most-positive-fixnum", Vmost_positive_fixnum, doc: /* The largest value that is representable in a Lisp integer. */); diff --git a/src/doc.c b/src/doc.c index e81740bfc1..0cd62172c3 100644 --- a/src/doc.c +++ b/src/doc.c @@ -472,7 +472,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) { /* Don't use indirect_function here, or defaliases will apply their docstrings to the base functions (Bug#2603). */ - Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj; + Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->u.s.function : obj; /* The type determines where the docstring is stored. */ diff --git a/src/eval.c b/src/eval.c index 52e4c96d4b..40b47968be 100644 --- a/src/eval.c +++ b/src/eval.c @@ -603,7 +603,7 @@ The return value is BASE-VARIABLE. */) sym = XSYMBOL (new_alias); - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_FORWARDED: error ("Cannot make an internal variable an alias"); @@ -632,14 +632,14 @@ The return value is BASE-VARIABLE. */) error ("Don't know how to make a let-bound variable an alias"); } - if (sym->trapped_write == SYMBOL_TRAPPED_WRITE) + if (sym->u.s.trapped_write == SYMBOL_TRAPPED_WRITE) notify_variable_watchers (new_alias, base_variable, Qdefvaralias, Qnil); - sym->declared_special = 1; - XSYMBOL (base_variable)->declared_special = 1; - sym->redirect = SYMBOL_VARALIAS; + sym->u.s.declared_special = true; + XSYMBOL (base_variable)->u.s.declared_special = true; + sym->u.s.redirect = SYMBOL_VARALIAS; SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); - sym->trapped_write = XSYMBOL (base_variable)->trapped_write; + sym->u.s.trapped_write = XSYMBOL (base_variable)->u.s.trapped_write; LOADHIST_ATTACH (new_alias); /* Even if docstring is nil: remove old docstring. */ Fput (new_alias, Qvariable_documentation, docstring); @@ -745,7 +745,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; + XSYMBOL (sym)->u.s.declared_special = true; if (NILP (tem)) Fset_default (sym, eval_sub (XCAR (tail))); @@ -769,7 +769,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) LOADHIST_ATTACH (sym); } else if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (sym)->declared_special) + && !XSYMBOL (sym)->u.s.declared_special) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ @@ -818,7 +818,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); - XSYMBOL (sym)->declared_special = 1; + XSYMBOL (sym)->u.s.declared_special = true; if (!NILP (docstring)) { if (!NILP (Vpurify_flag)) @@ -837,7 +837,7 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special, (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - XSYMBOL (symbol)->declared_special = 0; + XSYMBOL (symbol)->u.s.declared_special = false; return Qnil; } @@ -877,7 +877,7 @@ usage: (let* VARLIST BODY...) */) } if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && !XSYMBOL (var)->u.s.declared_special && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ @@ -953,7 +953,7 @@ usage: (let VARLIST BODY...) */) tem = temps[argnum]; if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && !XSYMBOL (var)->u.s.declared_special && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (var, tem), lexenv); @@ -1022,7 +1022,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) tem = Fassq (sym, environment); if (NILP (tem)) { - def = XSYMBOL (sym)->function; + def = XSYMBOL (sym)->u.s.function; if (!NILP (def)) continue; } @@ -1932,8 +1932,8 @@ this does nothing and returns nil. */) CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if (!NILP (XSYMBOL (function)->function) - && !AUTOLOADP (XSYMBOL (function)->function)) + if (!NILP (XSYMBOL (function)->u.s.function) + && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) @@ -2164,7 +2164,7 @@ eval_sub (Lisp_Object form) fun = original_fun; if (!SYMBOLP (fun)) fun = Ffunction (Fcons (fun, Qnil)); - else if (!NILP (fun) && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + else if (!NILP (fun) && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun)) @@ -2347,7 +2347,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) { fun = indirect_function (fun); if (NILP (fun)) @@ -2759,7 +2759,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ fun = original_fun; if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + && (fun = XSYMBOL (fun)->u.s.function, SYMBOLP (fun))) fun = indirect_function (fun); if (SUBRP (fun)) @@ -3075,7 +3075,7 @@ function with `&rest' args, or `unevalled' for a special form. */) function = original; if (SYMBOLP (function) && !NILP (function)) { - function = XSYMBOL (function)->function; + function = XSYMBOL (function)->u.s.function; if (SYMBOLP (function)) function = indirect_function (function); } @@ -3214,7 +3214,7 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) if ((--p)->kind > SPECPDL_LET) { struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); - eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); + eassert (let_bound_symbol->u.s.redirect != SYMBOL_VARALIAS); if (symbol == let_bound_symbol && EQ (specpdl_where (p), buf)) return 1; @@ -3227,10 +3227,10 @@ static void do_specbind (struct Lisp_Symbol *sym, union specbinding *bind, Lisp_Object value, enum Set_Internal_Bind bindflag) { - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_PLAINVAL: - if (!sym->trapped_write) + if (!sym->u.s.trapped_write) SET_SYMBOL_VAL (sym, value); else set_internal (specpdl_symbol (bind), value, Qnil, bindflag); @@ -3274,7 +3274,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (sym->u.s.redirect) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; @@ -3298,10 +3298,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.where = Fcurrent_buffer (); specpdl_ptr->let.saved_value = Qnil; - eassert (sym->redirect != SYMBOL_LOCALIZED + eassert (sym->u.s.redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); - if (sym->redirect == SYMBOL_LOCALIZED) + if (sym->u.s.redirect == SYMBOL_LOCALIZED) { if (!blv_found (SYMBOL_BLV (sym))) specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; @@ -3412,9 +3412,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, { /* If variable has a trivial value (no forwarding), and isn't trapped, we can just set it. */ Lisp_Object sym = specpdl_symbol (this_binding); - if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) + if (SYMBOLP (sym) && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL) { - if (XSYMBOL (sym)->trapped_write == SYMBOL_UNTRAPPED_WRITE) + if (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_UNTRAPPED_WRITE) SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding)); else set_internal (sym, specpdl_old_value (this_binding), @@ -3546,7 +3546,7 @@ context where binding is lexical by default. */) (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return XSYMBOL (symbol)->declared_special ? Qt : Qnil; + return XSYMBOL (symbol)->u.s.declared_special ? Qt : Qnil; } @@ -3702,7 +3702,8 @@ backtrace_eval_unrewind (int distance) just set it. No need to check for constant symbols here, since that was already done by specbind. */ Lisp_Object sym = specpdl_symbol (tmp); - if (SYMBOLP (sym) && XSYMBOL (sym)->redirect == SYMBOL_PLAINVAL) + if (SYMBOLP (sym) + && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL) { Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, SYMBOL_VAL (XSYMBOL (sym))); diff --git a/src/fns.c b/src/fns.c index 2311a6e041..42859344bd 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1993,7 +1993,7 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) propname); if (!NILP (propval)) return propval; - return Fplist_get (XSYMBOL (symbol)->plist, propname); + return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname); } DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0, @@ -2039,7 +2039,7 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */) { CHECK_SYMBOL (symbol); set_symbol_plist - (symbol, Fplist_put (XSYMBOL (symbol)->plist, propname, value)); + (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value)); return value; } diff --git a/src/keyboard.c b/src/keyboard.c index 7ddd6b9674..57757cf211 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -7901,7 +7901,7 @@ parse_menu_item (Lisp_Object item, int inmenubar) (such as lmenu.el set it up), check if the original command matches the cached command. */ && !(SYMBOLP (def) - && EQ (tem, XSYMBOL (def)->function)))) + && EQ (tem, XSYMBOL (def)->u.s.function)))) keys = Qnil; } @@ -8761,9 +8761,9 @@ access_keymap_keyremap (Lisp_Object map, Lisp_Object key, Lisp_Object prompt, /* Handle a symbol whose function definition is a keymap or an array. */ if (SYMBOLP (next) && !NILP (Ffboundp (next)) - && (ARRAYP (XSYMBOL (next)->function) - || KEYMAPP (XSYMBOL (next)->function))) - next = Fautoload_do_load (XSYMBOL (next)->function, next, Qnil); + && (ARRAYP (XSYMBOL (next)->u.s.function) + || KEYMAPP (XSYMBOL (next)->u.s.function))) + next = Fautoload_do_load (XSYMBOL (next)->u.s.function, next, Qnil); /* If the keymap gives a function, not an array, then call the function with one arg and use @@ -11510,7 +11510,7 @@ for that character after that prefix key. */); doc: /* Form to evaluate when Emacs starts up. Useful to set before you dump a modified Emacs. */); Vtop_level = Qnil; - XSYMBOL (Qtop_level)->declared_special = false; + XSYMBOL (Qtop_level)->u.s.declared_special = false; DEFVAR_KBOARD ("keyboard-translate-table", Vkeyboard_translate_table, doc: /* Translate table for local keyboard input, or nil. diff --git a/src/lisp.h b/src/lisp.h index 1d6fd5a4fe..e9aec4c597 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -229,7 +229,7 @@ extern bool suppress_checking EXTERNALLY_VISIBLE; USE_LSB_TAG not only requires the least 3 bits of pointers returned by malloc to be 0 but also needs to be able to impose a mult-of-8 alignment on the few static Lisp_Objects used, all of which are aligned via - the GCALIGN macro defined below. */ + 'char alignas (GCALIGNMENT) gcaligned;' inside a union. */ enum Lisp_Bits { @@ -277,20 +277,6 @@ DEFINE_GDB_SYMBOL_END (VALMASK) error !; #endif -/* Use GCALIGNED immediately after the 'struct' keyword to require the - struct to have an address that is a multiple of GCALIGNMENT. This - is a no-op if the struct's natural alignment is already a multiple - of GCALIGNMENT. GCALIGNED's implementation uses the 'aligned' - attribute instead of 'alignas (GCALIGNMENT)', as the latter would - fail if an object's natural alignment exceeds GCALIGNMENT. The - implementation hopes that natural alignment suffices on platforms - lacking 'aligned'. */ -#ifdef HAVE_STRUCT_ATTRIBUTE_ALIGNED -# define GCALIGNED __attribute__ ((aligned (GCALIGNMENT))) -#else -# define GCALIGNED /* empty */ -#endif - /* Some operations are so commonly executed that they are implemented as macros, not functions, because otherwise runtime performance would suffer too much when compiling with GCC without optimization. @@ -338,15 +324,17 @@ error !; #define lisp_h_MISCP(x) (XTYPE (x) == Lisp_Misc) #define lisp_h_NILP(x) EQ (x, Qnil) #define lisp_h_SET_SYMBOL_VAL(sym, v) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v)) -#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->trapped_write == SYMBOL_NOWRITE) -#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->trapped_write) + (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), \ + (sym)->u.s.val.value = (v)) +#define lisp_h_SYMBOL_CONSTANT_P(sym) \ + (XSYMBOL (sym)->u.s.trapped_write == SYMBOL_NOWRITE) +#define lisp_h_SYMBOL_TRAPPED_WRITE_P(sym) (XSYMBOL (sym)->u.s.trapped_write) #define lisp_h_SYMBOL_VAL(sym) \ - (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value) + (eassert ((sym)->u.s.redirect == SYMBOL_PLAINVAL), (sym)->u.s.val.value) #define lisp_h_SYMBOLP(x) (XTYPE (x) == Lisp_Symbol) #define lisp_h_VECTORLIKEP(x) (XTYPE (x) == Lisp_Vectorlike) -#define lisp_h_XCAR(c) XCONS (c)->car -#define lisp_h_XCDR(c) XCONS (c)->u.cdr +#define lisp_h_XCAR(c) XCONS (c)->u.s.car +#define lisp_h_XCDR(c) XCONS (c)->u.s.u.cdr #define lisp_h_XCONS(a) \ (eassert (CONSP (a)), (struct Lisp_Cons *) XUNTAG (a, Lisp_Cons)) #define lisp_h_XHASH(a) XUINT (a) @@ -677,52 +665,60 @@ enum symbol_trapped_write struct Lisp_Symbol { - bool_bf gcmarkbit : 1; - - /* Indicates where the value can be found: - 0 : it's a plain var, the value is in the `value' field. - 1 : it's a varalias, the value is really in the `alias' symbol. - 2 : it's a localized var, the value is in the `blv' object. - 3 : it's a forwarding variable, the value is in `forward'. */ - ENUM_BF (symbol_redirect) redirect : 3; - - /* 0 : normal case, just set the value - 1 : constant, cannot set, e.g. nil, t, :keywords. - 2 : trap the write, call watcher functions. */ - ENUM_BF (symbol_trapped_write) trapped_write : 2; - - /* Interned state of the symbol. This is an enumerator from - enum symbol_interned. */ - unsigned interned : 2; - - /* True means that this variable has been explicitly declared - special (with `defvar' etc), and shouldn't be lexically bound. */ - bool_bf declared_special : 1; - - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - - /* The symbol's name, as a Lisp string. */ - Lisp_Object name; - - /* Value of the symbol or Qunbound if unbound. Which alternative of the - union is used depends on the `redirect' field above. */ - union { - Lisp_Object value; - struct Lisp_Symbol *alias; - struct Lisp_Buffer_Local_Value *blv; - union Lisp_Fwd *fwd; - } val; - - /* Function value of the symbol or Qnil if not fboundp. */ - Lisp_Object function; + union + { + struct + { + bool_bf gcmarkbit : 1; + + /* Indicates where the value can be found: + 0 : it's a plain var, the value is in the `value' field. + 1 : it's a varalias, the value is really in the `alias' symbol. + 2 : it's a localized var, the value is in the `blv' object. + 3 : it's a forwarding variable, the value is in `forward'. */ + ENUM_BF (symbol_redirect) redirect : 3; + + /* 0 : normal case, just set the value + 1 : constant, cannot set, e.g. nil, t, :keywords. + 2 : trap the write, call watcher functions. */ + ENUM_BF (symbol_trapped_write) trapped_write : 2; + + /* Interned state of the symbol. This is an enumerator from + enum symbol_interned. */ + unsigned interned : 2; + + /* True means that this variable has been explicitly declared + special (with `defvar' etc), and shouldn't be lexically bound. */ + bool_bf declared_special : 1; + + /* True if pointed to from purespace and hence can't be GC'd. */ + bool_bf pinned : 1; + + /* The symbol's name, as a Lisp string. */ + Lisp_Object name; + + /* Value of the symbol or Qunbound if unbound. Which alternative of the + union is used depends on the `redirect' field above. */ + union { + Lisp_Object value; + struct Lisp_Symbol *alias; + struct Lisp_Buffer_Local_Value *blv; + union Lisp_Fwd *fwd; + } val; + + /* Function value of the symbol or Qnil if not fboundp. */ + Lisp_Object function; - /* The symbol's property list. */ - Lisp_Object plist; + /* The symbol's property list. */ + Lisp_Object plist; - /* Next symbol in obarray bucket, if the symbol is interned. */ - struct Lisp_Symbol *next; + /* Next symbol in obarray bucket, if the symbol is interned. */ + struct Lisp_Symbol *next; + } s; + char alignas (GCALIGNMENT) gcaligned; + } u; }; +verify (alignof (struct Lisp_Symbol) % GCALIGNMENT == 0); /* Declare a Lisp-callable function. The MAXARGS parameter has the same meaning as in the DEFUN macro, and is used to construct a prototype. */ @@ -802,7 +798,7 @@ struct Lisp_Symbol Bug#8546. */ union vectorlike_header { - /* The only field contains various pieces of information: + /* The main member contains various pieces of information: - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain vector (0) or a pseudovector (1). @@ -822,7 +818,9 @@ union vectorlike_header Current layout limits the pseudovectors to 63 PVEC_xxx subtypes, 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots. */ ptrdiff_t size; + char alignas (GCALIGNMENT) gcaligned; }; +verify (alignof (union vectorlike_header) % GCALIGNMENT == 0); INLINE bool (SYMBOLP) (Lisp_Object x) @@ -854,7 +852,7 @@ make_lisp_symbol (struct Lisp_Symbol *sym) INLINE Lisp_Object builtin_lisp_symbol (int index) { - return make_lisp_symbol (&lispsym[index].s); + return make_lisp_symbol (&lispsym[index]); } INLINE void @@ -1144,20 +1142,28 @@ make_pointer_integer (void *p) typedef struct interval *INTERVAL; -struct GCALIGNED Lisp_Cons +struct Lisp_Cons +{ + union { - /* Car of this cons cell. */ - Lisp_Object car; - - union + struct { - /* Cdr of this cons cell. */ - Lisp_Object cdr; - - /* Used to chain conses on a free list. */ - struct Lisp_Cons *chain; - } u; - }; + /* Car of this cons cell. */ + Lisp_Object car; + + union + { + /* Cdr of this cons cell. */ + Lisp_Object cdr; + + /* Used to chain conses on a free list. */ + struct Lisp_Cons *chain; + } u; + } s; + char alignas (GCALIGNMENT) gcaligned; + } u; +}; +verify (alignof (struct Lisp_Cons) % GCALIGNMENT == 0); INLINE bool (NILP) (Lisp_Object x) @@ -1193,12 +1199,12 @@ INLINE struct Lisp_Cons * INLINE Lisp_Object * xcar_addr (Lisp_Object c) { - return &XCONS (c)->car; + return &XCONS (c)->u.s.car; } INLINE Lisp_Object * xcdr_addr (Lisp_Object c) { - return &XCONS (c)->u.cdr; + return &XCONS (c)->u.s.u.cdr; } /* Use these from normal code. */ @@ -1262,15 +1268,24 @@ CDR_SAFE (Lisp_Object c) return CONSP (c) ? XCDR (c) : Qnil; } -/* In a string or vector, the sign bit of the `size' is the gc mark bit. */ +/* In a string or vector, the sign bit of u.s.size is the gc mark bit. */ -struct GCALIGNED Lisp_String +struct Lisp_String +{ + union { - ptrdiff_t size; - ptrdiff_t size_byte; - INTERVAL intervals; /* Text properties in this string. */ - unsigned char *data; - }; + struct + { + ptrdiff_t size; + ptrdiff_t size_byte; + INTERVAL intervals; /* Text properties in this string. */ + unsigned char *data; + } s; + struct Lisp_String *next; + char alignas (GCALIGNMENT) gcaligned; + } u; +}; +verify (alignof (struct Lisp_String) % GCALIGNMENT == 0); INLINE bool STRINGP (Lisp_Object x) @@ -1295,7 +1310,7 @@ XSTRING (Lisp_Object a) INLINE bool STRING_MULTIBYTE (Lisp_Object str) { - return 0 <= XSTRING (str)->size_byte; + return 0 <= XSTRING (str)->u.s.size_byte; } /* An upper bound on the number of bytes in a Lisp string, not @@ -1317,20 +1332,20 @@ STRING_MULTIBYTE (Lisp_Object str) /* Mark STR as a unibyte string. */ #define STRING_SET_UNIBYTE(STR) \ do { \ - if (XSTRING (STR)->size == 0) \ + if (XSTRING (STR)->u.s.size == 0) \ (STR) = empty_unibyte_string; \ else \ - XSTRING (STR)->size_byte = -1; \ + XSTRING (STR)->u.s.size_byte = -1; \ } while (false) /* Mark STR as a multibyte string. Assure that STR contains only ASCII characters in advance. */ #define STRING_SET_MULTIBYTE(STR) \ do { \ - if (XSTRING (STR)->size == 0) \ + if (XSTRING (STR)->u.s.size == 0) \ (STR) = empty_multibyte_string; \ else \ - XSTRING (STR)->size_byte = XSTRING (STR)->size; \ + XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \ } while (false) /* Convenience functions for dealing with Lisp strings. */ @@ -1338,7 +1353,7 @@ STRING_MULTIBYTE (Lisp_Object str) INLINE unsigned char * SDATA (Lisp_Object string) { - return XSTRING (string)->data; + return XSTRING (string)->u.s.data; } INLINE char * SSDATA (Lisp_Object string) @@ -1359,7 +1374,7 @@ SSET (Lisp_Object string, ptrdiff_t index, unsigned char new) INLINE ptrdiff_t SCHARS (Lisp_Object string) { - ptrdiff_t nchars = XSTRING (string)->size; + ptrdiff_t nchars = XSTRING (string)->u.s.size; eassume (0 <= nchars); return nchars; } @@ -1373,7 +1388,7 @@ STRING_BYTES (struct Lisp_String *s) #ifdef GC_CHECK_STRING_BYTES ptrdiff_t nbytes = string_bytes (s); #else - ptrdiff_t nbytes = s->size_byte < 0 ? s->size : s->size_byte; + ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte; #endif eassume (0 <= nbytes); return nbytes; @@ -1392,7 +1407,7 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) eassert (STRING_MULTIBYTE (string) ? 0 <= newsize && newsize <= SBYTES (string) : newsize == SCHARS (string)); - XSTRING (string)->size = newsize; + XSTRING (string)->u.s.size = newsize; } /* A regular vector is just a header plus an array of Lisp_Objects. */ @@ -1910,20 +1925,20 @@ INLINE Lisp_Object INLINE struct Lisp_Symbol * SYMBOL_ALIAS (struct Lisp_Symbol *sym) { - eassume (sym->redirect == SYMBOL_VARALIAS && sym->val.alias); - return sym->val.alias; + eassume (sym->u.s.redirect == SYMBOL_VARALIAS && sym->u.s.val.alias); + return sym->u.s.val.alias; } INLINE struct Lisp_Buffer_Local_Value * SYMBOL_BLV (struct Lisp_Symbol *sym) { - eassume (sym->redirect == SYMBOL_LOCALIZED && sym->val.blv); - return sym->val.blv; + eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && sym->u.s.val.blv); + return sym->u.s.val.blv; } INLINE union Lisp_Fwd * SYMBOL_FWD (struct Lisp_Symbol *sym) { - eassume (sym->redirect == SYMBOL_FORWARDED && sym->val.fwd); - return sym->val.fwd; + eassume (sym->u.s.redirect == SYMBOL_FORWARDED && sym->u.s.val.fwd); + return sym->u.s.val.fwd; } INLINE void @@ -1935,26 +1950,26 @@ INLINE void INLINE void SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v) { - eassume (sym->redirect == SYMBOL_VARALIAS && v); - sym->val.alias = v; + eassume (sym->u.s.redirect == SYMBOL_VARALIAS && v); + sym->u.s.val.alias = v; } INLINE void SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v) { - eassume (sym->redirect == SYMBOL_LOCALIZED && v); - sym->val.blv = v; + eassume (sym->u.s.redirect == SYMBOL_LOCALIZED && v); + sym->u.s.val.blv = v; } INLINE void SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v) { - eassume (sym->redirect == SYMBOL_FORWARDED && v); - sym->val.fwd = v; + eassume (sym->u.s.redirect == SYMBOL_FORWARDED && v); + sym->u.s.val.fwd = v; } INLINE Lisp_Object SYMBOL_NAME (Lisp_Object sym) { - return XSYMBOL (sym)->name; + return XSYMBOL (sym)->u.s.name; } /* Value is true if SYM is an interned symbol. */ @@ -1962,7 +1977,7 @@ SYMBOL_NAME (Lisp_Object sym) INLINE bool SYMBOL_INTERNED_P (Lisp_Object sym) { - return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED; + return XSYMBOL (sym)->u.s.interned != SYMBOL_UNINTERNED; } /* Value is true if SYM is interned in initial_obarray. */ @@ -1970,7 +1985,7 @@ SYMBOL_INTERNED_P (Lisp_Object sym) INLINE bool SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym) { - return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; + return XSYMBOL (sym)->u.s.interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY; } /* Value is non-zero if symbol cannot be changed through a simple set, @@ -2948,7 +2963,7 @@ CHECK_NUMBER_CDR (Lisp_Object x) #ifdef _MSC_VER #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \ - static struct GCALIGNED Lisp_Subr sname = \ + static struct Lisp_Subr sname = \ { { (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) \ | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) }, \ { (Lisp_Object (__cdecl *)(void))fnname }, \ @@ -2956,7 +2971,7 @@ CHECK_NUMBER_CDR (Lisp_Object x) Lisp_Object fnname #else /* not _MSC_VER */ #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - static struct GCALIGNED Lisp_Subr sname = \ + static struct Lisp_Subr sname = \ { { PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ { .a ## maxargs = fnname }, \ minargs, maxargs, lname, intspec, 0}; \ @@ -3224,25 +3239,25 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val) INLINE void set_symbol_function (Lisp_Object sym, Lisp_Object function) { - XSYMBOL (sym)->function = function; + XSYMBOL (sym)->u.s.function = function; } INLINE void set_symbol_plist (Lisp_Object sym, Lisp_Object plist) { - XSYMBOL (sym)->plist = plist; + XSYMBOL (sym)->u.s.plist = plist; } INLINE void set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next) { - XSYMBOL (sym)->next = next; + XSYMBOL (sym)->u.s.next = next; } INLINE void make_symbol_constant (Lisp_Object sym) { - XSYMBOL (sym)->trapped_write = SYMBOL_NOWRITE; + XSYMBOL (sym)->u.s.trapped_write = SYMBOL_NOWRITE; } /* Buffer-local variable access functions. */ @@ -3267,7 +3282,7 @@ set_overlay_plist (Lisp_Object overlay, Lisp_Object plist) INLINE INTERVAL string_intervals (Lisp_Object s) { - return XSTRING (s)->intervals; + return XSTRING (s)->u.s.intervals; } /* Set text properties of S to I. */ @@ -3275,7 +3290,7 @@ string_intervals (Lisp_Object s) INLINE void set_string_intervals (Lisp_Object s, INTERVAL i) { - XSTRING (s)->intervals = i; + XSTRING (s)->u.s.intervals = i; } /* Set a Lisp slot in TABLE to VAL. Most code should use this instead @@ -4600,20 +4615,6 @@ enum { defined_GC_CHECK_STRING_BYTES = true }; enum { defined_GC_CHECK_STRING_BYTES = false }; #endif -/* Struct inside unions that are typically no larger and aligned enough. */ - -union Aligned_Cons -{ - struct Lisp_Cons s; - double d; intmax_t i; void *p; -}; - -union Aligned_String -{ - struct Lisp_String s; - double d; intmax_t i; void *p; -}; - /* True for stack-based cons and string implementations, respectively. Use stack-based strings only if stack-based cons also works. Otherwise, STACK_CONS would create heap-based cons cells that @@ -4621,18 +4622,16 @@ union Aligned_String enum { - USE_STACK_CONS = (USE_STACK_LISP_OBJECTS - && alignof (union Aligned_Cons) % GCALIGNMENT == 0), + USE_STACK_CONS = USE_STACK_LISP_OBJECTS, USE_STACK_STRING = (USE_STACK_CONS - && !defined_GC_CHECK_STRING_BYTES - && alignof (union Aligned_String) % GCALIGNMENT == 0) + && !defined_GC_CHECK_STRING_BYTES) }; /* Auxiliary macros used for auto allocation of Lisp objects. Please use these only in macros like AUTO_CONS that declare a local variable whose lifetime will be clear to the programmer. */ #define STACK_CONS(a, b) \ - make_lisp_ptr (&((union Aligned_Cons) { { a, { b } } }).s, Lisp_Cons) + make_lisp_ptr (&((struct Lisp_Cons) {{{a, {b}}}}), Lisp_Cons) #define AUTO_CONS_EXPR(a, b) \ (USE_STACK_CONS ? STACK_CONS (a, b) : Fcons (a, b)) @@ -4678,7 +4677,7 @@ enum Lisp_Object name = \ (USE_STACK_STRING \ ? (make_lisp_ptr \ - ((&((union Aligned_String) {{len, -1, 0, (unsigned char *) (str)}}).s), \ + ((&(struct Lisp_String) {{{len, -1, 0, (unsigned char *) (str)}}}), \ Lisp_String)) \ : make_unibyte_string (str, len)) diff --git a/src/lread.c b/src/lread.c index 33da866722..b056f4aaf3 100644 --- a/src/lread.c +++ b/src/lread.c @@ -4043,14 +4043,14 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { Lisp_Object *ptr; - XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) - ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY - : SYMBOL_INTERNED); + XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray) + ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY + : SYMBOL_INTERNED); if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) { make_symbol_constant (sym); - XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; + XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } @@ -4203,16 +4203,16 @@ usage: (unintern NAME OBARRAY) */) /* if (EQ (tem, Qnil) || EQ (tem, Qt)) error ("Attempt to unintern t or nil"); */ - XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; + XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED; hash = oblookup_last_bucket_number; if (EQ (AREF (obarray, hash), tem)) { - if (XSYMBOL (tem)->next) + if (XSYMBOL (tem)->u.s.next) { Lisp_Object sym; - XSETSYMBOL (sym, XSYMBOL (tem)->next); + XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next); ASET (obarray, hash, sym); } else @@ -4223,13 +4223,13 @@ usage: (unintern NAME OBARRAY) */) Lisp_Object tail, following; for (tail = AREF (obarray, hash); - XSYMBOL (tail)->next; + XSYMBOL (tail)->u.s.next; tail = following) { - XSETSYMBOL (following, XSYMBOL (tail)->next); + XSETSYMBOL (following, XSYMBOL (tail)->u.s.next); if (EQ (following, tem)) { - set_symbol_next (tail, XSYMBOL (following)->next); + set_symbol_next (tail, XSYMBOL (following)->u.s.next); break; } } @@ -4264,13 +4264,13 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff else if (!SYMBOLP (bucket)) error ("Bad data in guts of obarray"); /* Like CADR error message. */ else - for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) + for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next)) { if (SBYTES (SYMBOL_NAME (tail)) == size_byte && SCHARS (SYMBOL_NAME (tail)) == size && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) return tail; - else if (XSYMBOL (tail)->next == 0) + else if (XSYMBOL (tail)->u.s.next == 0) break; } XSETINT (tem, hash); @@ -4290,9 +4290,9 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob while (1) { (*fn) (tail, arg); - if (XSYMBOL (tail)->next == 0) + if (XSYMBOL (tail)->u.s.next == 0) break; - XSETSYMBOL (tail, XSYMBOL (tail)->next); + XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); } } } @@ -4332,12 +4332,12 @@ init_obarray (void) DEFSYM (Qnil, "nil"); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); make_symbol_constant (Qnil); - XSYMBOL (Qnil)->declared_special = true; + XSYMBOL (Qnil)->u.s.declared_special = true; DEFSYM (Qt, "t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); make_symbol_constant (Qt); - XSYMBOL (Qt)->declared_special = true; + XSYMBOL (Qt)->u.s.declared_special = true; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; @@ -4361,7 +4361,7 @@ defalias (struct Lisp_Subr *sname, char *string) { Lisp_Object sym; sym = intern (string); - XSETSUBR (XSYMBOL (sym)->function, sname); + XSETSUBR (XSYMBOL (sym)->u.s.function, sname); } #endif /* NOTDEF */ @@ -4376,8 +4376,8 @@ defvar_int (struct Lisp_Intfwd *i_fwd, sym = intern_c_string (namestring); i_fwd->type = Lisp_Fwd_Int; i_fwd->intvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + XSYMBOL (sym)->u.s.declared_special = true; + XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); } @@ -4391,8 +4391,8 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd, sym = intern_c_string (namestring); b_fwd->type = Lisp_Fwd_Bool; b_fwd->boolvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + XSYMBOL (sym)->u.s.declared_special = true; + XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -4410,8 +4410,8 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd, sym = intern_c_string (namestring); o_fwd->type = Lisp_Fwd_Obj; o_fwd->objvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + XSYMBOL (sym)->u.s.declared_special = true; + XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); } @@ -4434,8 +4434,8 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd, sym = intern_c_string (namestring); ko_fwd->type = Lisp_Fwd_Kboard_Obj; ko_fwd->offset = offset; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + XSYMBOL (sym)->u.s.declared_special = true; + XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED; SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); } @@ -4769,7 +4769,7 @@ to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. Order is reverse chronological. */); - XSYMBOL (intern ("values"))->declared_special = 0; + XSYMBOL (intern ("values"))->u.s.declared_special = true; DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. diff --git a/src/minibuf.c b/src/minibuf.c index a2f3324f99..913c93001e 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1280,8 +1280,8 @@ is used to further constrain the set of candidates. */) error ("Bad data in guts of obarray"); elt = bucket; eltstring = elt; - if (XSYMBOL (bucket)->next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->next); + if (XSYMBOL (bucket)->u.s.next) + XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); else XSETFASTINT (bucket, 0); } @@ -1533,8 +1533,8 @@ with a space are ignored unless STRING itself starts with a space. */) error ("Bad data in guts of obarray"); elt = bucket; eltstring = elt; - if (XSYMBOL (bucket)->next) - XSETSYMBOL (bucket, XSYMBOL (bucket)->next); + if (XSYMBOL (bucket)->u.s.next) + XSETSYMBOL (bucket, XSYMBOL (bucket)->u.s.next); else XSETFASTINT (bucket, 0); } @@ -1754,9 +1754,9 @@ the values STRING, PREDICATE and `lambda'. */) tem = tail; break; } - if (XSYMBOL (tail)->next == 0) + if (XSYMBOL (tail)->u.s.next == 0) break; - XSETSYMBOL (tail, XSYMBOL (tail)->next); + XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next); } } } diff --git a/src/thread.c b/src/thread.c index 7335833cf9..c03cdda0fa 100644 --- a/src/thread.c +++ b/src/thread.c @@ -26,7 +26,7 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "syssignal.h" -static struct GCALIGNED thread_state main_thread; +static struct thread_state main_thread; struct thread_state *current_thread = &main_thread; diff --git a/src/xterm.c b/src/xterm.c index 5e2fc6d20a..28abfaecde 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -12515,7 +12515,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { terminal->kboard = allocate_kboard (Qx); - if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->function, Qunbound)) + if (!EQ (XSYMBOL (Qvendor_specific_keysyms)->u.s.function, Qunbound)) { char *vendor = ServerVendor (dpy); commit 5d68dc9a2fd1b9b883db6bc1c226541b50de8bb1 Author: Paul Eggert Date: Mon Nov 13 08:51:41 2017 -0800 Change vectorlike from struct to union * src/lisp.h (vectorlike_headed): Change from struct to union. All uses changed. Since it has only one member, this does not change semantics. This is designed to simplify future changes needed to fix bugs like Bug#29040. All uses changed. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 663d0fd92b..b0348e74d4 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -248,7 +248,7 @@ of 8k bytes, and small vectors are packed into blocks of 4k bytes). @cindex storage of vector-like Lisp objects Beyond the basic vector, a lot of objects like window, buffer, and frame are managed as if they were vectors. The corresponding C data -structures include the @code{struct vectorlike_header} field whose +structures include the @code{union vectorlike_header} field whose @code{size} member contains the subtype enumerated by @code{enum pvec_type} and an information about how many @code{Lisp_Object} fields this structure contains and what the size of the rest data is. This information is @@ -1085,7 +1085,7 @@ Some of the fields of @code{struct buffer} are: @table @code @item header -A header of type @code{struct vectorlike_header} is common to all +A header of type @code{union vectorlike_header} is common to all vectorlike objects. @item own_text diff --git a/src/buffer.h b/src/buffer.h index ac7c5a5467..46c7c6e5ad 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -504,7 +504,7 @@ struct buffer_text struct buffer { - struct vectorlike_header header; + union vectorlike_header header; /* The name of this buffer. */ Lisp_Object name_; diff --git a/src/font.h b/src/font.h index 8f2e27f0ed..43d6f67e3e 100644 --- a/src/font.h +++ b/src/font.h @@ -244,7 +244,7 @@ enum font_property_index struct font_spec { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object props[FONT_SPEC_MAX]; }; @@ -252,7 +252,7 @@ struct font_spec struct font_entity { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object props[FONT_ENTITY_MAX]; }; @@ -265,7 +265,7 @@ struct font_entity struct font { - struct vectorlike_header header; + union vectorlike_header header; /* All Lisp_Object components must come first. That ensures they are all aligned normally. */ diff --git a/src/frame.h b/src/frame.h index e610fc768d..a3b7763643 100644 --- a/src/frame.h +++ b/src/frame.h @@ -79,7 +79,7 @@ enum ns_appearance_type struct frame { - struct vectorlike_header header; + union vectorlike_header header; /* All Lisp_Object components must come first. That ensures they are all aligned normally. */ diff --git a/src/lisp.h b/src/lisp.h index 015346858b..1d6fd5a4fe 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -796,11 +796,11 @@ struct Lisp_Symbol /* Header of vector-like objects. This documents the layout constraints on vectors and pseudovectors (objects of PVEC_xxx subtype). It also prevents compilers from being fooled by Emacs's type punning: XSETPSEUDOVECTOR - and PSEUDOVECTORP cast their pointers to struct vectorlike_header *, + and PSEUDOVECTORP cast their pointers to union vectorlike_header *, because when two such pointers potentially alias, a compiler won't incorrectly reorder loads and stores to their size fields. See Bug#8546. */ -struct vectorlike_header +union vectorlike_header { /* The only field contains various pieces of information: - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit. @@ -1094,10 +1094,10 @@ INLINE bool | ((restsize) << PSEUDOVECTOR_SIZE_BITS) \ | (lispsize))) -/* The cast to struct vectorlike_header * avoids aliasing issues. */ +/* The cast to union vectorlike_header * avoids aliasing issues. */ #define XSETPSEUDOVECTOR(a, b, code) \ XSETTYPED_PSEUDOVECTOR (a, b, \ - (((struct vectorlike_header *) \ + (((union vectorlike_header *) \ XUNTAG (a, Lisp_Vectorlike)) \ ->size), \ code) @@ -1399,7 +1399,7 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize) struct Lisp_Vector { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object contents[FLEXIBLE_ARRAY_MEMBER]; }; @@ -1456,7 +1456,7 @@ PSEUDOVECTOR_TYPE (struct Lisp_Vector *v) /* Can't be used with PVEC_NORMAL_VECTOR. */ INLINE bool -PSEUDOVECTOR_TYPEP (struct vectorlike_header *a, enum pvec_type code) +PSEUDOVECTOR_TYPEP (union vectorlike_header *a, enum pvec_type code) { /* We don't use PSEUDOVECTOR_TYPE here so as to avoid a shift * operation when `code' is known. */ @@ -1472,8 +1472,8 @@ PSEUDOVECTORP (Lisp_Object a, int code) return false; else { - /* Converting to struct vectorlike_header * avoids aliasing issues. */ - struct vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); + /* Converting to union vectorlike_header * avoids aliasing issues. */ + union vectorlike_header *h = XUNTAG (a, Lisp_Vectorlike); return PSEUDOVECTOR_TYPEP (h, code); } } @@ -1484,7 +1484,7 @@ struct Lisp_Bool_Vector { /* HEADER.SIZE is the vector's size field. It doesn't have the real size, just the subtype information. */ - struct vectorlike_header header; + union vectorlike_header header; /* This is the size in bits. */ EMACS_INT size; /* The actual bits, packed into bytes. @@ -1697,7 +1697,7 @@ struct Lisp_Char_Table pseudovector type information. It holds the size, too. The size counts the defalt, parent, purpose, ascii, contents, and extras slots. */ - struct vectorlike_header header; + union vectorlike_header header; /* This holds a default value, which is used whenever the value for a specific character is nil. */ @@ -1739,7 +1739,7 @@ struct Lisp_Sub_Char_Table { /* HEADER.SIZE is the vector's size field, which also holds the pseudovector type information. It holds the size, too. */ - struct vectorlike_header header; + union vectorlike_header header; /* Depth of this sub char-table. It should be 1, 2, or 3. A sub char-table of depth 1 contains 16 elements, and each element @@ -1814,7 +1814,7 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val) struct Lisp_Subr { - struct vectorlike_header header; + union vectorlike_header header; union { Lisp_Object (*a0) (void); Lisp_Object (*a1) (Lisp_Object); @@ -2026,7 +2026,7 @@ struct hash_table_test struct Lisp_Hash_Table { /* This is for Lisp; the hash table code does not refer to it. */ - struct vectorlike_header header; + union vectorlike_header header; /* Nil if table is non-weak. Otherwise a symbol describing the weakness of the table. */ @@ -3929,7 +3929,7 @@ typedef emacs_value (*emacs_subr) (emacs_env *, ptrdiff_t, struct Lisp_Module_Function { - struct vectorlike_header header; + union vectorlike_header header; /* Fields traced by GC; these must come first. */ Lisp_Object documentation; diff --git a/src/process.h b/src/process.h index 5a044f669f..5670f44736 100644 --- a/src/process.h +++ b/src/process.h @@ -41,7 +41,7 @@ enum { PROCESS_OPEN_FDS = 6 }; struct Lisp_Process { - struct vectorlike_header header; + union vectorlike_header header; /* Name of subprocess terminal. */ Lisp_Object tty_name; diff --git a/src/termhooks.h b/src/termhooks.h index dd6044aabd..fe4e993c96 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -373,7 +373,7 @@ extern struct tty_display_info *gpm_tty; struct terminal { /* This is for Lisp; the terminal code does not refer to it. */ - struct vectorlike_header header; + union vectorlike_header header; /* Parameter alist of this terminal. */ Lisp_Object param_alist; diff --git a/src/thread.h b/src/thread.h index 19baafbf8a..1845974bc2 100644 --- a/src/thread.h +++ b/src/thread.h @@ -35,7 +35,7 @@ along with GNU Emacs. If not, see . */ struct thread_state { - struct vectorlike_header header; + union vectorlike_header header; /* The buffer in which the last search was performed, or Qt if the last search was done in a string; @@ -230,7 +230,7 @@ typedef struct /* A mutex as a lisp object. */ struct Lisp_Mutex { - struct vectorlike_header header; + union vectorlike_header header; /* The name of the mutex, or nil. */ Lisp_Object name; @@ -261,7 +261,7 @@ XMUTEX (Lisp_Object a) /* A condition variable as a lisp object. */ struct Lisp_CondVar { - struct vectorlike_header header; + union vectorlike_header header; /* The associated mutex. */ Lisp_Object mutex; diff --git a/src/w32term.h b/src/w32term.h index 8d08ca0a2b..de234cb57d 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -431,7 +431,7 @@ extern struct w32_output w32term_display; struct scroll_bar { /* This field is shared by all vectors. */ - struct vectorlike_header header; + union vectorlike_header header; /* The window we're a scroll bar for. */ Lisp_Object window; diff --git a/src/window.c b/src/window.c index cc1d2a7b36..7f472523b4 100644 --- a/src/window.c +++ b/src/window.c @@ -3733,8 +3733,8 @@ make_parent_window (Lisp_Object window, bool horflag) o = XWINDOW (window); p = allocate_window (); - memcpy ((char *) p + sizeof (struct vectorlike_header), - (char *) o + sizeof (struct vectorlike_header), + memcpy ((char *) p + sizeof (union vectorlike_header), + (char *) o + sizeof (union vectorlike_header), word_size * VECSIZE (struct window)); /* P's buffer slot may change from nil to a buffer... */ adjust_window_count (p, 1); @@ -6232,7 +6232,7 @@ from the top of the window. */) struct save_window_data { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object selected_frame; Lisp_Object current_window; Lisp_Object f_current_buffer; @@ -6260,7 +6260,7 @@ struct save_window_data /* This is saved as a Lisp_Vector. */ struct saved_window { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object window, buffer, start, pointm, old_pointm; Lisp_Object pixel_left, pixel_top, pixel_height, pixel_width; diff --git a/src/window.h b/src/window.h index df7c23f824..25c9686a9f 100644 --- a/src/window.h +++ b/src/window.h @@ -88,7 +88,7 @@ struct cursor_pos struct window { /* This is for Lisp; the terminal code does not refer to it. */ - struct vectorlike_header header; + union vectorlike_header header; /* The frame this window is on. */ Lisp_Object frame; diff --git a/src/xterm.h b/src/xterm.h index 6274630706..7ab20ba06c 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -887,7 +887,7 @@ extern void x_mark_frame_dirty (struct frame *f); struct scroll_bar { /* These fields are shared by all vectors. */ - struct vectorlike_header header; + union vectorlike_header header; /* The window we're a scroll bar for. */ Lisp_Object window; diff --git a/src/xwidget.h b/src/xwidget.h index 22a8eb3a55..02a0453dab 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -33,7 +33,7 @@ struct window; struct xwidget { - struct vectorlike_header header; + union vectorlike_header header; /* Auxiliary data. */ Lisp_Object plist; @@ -62,7 +62,7 @@ struct xwidget struct xwidget_view { - struct vectorlike_header header; + union vectorlike_header header; Lisp_Object model; Lisp_Object w; commit a7b7b85567f766ff510a5eaaaf32dbbbec15efd0 Author: Stefan Monnier Date: Mon Nov 13 11:28:05 2017 -0500 * lisp/gnus/gnus-srvr.el: Avoid custom-set-variables * lisp/gnus/gnus-srvr.el (gnus-server-toggle-cloud-method-server): Prefer customize-set-variable. diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index 8a91973e38..23d8b02efd 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -1159,7 +1159,7 @@ Requesting compaction of %s... (this may take a long time)" (error "The server under point can't host the Emacs Cloud")) (when (not (string-equal gnus-cloud-method server)) - (custom-set-variables '(gnus-cloud-method server)) + (customize-set-variable 'gnus-cloud-method server) ;; Note we can't use `Custom-save' here. (when (gnus-yes-or-no-p (format "The new cloud host server is %S now. Save it? " server)) commit 6aa0a26b46240d79eddd7e0d275454e235a60b84 Author: Tom Tromey Date: Sun Nov 12 11:56:05 2017 -0700 Don't enable cursor-sensor-mode in mhtml-mode * lisp/textmodes/mhtml-mode.el (mhtml--last-submode): Update doc string. (mhtml-mode): Don't call cursor-sensor-mode. diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 5854167750..8df251276b 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -237,8 +237,8 @@ smallest." (cons 'jit-lock-bounds (cons new-beg new-end))))) (defvar-local mhtml--last-submode nil - "Record the last visited submode, so the cursor-sensor function -can function properly.") + "Record the last visited submode. +This is used by `mhtml--pre-command'.") (defvar-local mhtml--stashed-crucial-variables nil "Alist of stashed values of the crucial variables.") @@ -359,7 +359,6 @@ can function properly.") Code inside a ")) ;; Closing document. "\n")) @@ -2107,7 +2166,9 @@ is the language used for CODE, as a string, or nil." ;; Simple transcoding. (org-html-encode-plain-text code)) ;; Case 2: No htmlize or an inferior version of htmlize - ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) + ((not (and (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) + (fboundp 'htmlize-region-for-paste))) ;; Emit a warning. (message "Cannot fontify src block (htmlize.el >= 1.34 required)") ;; Simple transcoding. @@ -2552,21 +2613,22 @@ holding contextual information." (cdr ids) ""))) (if (org-export-low-level-p headline info) ;; This is a deep sub-tree: export it as a list item. - (let* ((type (if numberedp 'ordered 'unordered)) - (itemized-body - (org-html-format-list-item - contents type nil info nil + (let* ((html-type (if numberedp "ol" "ul"))) + (concat + (and (org-export-first-sibling-p headline info) + (apply #'format "<%s class=\"org-%s\">\n" + (make-list 2 html-type))) + (org-html-format-list-item + contents (if numberedp 'ordered 'unordered) + nil info nil (concat (org-html--anchor preferred-id nil nil info) extra-ids - full-text)))) - (concat (and (org-export-first-sibling-p headline info) - (org-html-begin-plain-list type)) - itemized-body - (and (org-export-last-sibling-p headline info) - (org-html-end-plain-list type)))) + full-text)) "\n" + (and (org-export-last-sibling-p headline info) + (format "\n" html-type)))) + ;; Standard headline. Export it as a section. (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) (first-content (car (org-element-contents headline)))) - ;; Standard headline. Export it as a section. (format "<%s id=\"%s\" class=\"%s\">%s%s\n" (org-html--container headline info) (concat "outline-container-" @@ -2692,7 +2754,8 @@ INFO is a plist holding contextual information. See (symbol-name checkbox)) "")) (checkbox (concat (org-html-checkbox checkbox info) (and checkbox " "))) - (br (org-html-close-tag "br" nil info))) + (br (org-html-close-tag "br" nil info)) + (extra-newline (if (and (org-string-nw-p contents) headline) "\n" ""))) (concat (pcase type (`ordered @@ -2715,7 +2778,9 @@ INFO is a plist holding contextual information. See class (concat checkbox term)) "
")))) (unless (eq type 'descriptive) checkbox) - (and contents (org-trim contents)) + extra-newline + (and (org-string-nw-p contents) (org-trim contents)) + extra-newline (pcase type (`ordered "") (`unordered "") @@ -2838,6 +2903,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link +(defun org-html-image-link-filter (data _backend info) + (org-export-insert-image-links data info org-html-inline-image-rules)) + (defun org-html-inline-image-p (link info) "Non-nil when LINK is meant to appear as an image. INFO is a plist used as a communication channel. LINK is an @@ -3132,34 +3200,27 @@ the plist used as a communication channel." ;;;; Plain List -;; FIXME Maybe arg1 is not needed because
  • already sets -;; the correct value for the item counter -(defun org-html-begin-plain-list (type &optional arg1) - "Insert the beginning of the HTML list depending on TYPE. -When ARG1 is a string, use it as the start parameter for ordered -lists." - (pcase type - (`ordered - (format "
      " - (if arg1 (format " start=\"%d\"" arg1) ""))) - (`unordered "
        ") - (`descriptive "
        "))) - -(defun org-html-end-plain-list (type) - "Insert the end of the HTML list depending on TYPE." - (pcase type - (`ordered "
    ") - (`unordered "") - (`descriptive ""))) - (defun org-html-plain-list (plain-list contents _info) "Transcode a PLAIN-LIST element from Org to HTML. CONTENTS is the contents of the list. INFO is a plist holding contextual information." - (let ((type (org-element-property :type plain-list))) - (format "%s\n%s%s" - (org-html-begin-plain-list type) - contents (org-html-end-plain-list type)))) + (let* ((type (pcase (org-element-property :type plain-list) + (`ordered "ol") + (`unordered "ul") + (`descriptive "dl") + (other (error "Unknown HTML list type: %s" other)))) + (class (format "org-%s" type)) + (attributes (org-export-read-attribute :attr_html plain-list))) + (format "<%s %s>\n%s" + type + (org-html--make-attribute-string + (plist-put attributes :class + (org-trim + (mapconcat #'identity + (list class (plist-get attributes :class)) + " ")))) + contents + type))) ;;;; Plain Text @@ -3267,7 +3328,7 @@ holding contextual information." #'number-to-string (org-export-get-headline-number parent info) "-")))) ;; Build return value. - (format "
    \n%s
    " + (format "
    \n%s
    \n" class-num (or (org-element-property :CUSTOM_ID parent) section-number @@ -3317,11 +3378,14 @@ CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (if (org-export-read-attribute :attr_html src-block :textarea) (org-html--textarea-block src-block) - (let ((lang (org-element-property :language src-block)) + (let* ((lang (org-element-property :language src-block)) (code (org-html-format-code src-block info)) (label (let ((lbl (and (org-element-property :name src-block) (org-export-get-reference src-block info)))) - (if lbl (format " id=\"%s\"" lbl) "")))) + (if lbl (format " id=\"%s\"" lbl) ""))) + (klipsify (and (plist-get info :html-klipsify-src) + (member lang '("javascript" "js" + "ruby" "scheme" "clojure" "php" "html"))))) (if (not lang) (format "
    \n%s
    " label code) (format "
    \n%s%s\n
    " ;; Build caption. @@ -3338,8 +3402,12 @@ contextual information." listing-number (org-trim (org-export-data caption info)))))) ;; Contents. - (format "
    %s
    " - lang label code)))))) + (let ((open (if org-html-keep-old-src "" ""))) + (format "%s class=\"src src-%s\"%s%s>%s%s" + open lang label (if (and klipsify (string= lang "html")) + " data-editor-type=\"html\"" "") + code close))))))) ;;;; Statistics Cookie diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index ecec752862..4783f1158c 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -341,7 +341,7 @@ A headline is blocked when either (1- (length org-icalendar-date-time-format))) ?Z)) (defvar org-agenda-default-appointment-duration) ; From org-agenda.el. -(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) +(defun org-icalendar-convert-timestamp (timestamp keyword &optional end tz) "Convert TIMESTAMP to iCalendar format. TIMESTAMP is a timestamp object. KEYWORD is added in front of @@ -352,8 +352,11 @@ Also increase the hour by two (if time string contains a time), or the day by one (if it does not contain a time) when no explicit ending time is specified. -When optional argument UTC is non-nil, time will be expressed in -Universal Time, ignoring `org-icalendar-date-time-format'." +When optional argument TZ is non-nil, timezone data time will be +added to the timestamp. It can be the string \"UTC\", to use UTC +time, or a string in the IANA TZ database +format (e.g. \"Europe/London\"). In either case, the value of +`org-icalendar-date-time-format' will be ignored." (let* ((year-start (org-element-property :year-start timestamp)) (year-end (org-element-property :year-end timestamp)) (month-start (org-element-property :month-start timestamp)) @@ -387,8 +390,9 @@ Universal Time, ignoring `org-icalendar-date-time-format'." (concat keyword (format-time-string - (cond (utc ":%Y%m%dT%H%M%SZ") + (cond ((string-equal tz "UTC") ":%Y%m%dT%H%M%SZ") ((not with-time-p) ";VALUE=DATE:%Y%m%d") + ((stringp tz) (concat ";TZID=" tz ":%Y%m%dT%H%M%S")) (t (replace-regexp-in-string "%Z" org-icalendar-timezone org-icalendar-date-time-format @@ -396,7 +400,10 @@ Universal Time, ignoring `org-icalendar-date-time-format'." ;; Convert timestamp into internal time in order to use ;; `format-time-string' and fix any mistake (i.e. MI >= 60). (encode-time 0 mi h d m y) - (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))) + (and (or (string-equal tz "UTC") + (and (null tz) + with-time-p + (org-icalendar-use-UTC-date-time-p))) t))))) (defun org-icalendar-dtstamp () @@ -530,7 +537,9 @@ inlinetask within the section." (org-export-data (org-element-property :title entry) info)))) (loc (org-icalendar-cleanup-string - (org-element-property :LOCATION entry))) + (org-export-get-node-property + :LOCATION entry + (org-property-inherit-p "LOCATION")))) ;; Build description of the entry from associated section ;; (headline) or contents (inlinetask). (desc @@ -545,7 +554,10 @@ inlinetask within the section." contents 0 (min (length contents) org-icalendar-include-body)))) (org-icalendar-include-body (org-trim contents))))))) - (cat (org-icalendar-get-categories entry info))) + (cat (org-icalendar-get-categories entry info)) + (tz (org-export-get-node-property + :TIMEZONE entry + (org-property-inherit-p "TIMEZONE")))) (concat ;; Events: Delegate to `org-icalendar--vevent' to generate ;; "VEVENT" component from scheduled, deadline, or any @@ -556,14 +568,14 @@ inlinetask within the section." org-icalendar-use-deadline) (org-icalendar--vevent entry deadline (concat "DL-" uid) - (concat "DL: " summary) loc desc cat))) + (concat "DL: " summary) loc desc cat tz))) (let ((scheduled (org-element-property :scheduled entry))) (and scheduled (memq (if todo-type 'event-if-todo 'event-if-not-todo) org-icalendar-use-scheduled) (org-icalendar--vevent entry scheduled (concat "SC-" uid) - (concat "S: " summary) loc desc cat))) + (concat "S: " summary) loc desc cat tz))) ;; When collecting plain timestamps from a headline and its ;; title, skip inlinetasks since collection will happen once ;; ENTRY is one of them. @@ -581,7 +593,7 @@ inlinetask within the section." ((t) t))) (let ((uid (format "TS%d-%s" (cl-incf counter) uid))) (org-icalendar--vevent - entry ts uid summary loc desc cat)))) + entry ts uid summary loc desc cat tz)))) info nil (and (eq type 'headline) 'inlinetask)) "")) ;; Task: First check if it is appropriate to export it. If @@ -595,7 +607,7 @@ inlinetask within the section." (not (org-icalendar-blocked-headline-p entry info)))) ((t) (eq todo-type 'todo)))) - (org-icalendar--vtodo entry uid summary loc desc cat)) + (org-icalendar--vtodo entry uid summary loc desc cat tz)) ;; Diary-sexp: Collect every diary-sexp element within ENTRY ;; and its title, and transcode them. If ENTRY is ;; a headline, skip inlinetasks: they will be handled @@ -626,7 +638,7 @@ inlinetask within the section." contents)))) (defun org-icalendar--vevent - (entry timestamp uid summary location description categories) + (entry timestamp uid summary location description categories timezone) "Create a VEVENT component. ENTRY is either a headline or an inlinetask element. TIMESTAMP @@ -635,7 +647,8 @@ is the unique identifier for the event. SUMMARY defines a short summary or subject for the event. LOCATION defines the intended venue for the event. DESCRIPTION provides the complete description of the event. CATEGORIES defines the categories the -event belongs to. +event belongs to. TIMEZONE specifies a time zone for this event +only. Return VEVENT component as a string." (org-icalendar-fold-string @@ -645,8 +658,8 @@ Return VEVENT component as a string." (concat "BEGIN:VEVENT\n" (org-icalendar-dtstamp) "\n" "UID:" uid "\n" - (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" - (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" + (org-icalendar-convert-timestamp timestamp "DTSTART" nil timezone) "\n" + (org-icalendar-convert-timestamp timestamp "DTEND" t timezone) "\n" ;; RRULE. (when (org-element-property :repeater-type timestamp) (format "RRULE:FREQ=%s;INTERVAL=%d\n" @@ -664,7 +677,7 @@ Return VEVENT component as a string." "END:VEVENT")))) (defun org-icalendar--vtodo - (entry uid summary location description categories) + (entry uid summary location description categories timezone) "Create a VTODO component. ENTRY is either a headline or an inlinetask element. UID is the @@ -672,6 +685,7 @@ unique identifier for the task. SUMMARY defines a short summary or subject for the task. LOCATION defines the intended venue for the task. DESCRIPTION provides the complete description of the task. CATEGORIES defines the categories the task belongs to. +TIMEZONE specifies a time zone for this TODO only. Return VTODO component as a string." (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) @@ -690,11 +704,11 @@ Return VTODO component as a string." (concat "BEGIN:VTODO\n" "UID:TODO-" uid "\n" (org-icalendar-dtstamp) "\n" - (org-icalendar-convert-timestamp start "DTSTART") "\n" + (org-icalendar-convert-timestamp start "DTSTART" nil timezone) "\n" (and (memq 'todo-due org-icalendar-use-deadline) (org-element-property :deadline entry) (concat (org-icalendar-convert-timestamp - (org-element-property :deadline entry) "DUE") + (org-element-property :deadline entry) "DUE" nil timezone) "\n")) "SUMMARY:" summary "\n" (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) @@ -879,7 +893,7 @@ The file is stored under the name chosen in "Export current agenda view to an iCalendar FILE. This function assumes major mode for current buffer is `org-agenda-mode'." - (let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks + (let* ((org-export-use-babel) ;don't evaluate Babel blocks (contents (org-export-string-as (with-output-to-string @@ -914,43 +928,46 @@ This function assumes major mode for current buffer is (defun org-icalendar--combine-files (&rest files) "Combine entries from multiple files into an iCalendar file. FILES is a list of files to build the calendar from." - (org-agenda-prepare-buffers files) - (unwind-protect - (progn - (with-temp-file org-icalendar-combined-agenda-file - (insert - (org-icalendar--vcalendar - ;; Name. - org-icalendar-combined-name - ;; Owner. - user-full-name - ;; Timezone. - (or (org-string-nw-p org-icalendar-timezone) - (cadr (current-time-zone))) - ;; Description. - org-icalendar-combined-description - ;; Contents. - (concat - ;; Agenda contents. - (mapconcat - (lambda (file) - (catch 'nextfile - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - ;; Create ID if necessary. - (when org-icalendar-store-UID - (org-icalendar-create-uid file t)) - (org-export-as - 'icalendar nil nil t - '(:ascii-charset utf-8 :ascii-links-to-notes nil))))) - files "") - ;; BBDB anniversaries. - (when (and org-icalendar-include-bbdb-anniversaries - (require 'org-bbdb nil t)) - (with-output-to-string (org-bbdb-anniv-export-ical))))))) - (run-hook-with-args 'org-icalendar-after-save-hook - org-icalendar-combined-agenda-file)) - (org-release-buffers org-agenda-new-buffers))) + ;; At the end of the process, all buffers related to FILES are going + ;; to be killed. Make sure to only kill the ones opened in the + ;; process. + (let ((org-agenda-new-buffers nil)) + (unwind-protect + (progn + (with-temp-file org-icalendar-combined-agenda-file + (insert + (org-icalendar--vcalendar + ;; Name. + org-icalendar-combined-name + ;; Owner. + user-full-name + ;; Timezone. + (or (org-string-nw-p org-icalendar-timezone) + (cadr (current-time-zone))) + ;; Description. + org-icalendar-combined-description + ;; Contents. + (concat + ;; Agenda contents. + (mapconcat + (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + ;; Create ID if necessary. + (when org-icalendar-store-UID + (org-icalendar-create-uid file t)) + (org-export-as + 'icalendar nil nil t + '(:ascii-charset utf-8 :ascii-links-to-notes nil))))) + files "") + ;; BBDB anniversaries. + (when (and org-icalendar-include-bbdb-anniversaries + (require 'org-bbdb nil t)) + (with-output-to-string (org-bbdb-anniv-export-ical))))))) + (run-hook-with-args 'org-icalendar-after-save-hook + org-icalendar-combined-agenda-file)) + (org-release-buffers org-agenda-new-buffers)))) (provide 'ox-icalendar) diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index f1a510e98a..61b6b8cca9 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -102,7 +102,8 @@ :filters-alist '((:filter-options . org-latex-math-block-options-filter) (:filter-paragraph . org-latex-clean-invalid-line-breaks) (:filter-parse-tree org-latex-math-block-tree-filter - org-latex-matrices-tree-filter) + org-latex-matrices-tree-filter + org-latex-image-link-filter) (:filter-verse-block . org-latex-clean-invalid-line-breaks)) :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) @@ -726,7 +727,8 @@ environment." :safe #'stringp) (defcustom org-latex-inline-image-rules - '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) + `(("file" . ,(regexp-opt + '("pdf" "jpeg" "jpg" "png" "ps" "eps" "tikz" "pgf" "svg")))) "Rules characterizing image files that can be inlined into LaTeX. A rule consists in an association whose key is the type of link @@ -863,7 +865,7 @@ The function should return the string to be exported. The default function simply returns the value of CONTENTS." :group 'org-export-latex - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -954,7 +956,7 @@ parameter for the listings package. If the mode name and the listings name are the same, the language does not need an entry in this list - but it does not hurt if it is present." :group 'org-export-latex - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type '(repeat (list @@ -1310,14 +1312,19 @@ For non-floats, see `org-latex--wrap-label'." (t (format (if nonfloat "\\captionof{%s}%s{%s%s}\n" "\\caption%s%s{%s%s}\n") - (if nonfloat - (cl-case type - (paragraph "figure") - (src-block (if (plist-get info :latex-listings) - "listing" - "figure")) - (t (symbol-name type))) - "") + (let ((type* (if (eq type 'latex-environment) + (org-latex--environment-type element) + type))) + (if nonfloat + (cl-case type* + (paragraph "figure") + (image "figure") + (special-block "figure") + (src-block (if (plist-get info :latex-listings) + "listing" + "figure")) + (t (symbol-name type*))) + "")) (if short (format "[%s]" (org-export-data short info)) "") label (org-export-data main info)))))) @@ -2250,24 +2257,62 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Latex Environment +(defun org-latex--environment-type (latex-environment) + "Return the TYPE of LATEX-ENVIRONMENT. + +The TYPE is determined from the actual latex environment, and +could be a member of `org-latex-caption-above' or `math'." + (let* ((latex-begin-re "\\\\begin{\\([A-Za-z0-9*]+\\)}") + (value (org-remove-indentation + (org-element-property :value latex-environment))) + (env (or (and (string-match latex-begin-re value) + (match-string 1 value)) + ""))) + (cond + ((string-match-p org-latex-math-environments-re value) 'math) + ((string-match-p + (eval-when-compile + (regexp-opt '("table" "longtable" "tabular" "tabu" "longtabu"))) + env) + 'table) + ((string-match-p "figure" env) 'image) + ((string-match-p + (eval-when-compile + (regexp-opt '("lstlisting" "listing" "verbatim" "minted"))) + env) + 'src-block) + (t 'special-block)))) + (defun org-latex-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. CONTENTS is nil. INFO is a plist holding contextual information." (when (plist-get info :with-latex) - (let ((value (org-remove-indentation - (org-element-property :value latex-environment)))) - (if (not (org-element-property :name latex-environment)) value + (let* ((value (org-remove-indentation + (org-element-property :value latex-environment))) + (type (org-latex--environment-type latex-environment)) + (caption (if (eq type 'math) + (org-latex--label latex-environment info nil t) + (org-latex--caption/label-string latex-environment info))) + (caption-above-p + (memq type (append (plist-get info :latex-caption-above) '(math))))) + (if (not (or (org-element-property :name latex-environment) + (org-element-property :caption latex-environment))) + value ;; Environment is labeled: label must be within the environment ;; (otherwise, a reference pointing to that element will count - ;; the section instead). + ;; the section instead). Also insert caption if `latex-environment' + ;; is not a math environment. (with-temp-buffer (insert value) - (goto-char (point-min)) - (forward-line) - (insert (org-latex--label latex-environment info nil t)) + (if caption-above-p + (progn + (goto-char (point-min)) + (forward-line)) + (goto-char (point-max)) + (forward-line -1)) + (insert caption) (buffer-string)))))) - ;;;; Latex Fragment (defun org-latex-latex-fragment (latex-fragment _contents _info) @@ -2291,6 +2336,9 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link +(defun org-latex-image-link-filter (data _backend info) + (org-export-insert-image-links data info org-latex-inline-image-rules)) + (defun org-latex--inline-image (link info) "Return LaTeX code for an inline image. LINK is the link pointing to the inline image. INFO is a plist @@ -3300,8 +3348,7 @@ This function assumes TABLE has `org' as its `:type' property and (contents (mapconcat (lambda (row) - ;; Ignore horizontal rules. - (when (eq (org-element-property :type row) 'standard) + (if (eq (org-element-property :type row) 'rule) "\\hline" ;; Return each cell unmodified. (concat (mapconcat diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index e2fefa345c..5ba52e7faf 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -248,15 +248,42 @@ a communication channel." "Non-nil when HEADLINE is being referred to. INFO is a plist used as a communication channel. Links and table of contents can refer to headlines." - (or (plist-get info :with-toc) - (org-element-map (plist-get info :parse-tree) 'link - (lambda (link) - (eq headline - (pcase (org-element-property :type link) - ((or "custom-id" "id") (org-export-resolve-id-link link info)) - ("fuzzy" (org-export-resolve-fuzzy-link link info)) - (_ nil)))) - info t))) + (unless (org-element-property :footnote-section-p headline) + (or + ;; Global table of contents includes HEADLINE. + (and (plist-get info :with-toc) + (memq headline + (org-export-collect-headlines info (plist-get info :with-toc)))) + ;; A local table of contents includes HEADLINE. + (cl-some + (lambda (h) + (let ((section (car (org-element-contents h)))) + (and + (eq 'section (org-element-type section)) + (org-element-map section 'keyword + (lambda (keyword) + (when (equal "TOC" (org-element-property :key keyword)) + (let ((case-fold-search t) + (value (org-element-property :value keyword))) + (and (string-match-p "\\" value) + (let ((n (and + (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (local? (string-match-p "\\" value))) + (memq headline + (org-export-collect-headlines + info n (and local? keyword)))))))) + info t)))) + (org-element-lineage headline)) + ;; A link refers internally to HEADLINE. + (org-element-map (plist-get info :parse-tree) 'link + (lambda (link) + (eq headline + (pcase (org-element-property :type link) + ((or "custom-id" "id") (org-export-resolve-id-link link info)) + ("fuzzy" (org-export-resolve-fuzzy-link link info)) + (_ nil)))) + info t)))) (defun org-md--headline-title (style level title &optional anchor tags) "Generate a headline title in the preferred Markdown headline style. @@ -328,9 +355,19 @@ a communication channel." "Transcode a KEYWORD element into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." - (if (member (org-element-property :key keyword) '("MARKDOWN" "MD")) - (org-element-property :value keyword) - (org-export-with-backend 'html keyword contents info))) + (pcase (org-element-property :key keyword) + ((or "MARKDOWN" "MD") (org-element-property :value keyword)) + ("TOC" + (let ((case-fold-search t) + (value (org-element-property :value keyword))) + (cond + ((string-match-p "\\" value) + (let ((depth (and (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (local? (string-match-p "\\" value))) + (org-remove-indentation + (org-md--build-toc info depth keyword local?))))))) + (_ (org-export-with-backend 'html keyword contents info)))) ;;;; Line Break @@ -513,6 +550,61 @@ a communication channel." ;;;; Template +(defun org-md--build-toc (info &optional n keyword local) + "Return a table of contents. + +INFO is a plist used as a communication channel. + +Optional argument N, when non-nil, is an integer specifying the +depth of the table. + +Optional argument KEYWORD specifies the TOC keyword, if any, from +which the table of contents generation has been initiated. + +When optional argument LOCAL is non-nil, build a table of +contents according to the current headline." + (concat + (unless local + (let ((style (plist-get info :md-headline-style)) + (title (org-html--translate "Table of Contents" info))) + (org-md--headline-title style 1 title nil))) + (mapconcat + (lambda (headline) + (let* ((indentation + (make-string + (* 4 (1- (org-export-get-relative-level headline info))) + ?\s)) + (number (format "%d." + (org-last + (org-export-get-headline-number headline info)))) + (bullet (concat number (make-string (- 4 (length number)) ?\s))) + (title + (format "[%s](#%s)" + (org-export-data-with-backend + (org-export-get-alt-title headline info) + ;; Create an anonymous back-end that will + ;; ignore any footnote-reference, link, + ;; radio-target and target in table of + ;; contents. + (org-export-create-backend + :parent 'md + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info) + (or (org-element-property :CUSTOM_ID headline) + (org-export-get-reference headline info)))) + (tags (and (plist-get info :with-tags) + (not (eq 'not-in-toc (plist-get info :with-tags))) + (let ((tags (org-export-get-tags headline info))) + (and tags + (format ":%s:" + (mapconcat #'identity tags ":"))))))) + (concat indentation bullet title tags))) + (org-export-collect-headlines info n (and local keyword)) "\n") + "\n")) + (defun org-md--footnote-formatted (footnote info) "Formats a single footnote entry FOOTNOTE. FOOTNOTE is a cons cell of the form (number . definition). @@ -549,7 +641,8 @@ holding export options." (concat ;; Table of contents. (let ((depth (plist-get info :with-toc))) - (when depth (org-html-toc depth info))) + (when depth + (concat (org-md--build-toc info (and (wholenump depth) depth)) "\n"))) ;; Document contents. contents "\n" diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index f70f5706db..f00fd99fc3 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -85,7 +85,8 @@ :filters-alist '((:filter-parse-tree . (org-odt--translate-latex-fragments org-odt--translate-description-lists - org-odt--translate-list-tables))) + org-odt--translate-list-tables + org-odt--translate-image-links))) :menu-entry '(?o "Export to ODT" ((?o "As ODT file" org-odt-export-to-odt) @@ -655,7 +656,7 @@ The function should return the string to be exported. The default value simply returns the value of CONTENTS." :group 'org-export-odt - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -1870,7 +1871,7 @@ See `org-odt-format-headline-function' for details." (let ((style (if (eq todo-type 'done) "OrgDone" "OrgTodo"))) (format "%s " style todo))) (when priority - (let* ((style (format "OrgPriority-%s" priority)) + (let* ((style (format "OrgPriority-%c" priority)) (priority (format "[#%c]" priority))) (format "%s " style priority))) @@ -3682,6 +3683,11 @@ contextual information." ;;; Filters +;;; Images + +(defun org-odt--translate-image-links (data _backend info) + (org-export-insert-image-links data info org-odt-inline-image-rules)) + ;;;; LaTeX fragments (defun org-odt--translate-latex-fragments (tree _backend info) @@ -3749,6 +3755,7 @@ contextual information." nil display-msg nil processing-type) (goto-char (point-min)) + (skip-chars-forward " \t\n") (org-element-link-parser)))) (if (not (eq 'link (org-element-type link))) (message "LaTeX Conversion failed.") diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index 6c6a29a1f3..7db3a66ee8 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -312,7 +312,8 @@ publishing directory. Return output file name." (org-publish-org-to 'org filename ".org" plist pub-dir) (when (plist-get plist :htmlized-source) - (require 'htmlize) + (or (require 'htmlize nil t) + (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize")) (require 'ox-html) (let* ((org-inhibit-startup t) (htmlize-output-type 'css) diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index bece11a2d1..a975abc487 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -46,9 +46,6 @@ ;;; Variables -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - ;; Here, so you find the variable right before it's used the first time: (defvar org-publish-cache nil "This will cache timestamps and titles for files in publishing projects. @@ -209,18 +206,12 @@ a site-map of files or summary page for a given project. `:sitemap-filename' - Filename for output of sitemap. Defaults to \"sitemap.org\". + Filename for output of site-map. Defaults to \"sitemap.org\". `:sitemap-title' Title of site-map page. Defaults to name of file. - `:sitemap-function' - - Plugin function to use for generation of site-map. Defaults - to `org-publish-org-sitemap', which generates a plain list of - links to all files in the project. - `:sitemap-style' Can be `list' (site-map is just an itemized list of the @@ -228,19 +219,42 @@ a site-map of files or summary page for a given project. structure of the source files is reflected in the site-map). Defaults to `tree'. - `:sitemap-sans-extension' + `:sitemap-format-entry' + + Plugin function used to format entries in the site-map. It + is called with three arguments: the file or directory name + relative to base directory, the site map style and the + current project. It has to return a string. + + Defaults to `org-publish-sitemap-default-entry', which turns + file names into links and use document titles as + descriptions. For specific formatting needs, one can use + `org-publish-find-date', `org-publish-find-title' and + `org-publish-find-property', to retrieve additional + information about published documents. - Remove extension from site-map's file-names. Useful to have - cool URIs (see http://www.w3.org/Provider/Style/URI). - Defaults to nil. + `:sitemap-function' + + Plugin function to use for generation of site-map. It is + called with two arguments: the title of the site-map, as + a string, and a representation of the files involved in the + project, as returned by `org-list-to-lisp'. The latter can + further be transformed using `org-list-to-generic', + `org-list-to-subtree' and alike. It has to return a string. + + Defaults to `org-publish-sitemap-default', which generates + a plain list of links to all files in the project. If you create a site-map file, adjust the sorting like this: `:sitemap-sort-folders' Where folders should appear in the site-map. Set this to - `first' (default) or `last' to display folders first or last, - respectively. Any other value will mix files and folders. + `first' or `last' to display folders first or last, + respectively. When set to `ignore' (default), folders are + ignored altogether. Any other value will mix files and + folders. This variable has no effect when site-map style is + `tree'. `:sitemap-sort-files' @@ -302,17 +316,28 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'symbol) -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. +(defcustom org-publish-sitemap-sort-folders 'ignore + "A symbol, denoting if folders are sorted first in site-maps. + +Possible values are `first', `last', `ignore' and nil. If `first', folders will be sorted before files. If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. +If `ignore', folders do not appear in the site-map. +Any other value will mix files and folders. You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." +`org-publish-project-alist', using `:sitemap-sort-folders'. + +This variable is ignored when site-map style is `tree'." :group 'org-export-publish - :type 'symbol) + :type '(choice + (const :tag "Folders before files" first) + (const :tag "Folders after files" last) + (const :tag "No folder in site-map" ignore) + (const :tag "Mix folders and files" nil)) + :version "26.1" + :package-version '(Org . "9.1") + :safe #'symbolp) (defcustom org-publish-sitemap-sort-ignore-case nil "Non-nil when site-map sorting should ignore case. @@ -322,22 +347,6 @@ You can overwrite this default per project in your :group 'org-export-publish :type 'boolean) -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for printing a date in the sitemap. -See `format-time-string' for allowed formatters." - :group 'org-export-publish - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "Format string for site-map file entry. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-export-publish - :type 'string) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -395,6 +404,15 @@ definition." (plist-get properties property) default))) +(defun org-publish--expand-file-name (file project) + "Return full file name for FILE in PROJECT. +When FILE is a relative file name, it is expanded according to +project base directory. Always return the true name of the file, +ignoring symlinks." + (file-truename + (if (file-name-absolute-p file) file + (expand-file-name file (org-publish-property :base-directory project))))) + (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -402,144 +420,57 @@ This splices all the components into the list." (while (setq p (pop rest)) (if (setq components (plist-get (cdr p) :components)) (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) + (mapcar + (lambda (x) + (or (assoc x org-publish-project-alist) + (user-error "Unknown component %S in project %S" + x (car p)))) + components) rest)) (push p rtn))) (nreverse (delete-dups (delq nil rtn))))) -(defvar org-publish-sitemap-sort-files) -(defvar org-publish-sitemap-sort-folders) -(defvar org-publish-sitemap-ignore-case) -(defvar org-publish-sitemap-requested) -(defvar org-publish-sitemap-date-format) -(defvar org-publish-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) - ;; First we sort files: - (when org-publish-sitemap-sort-files - (pcase org-publish-sitemap-sort-files - (`alphabetically - (let* ((adir (file-directory-p a)) - (aorg (and (string-suffix-p ".org" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-suffix-p ".org" b) (not bdir))) - (A (if aorg (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-publish-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((or `anti-chronologically `chronologically) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval - (if (eq org-publish-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-publish-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (eq org-publish-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (eq org-publish-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 - (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (let ((all-files (if (not recurse) (directory-files base-dir t match) - ;; If RECURSE is non-nil, we want all files - ;; matching MATCH and sub-directories. - (cl-remove-if-not - (lambda (file) - (or (file-directory-p file) - (and match (string-match match file)))) - (directory-files base-dir t))))) - (dolist (f (if (not org-publish-sitemap-requested) all-files - (sort all-files #'org-publish-compare-directory-files))) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 - f recurse match skip-file skip-dir) - (unless (or fd-p ; This is a directory. - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - (cl-pushnew f org-publish-temp-files))))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-publish-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) "sitemap.org")) - (org-publish-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-publish-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-publish-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-publish-sitemap-sort-folders' has an accepted - ;; value. - (unless (memq org-publish-sitemap-sort-folders '(first last)) - (setq org-publish-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (when org-publish-sitemap-requested - (cl-pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (dolist (f include-list org-publish-temp-files) - (cl-pushnew (expand-file-name (concat base-dir f)) - org-publish-temp-files)))) +(defun org-publish-get-base-files (project) + "Return a list of all files in PROJECT." + (let* ((base-dir (file-name-as-directory + (org-publish-property :base-directory project))) + (extension (or (org-publish-property :base-extension project) "org")) + (match (and (not (eq extension 'any)) + (concat "^[^\\.].*\\.\\(" extension "\\)$"))) + (base-files + (cl-remove-if #'file-directory-p + (if (org-publish-property :recursive project) + (directory-files-recursively base-dir match) + (directory-files base-dir t match t))))) + (org-uniquify + (append + ;; Files from BASE-DIR. Apply exclusion filter before adding + ;; included files. + (let ((exclude-regexp (org-publish-property :exclude project))) + (if exclude-regexp + (cl-remove-if + (lambda (f) + ;; Match against relative names, yet BASE-DIR file + ;; names are absolute. + (string-match exclude-regexp + (file-relative-name f base-dir))) + base-files) + base-files)) + ;; Sitemap file. + (and (org-publish-property :auto-sitemap project) + (list (expand-file-name + (or (org-publish-property :sitemap-filename project) + "sitemap.org") + base-dir))) + ;; Included files. + (mapcar (lambda (f) (expand-file-name f base-dir)) + (org-publish-property :include project)))))) (defun org-publish-get-project-from-filename (filename &optional up) "Return a project that FILENAME belongs to. When UP is non-nil, return a meta-project (i.e., with a :components part) publishing FILENAME." - (let* ((filename (expand-file-name filename)) + (let* ((filename (file-truename filename)) (project (cl-some (lambda (p) @@ -656,8 +587,7 @@ Return output file name." -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices +;;; Publishing files, sets of files (defun org-publish-file (filename &optional project no-cache) "Publish file FILENAME from PROJECT. @@ -672,7 +602,7 @@ files, when entire projects are published (see (abbreviate-file-name filename)))) (project-plist (cdr project)) (publishing-function - (pcase (plist-get project-plist :publishing-function) + (pcase (org-publish-property :publishing-function project) (`nil (user-error "No publishing function chosen")) ((and f (pred listp)) f) (f (list f)))) @@ -711,185 +641,262 @@ files, when entire projects are published (see If `:auto-sitemap' is set, publish the sitemap too. If `:makeindex' is set, also produce a file \"theindex.org\"." (dolist (project (org-publish-expand-projects projects)) - (let ((project-plist (cdr project))) - (let ((fun (plist-get project-plist :preparation-function))) - (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) - ((functionp fun) (funcall fun project-plist)))) + (let ((plist (cdr project))) + (let ((fun (org-publish-property :preparation-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist)))) ;; Each project uses its own cache file. (org-publish-initialize-cache (car project)) - (when (plist-get project-plist :auto-sitemap) + (when (org-publish-property :auto-sitemap project) (let ((sitemap-filename - (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function - (or (plist-get project-plist :sitemap-function) - #'org-publish-org-sitemap)) - (org-publish-sitemap-date-format - (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-publish-sitemap-file-entry-format - (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format))) - (funcall sitemap-function project sitemap-filename))) + (or (org-publish-property :sitemap-filename project) + "sitemap.org"))) + (org-publish-sitemap project sitemap-filename))) ;; Publish all files from PROJECT except "theindex.org". Its ;; publishing will be deferred until "theindex.inc" is ;; populated. (let ((theindex (expand-file-name "theindex.org" - (plist-get project-plist :base-directory))) - (exclude-regexp (plist-get project-plist :exclude))) - (dolist (file (org-publish-get-base-files project exclude-regexp)) + (org-publish-property :base-directory project)))) + (dolist (file (org-publish-get-base-files project)) (unless (file-equal-p file theindex) (org-publish-file file project t))) ;; Populate "theindex.inc", if needed, and publish ;; "theindex.org". - (when (plist-get project-plist :makeindex) + (when (org-publish-property :makeindex project) (org-publish-index-generate-theindex - project (plist-get project-plist :base-directory)) + project (org-publish-property :base-directory project)) (org-publish-file theindex project t))) - (let ((fun (plist-get project-plist :completion-function))) - (cond ((consp fun) (dolist (f fun) (funcall f project-plist))) - ((functionp fun) (funcall fun project-plist)))) - (org-publish-write-cache-file)))) + (let ((fun (org-publish-property :completion-function project))) + (cond + ((consp fun) (dolist (f fun) (funcall f plist))) + ((functionp fun) (funcall fun plist))))) + (org-publish-write-cache-file))) -(defun org-publish-org-sitemap (project &optional sitemap-filename) + +;;; Site map generation + +(defun org-publish--sitemap-files-to-lisp (files project style format-entry) + "Represent FILES as a parsed plain list. +FILES is the list of files in the site map. PROJECT is the +current project. STYLE determines is either `list' or `tree'. +FORMAT-ENTRY is a function called on each file which should +return a string. Return value is a list as returned by +`org-list-to-lisp'." + (let ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project))))) + (pcase style + (`list + (cons 'unordered + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + files))) + (`tree + (letrec ((files-only (cl-remove-if #'directory-name-p files)) + (directories (cl-remove-if-not #'directory-name-p files)) + (subtree-to-list + (lambda (dir) + (cons 'unordered + (nconc + ;; Files in DIR. + (mapcar + (lambda (f) + (list (funcall format-entry + (file-relative-name f root) + style + project))) + (cl-remove-if-not + (lambda (f) (string= dir (file-name-directory f))) + files-only)) + ;; Direct sub-directories. + (mapcar + (lambda (sub) + (list (funcall format-entry + (file-relative-name sub root) + style + project) + (funcall subtree-to-list sub))) + (cl-remove-if-not + (lambda (f) + (string= + dir + ;; Parent directory. + (file-name-directory (directory-file-name f)))) + directories))))))) + (funcall subtree-to-list root))) + (_ (user-error "Unknown site-map style: `%s'" style))))) + +(defun org-publish-sitemap (project &optional sitemap-filename) "Create a sitemap of pages in set defined by PROJECT. Optionally set the filename of the sitemap with SITEMAP-FILENAME. Default for SITEMAP-FILENAME is `sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\s)) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse - (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension - (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - file sitemap-buffer) - (with-current-buffer - (let ((org-inhibit-startup t)) - (setq sitemap-buffer - (or visiting (find-file sitemap-filename)))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (file-equal-p sitemap-filename file) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry - org-publish-sitemap-file-entry-format file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec - fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-publish-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) - (with-current-buffer buffer - (let ((title - (let ((property - (plist-get - ;; protect local variables in open buffers - (if visiting - (org-export-with-buffer-copy (org-export-get-environment)) - (org-export-get-environment)) - :title))) - (if property - (org-no-properties (org-element-interpret-data property)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. + (let* ((root (expand-file-name + (file-name-as-directory + (org-publish-property :base-directory project)))) + (sitemap-filename (concat root (or sitemap-filename "sitemap.org"))) + (title (or (org-publish-property :sitemap-title project) + (concat "Sitemap for project " (car project)))) + (style (or (org-publish-property :sitemap-style project) + 'tree)) + (sitemap-builder (or (org-publish-property :sitemap-function project) + #'org-publish-sitemap-default)) + (format-entry (or (org-publish-property :sitemap-format-entry project) + #'org-publish-sitemap-default-entry)) + (sort-folders + (org-publish-property :sitemap-sort-folders project + org-publish-sitemap-sort-folders)) + (sort-files + (org-publish-property :sitemap-sort-files project + org-publish-sitemap-sort-files)) + (ignore-case + (org-publish-property :sitemap-ignore-case project + org-publish-sitemap-sort-ignore-case)) + (org-file-p (lambda (f) (equal "org" (file-name-extension f)))) + (sort-predicate + (lambda (a b) + (let ((retval t)) + ;; First we sort files: + (pcase sort-files + (`alphabetically + (let ((A (if (funcall org-file-p a) + (concat (file-name-directory a) + (org-publish-find-title a project)) + a)) + (B (if (funcall org-file-p b) + (concat (file-name-directory b) + (org-publish-find-title b project)) + b))) + (setq retval + (if ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((or `anti-chronologically `chronologically) + (let* ((adate (org-publish-find-date a project)) + (bdate (org-publish-find-date b project)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval + (if (eq sort-files 'chronologically) + (<= A B) + (>= A B))))) + (`nil nil) + (_ (user-error "Invalid sort value %s" sort-files))) + ;; Directory-wise wins: + (when (memq sort-folders '(first last)) + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (eq sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (eq sort-folders 'last))))) + retval)))) + (message "Generating sitemap for %s" title) + (with-temp-file sitemap-filename + (insert + (let ((files (remove sitemap-filename + (org-publish-get-base-files project)))) + ;; Add directories, if applicable. + (unless (and (eq style 'list) (eq sort-folders 'ignore)) + (setq files + (nconc (remove root (org-uniquify + (mapcar #'file-name-directory files))) + files))) + ;; Eventually sort all entries. + (when (or sort-files (not (memq sort-folders 'ignore))) + (setq files (sort files sort-predicate))) + (funcall sitemap-builder + title + (org-publish--sitemap-files-to-lisp + files project style format-entry))))))) + +(defun org-publish-find-property (file property project &optional backend) + "Find the PROPERTY of FILE in project. + +PROPERTY is a keyword referring to an export option, as defined +in `org-export-options-alist' or in export back-ends. In the +latter case, optional argument BACKEND has to be set to the +back-end where the option is defined, e.g., + + (org-publish-find-property file :subtitle 'latex) + +Return value may be a string or a list, depending on the type of +PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." + (let ((file (org-publish--expand-file-name file project))) + (when (and (file-readable-p file) (not (directory-name-p file))) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (plist-get (with-current-buffer buffer + (if (not visiting) (org-export-get-environment backend) + ;; Protect local variables in open buffers. + (org-export-with-buffer-copy + (org-export-get-environment backend)))) + property) + (unless visiting (kill-buffer buffer))))))) + +(defun org-publish-find-title (file project) + "Find the title of FILE in PROJECT." + (let ((file (org-publish--expand-file-name file project))) + (or (org-publish-cache-get-file-property file :title nil t) + (let* ((parsed-title (org-publish-find-property file :title project)) + (title + (if parsed-title + ;; Remove property so that the return value is + ;; cache-able (i.e., it can be `read' back). + (org-no-properties + (org-element-interpret-data parsed-title)) + (file-name-nondirectory (file-name-sans-extension file))))) + (org-publish-cache-set-file-property file :title title) + title)))) + +(defun org-publish-find-date (file project) + "Find the date of FILE in PROJECT. This function assumes FILE is either a directory or an Org file. If FILE is an Org file and provides a DATE keyword use it. In any other case use the file system's modification time. Return time in `current-time' format." - (if (file-directory-p file) (nth 5 (file-attributes file)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (file-buf (or visiting (find-file-noselect file nil))) - (date (plist-get - (with-current-buffer file-buf - (if visiting - (org-export-with-buffer-copy - (org-export-get-environment)) - (org-export-get-environment))) - :date))) - (unless visiting (kill-buffer file-buf)) - ;; DATE is a secondary string. If it contains a timestamp, - ;; convert it to internal format. Otherwise, use FILE - ;; modification time. - (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) - (and ts - (let ((value (org-element-interpret-data ts))) - (and (org-string-nw-p value) - (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) - (t (error "No such file: \"%s\"" file)))))) - + (let ((file (org-publish--expand-file-name file project))) + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let ((date (org-publish-find-property file :date project))) + ;; DATE is a secondary string. If it contains a time-stamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file))))))) + +(defun org-publish-sitemap-default-entry (entry style project) + "Default format for site map ENTRY, as a string. +ENTRY is a file name. STYLE is the style of the sitemap. +PROJECT is the current project." + (cond ((not (directory-name-p entry)) + (format "[[file:%s][%s]]" + entry + (org-publish-find-title entry project))) + ((eq style 'tree) + ;; Return only last subdir. + (file-name-nondirectory (directory-file-name entry))) + (t entry))) + +(defun org-publish-sitemap-default (title list) + "Default site map, as a string. +TITLE is the the title of the site map. LIST is an internal +representation for the files to include, as returned by +`org-list-to-lisp'. PROJECT is the current project." + (concat "#+TITLE: " title "\n\n" + (org-list-to-org list))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1033,8 +1040,7 @@ its CDR is a string." "Retrieve full index from cache and build \"theindex.org\". PROJECT is the project the index relates to. DIRECTORY is the publishing directory." - (let ((all-files (org-publish-get-base-files - project (plist-get (cdr project) :exclude))) + (let ((all-files (org-publish-get-base-files project)) full-index) ;; Compile full index and sort it alphabetically. (dolist (file all-files diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index f70b7c4c82..b5903a5216 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -113,7 +113,7 @@ (:texinfo-link-with-unknown-path-format nil nil org-texinfo-link-with-unknown-path-format) (:texinfo-tables-verbatim nil nil org-texinfo-tables-verbatim) (:texinfo-table-scientific-notation nil nil org-texinfo-table-scientific-notation) - (:texinfo-def-table-markup nil nil org-texinfo-def-table-markup) + (:texinfo-table-default-markup nil nil org-texinfo-table-default-markup) (:texinfo-text-markup-alist nil nil org-texinfo-text-markup-alist) (:texinfo-format-drawer-function nil nil org-texinfo-format-drawer-function) (:texinfo-format-inlinetask-function nil nil org-texinfo-format-inlinetask-function))) @@ -146,17 +146,19 @@ If nil it will default to `buffer-file-coding-system'." (defcustom org-texinfo-classes '(("info" "@documentencoding AUTO\n@documentlanguage AUTO" - ("@chapter %s" . "@unnumbered %s") - ("@section %s" . "@unnumberedsec %s") - ("@subsection %s" . "@unnumberedsubsec %s") - ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) + ("@chapter %s" "@unnumbered %s" "@appendix %s") + ("@section %s" "@unnumberedsec %s" "@appendixsec %s") + ("@subsection %s" "@unnumberedsubsec %s" "@appendixsubsec %s") + ("@subsubsection %s" "@unnumberedsubsubsec %s" "@appendixsubsubsec %s"))) "Alist of Texinfo classes and associated header and structure. If #+TEXINFO_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: +associated information. Here is the structure of a class +definition: (class-name header-string - (numbered-section . unnumbered-section) + (numbered-1 unnumbered-1 appendix-1) + (numbered-2 unnumbered-2 appendix-2) ...) @@ -188,25 +190,19 @@ The sectioning structure The sectioning structure of the class is given by the elements following the header string. For each sectioning level, a number of strings is specified. A %s formatter is mandatory in each -section string and will be replaced by the title of the section. - -Instead of a list of sectioning commands, you can also specify -a function name. That function will be called with two -parameters, the reduced) level of the headline, and a predicate -non-nil when the headline should be numbered. It must return -a format string in which the section title will be added." +section string and will be replaced by the title of the section." :group 'org-export-texinfo - :version "24.4" - :package-version '(Org . "8.2") + :version "26.1" + :package-version '(Org . "9.1") :type '(repeat (list (string :tag "Texinfo class") (string :tag "Texinfo header") (repeat :tag "Levels" :inline t (choice - (cons :tag "Heading" + (list :tag "Heading" (string :tag " numbered") - (string :tag "unnumbered")) - (function :tag "Hook computing sectioning")))))) + (string :tag "unnumbered") + (string :tag " appendix"))))))) ;;;; Headline @@ -279,37 +275,42 @@ When nil, no transformation is made." (string :tag "Format string") (const :tag "No formatting" nil))) -(defcustom org-texinfo-def-table-markup "@samp" +(defcustom org-texinfo-table-default-markup "@asis" "Default markup for first column in two-column tables. This should an indicating command, e.g., \"@code\", \"@kbd\" or -\"@asis\". +\"@samp\". It can be overridden locally using the \":indic\" attribute." :group 'org-export-texinfo - :type 'string) + :type 'string + :version "26.1" + :package-version '(Org . "9.1") + :safe #'stringp) ;;;; Text markup (defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") (code . code) (italic . "@emph{%s}") - (verbatim . verb)) + (verbatim . samp)) "Alist of Texinfo expressions to convert text markup. The key must be a symbol among `bold', `code', `italic', `strike-through', `underscore' and `verbatim'. The value is a formatting string to wrap fontified text with. -Value can also be set to the following symbols: `verb' and -`code'. For the former, Org will use \"@verb\" to create -a format string and select a delimiter character that isn't in -the string. For the latter, Org will use \"@code\" to typeset -and try to protect special characters. +Value can also be set to the following symbols: `verb', `samp' +and `code'. With the first one, Org uses \"@verb\" to create +a format string and selects a delimiter character that isn't in +the string. For the other two, Org uses \"@samp\" or \"@code\" +to typeset and protects special characters. -If no association can be found for a given markup, text will be -returned as-is." +When no association is found for a given markup, text is returned +as-is." :group 'org-export-texinfo + :version "26.1" + :package-version '(Org . "9.1") :type 'alist :options '(bold code italic strike-through underscore verbatim)) @@ -350,7 +351,7 @@ The function should return the string to be exported." ;;;; Compilation -(defcustom org-texinfo-info-process '("makeinfo %f") +(defcustom org-texinfo-info-process '("makeinfo --no-split %f") "Commands to process a Texinfo file to an INFO file. This is a list of strings, each of them will be given to the @@ -360,6 +361,8 @@ base name (i.e. without directory and extension parts), %o by the base directory of the file and %O by the absolute file name of the output file." :group 'org-export-texinfo + :version "26.1" + :package-version '(Org . "9.1") :type '(repeat :tag "Shell command sequence" (string :tag "Shell command"))) @@ -444,13 +447,12 @@ This is used to choose a separator for constructs like \\verb." INFO is a plist used as a communication channel. See `org-texinfo-text-markup-alist' for details." (pcase (cdr (assq markup org-texinfo-text-markup-alist)) - ;; No format string: Return raw text. - (`nil text) + (`nil text) ;no markup: return raw text + (`code (format "@code{%s}" (org-texinfo--sanitize-content text))) + (`samp (format "@samp{%s}" (org-texinfo--sanitize-content text))) (`verb (let ((separator (org-texinfo--find-verb-separator text))) - (concat "@verb{" separator text separator "}"))) - (`code - (format "@code{%s}" (replace-regexp-in-string "[@{}]" "@\\&" text))) + (format "@verb{%s%s%s}" separator text separator))) ;; Else use format string. (fmt (format fmt text)))) @@ -786,8 +788,9 @@ holding contextual information." "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (format "@verbatim\n%s@end verbatim" - (org-export-format-code-default example-block info))) + (format "@example\n%s@end example" + (org-texinfo--sanitize-content + (org-export-format-code-default example-block info)))) ;;; Export Block @@ -828,82 +831,75 @@ plist holding contextual information." ;;;; Headline +(defun org-texinfo--structuring-command (headline info) + "Return Texinfo structuring command string for HEADLINE element. +Return nil if HEADLINE is to be ignored, `plain-list' if it +should be exported as a plain-list item. INFO is a plist holding +contextual information." + (cond + ((org-element-property :footnote-section-p headline) nil) + ((org-not-nil (org-export-get-node-property :COPYING headline t)) nil) + ((org-export-low-level-p headline info) 'plain-list) + (t + (let ((class (plist-get info :texinfo-class))) + (pcase (assoc class (plist-get info :texinfo-classes)) + (`(,_ ,_ . ,sections) + (pcase (nth (1- (org-export-get-relative-level headline info)) + sections) + (`(,numbered ,unnumbered ,appendix) + (cond + ((org-not-nil (org-export-get-node-property :APPENDIX headline t)) + appendix) + ((org-not-nil (org-export-get-node-property :INDEX headline t)) + unnumbered) + ((org-export-numbered-headline-p headline info) numbered) + (t unnumbered))) + (`nil 'plain-list) + (_ (user-error "Invalid Texinfo class specification: %S" class)))) + (_ (user-error "Invalid Texinfo class specification: %S" class))))))) + (defun org-texinfo-headline (headline contents info) "Transcode a HEADLINE element from Org to Texinfo. CONTENTS holds the contents of the headline. INFO is a plist holding contextual information." - (let* ((class (plist-get info :texinfo-class)) - (level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - (class-sectioning (assoc class (plist-get info :texinfo-classes))) - ;; Find the index type, if any. - (index (org-element-property :INDEX headline)) - ;; Create node info, to insert it before section formatting. - ;; Use custom menu title if present. - (node (format "@node %s\n" (org-texinfo--get-node headline info))) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (if (org-not-nil (org-element-property :APPENDIX headline)) - "@appendix %s\n%s" - (let ((sec (if (and (symbolp (nth 2 class-sectioning)) - (fboundp (nth 2 class-sectioning))) - (funcall (nth 2 class-sectioning) level numberedp) - (nth (1+ level) class-sectioning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. - ((stringp sec) sec) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (concat (if (or index (not numberedp)) (cdr sec) (car sec)) - "\n%s")))))) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-texinfo--sanitize-title - (org-element-property :title headline) info)) - (full-text (funcall (plist-get info :texinfo-format-headline-function) - todo todo-type priority text tags)) - (contents (if (org-string-nw-p contents) (concat "\n" contents) ""))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2: This is the `copying' section: ignore it - ;; This is used elsewhere. - ((org-not-nil (org-element-property :COPYING headline)) nil) - ;; Case 3: An index. If it matches one of the known indexes, - ;; print it as such following the contents, otherwise - ;; print the contents and leave the index up to the user. - (index - (concat node - (format - section-fmt - full-text - (concat contents - (and (member index '("cp" "fn" "ky" "pg" "tp" "vr")) - (concat "\n@printindex " index)))))) - ;; Case 4: This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((or (not section-fmt) (org-export-low-level-p headline info)) - ;; Build the real contents of the sub-tree. - (concat (and (org-export-first-sibling-p headline info) - (format "@%s\n" (if numberedp 'enumerate 'itemize))) - "@item\n" full-text "\n" - contents - (if (org-export-last-sibling-p headline info) - (format "@end %s" (if numberedp 'enumerate 'itemize)) - "\n"))) - ;; Case 5: Standard headline. Export it as a section. - (t (concat node (format section-fmt full-text contents)))))) + (let ((section-fmt (org-texinfo--structuring-command headline info))) + (when section-fmt + (let* ((todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-texinfo--sanitize-title + (org-element-property :title headline) info)) + (full-text + (funcall (plist-get info :texinfo-format-headline-function) + todo todo-type priority text tags)) + (contents + (concat "\n" + (if (org-string-nw-p contents) + (concat "\n" contents) + "") + (let ((index (org-element-property :INDEX headline))) + (and (member index '("cp" "fn" "ky" "pg" "tp" "vr")) + (format "\n@printindex %s\n" index)))))) + (cond + ((eq section-fmt 'plain-list) + (let ((numbered? (org-export-numbered-headline-p headline info))) + (concat (and (org-export-first-sibling-p headline info) + (format "@%s\n" (if numbered? 'enumerate 'itemize))) + "@item\n" full-text "\n" + contents + (if (org-export-last-sibling-p headline info) + (format "@end %s" (if numbered? 'enumerate 'itemize)) + "\n")))) + (t + (concat (format "@node %s\n" (org-texinfo--get-node headline info)) + (format section-fmt full-text) + contents))))))) (defun org-texinfo-format-headline-default-function (todo _todo-type priority text tags) @@ -920,9 +916,9 @@ See `org-texinfo-format-headline-function' for details." "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let* ((code (org-element-property :value inline-src-block)) - (separator (org-texinfo--find-verb-separator code))) - (concat "@verb{" separator code separator "}"))) + (format "@code{%s}" + (org-texinfo--sanitize-content + (org-element-property :value inline-src-block)))) ;;;; Inlinetask @@ -967,10 +963,26 @@ contextual information." "Transcode an ITEM element from Org to Texinfo. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (format "@item%s\n%s" - (let ((tag (org-element-property :tag item))) - (if tag (concat " " (org-export-data tag info)) "")) - (or contents ""))) + (let* ((tag (org-element-property :tag item)) + (split (org-string-nw-p + (org-export-read-attribute :attr_texinfo + (org-element-property :parent item) + :sep))) + (items (and tag + (let ((tag (org-export-data tag info))) + (if split + (split-string tag (regexp-quote split) t "[ \t\n]+") + (list tag)))))) + (format "%s\n%s" + (pcase items + (`nil "@item") + (`(,item) (concat "@item " item)) + (`(,item . ,items) + (concat "@item " item "\n" + (mapconcat (lambda (i) (concat "@itemx " i)) + items + "\n")))) + (or contents "")))) ;;;; Keyword @@ -1073,14 +1085,8 @@ INFO is a plist holding contextual information. See (pcase (org-export-get-ordinal destination info) ((and (pred integerp) n) (number-to-string n)) ((and (pred consp) n) (mapconcat #'number-to-string n ".")) - (_ "???"))) - info))))) ;cannot guess the description - ((equal type "info") - (let* ((info-path (split-string path "[:#]")) - (info-manual (car info-path)) - (info-node (or (cadr info-path) "Top")) - (title (or desc ""))) - (format "@ref{%s,%s,,%s,}" info-node title info-manual))) + (_ "???"))) ;cannot guess the description + info))))) ((string= type "mailto") (format "@email{%s}" (concat (org-texinfo--sanitize-content path) @@ -1210,13 +1216,10 @@ holding contextual information." (cached-entries (gethash scope cache 'no-cache))) (if (not (eq cached-entries 'no-cache)) cached-entries (puthash scope - (org-element-map (org-element-contents scope) 'headline - (lambda (h) - (and (not (org-not-nil (org-element-property :COPYING h))) - (not (org-element-property :footnote-section-p h)) - (not (org-export-low-level-p h info)) - h)) - info nil 'headline) + (cl-remove-if + (lambda (h) + (org-not-nil (org-export-get-node-property :COPYING h t))) + (org-export-collect-headlines info 1 scope)) cache)))) ;;;; Node Property @@ -1246,7 +1249,7 @@ CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) (indic (let ((i (or (plist-get attr :indic) - (plist-get info :texinfo-def-table-markup)))) + (plist-get info :texinfo-table-default-markup)))) ;; Allow indicating commands with missing @ sign. (if (string-prefix-p "@" i) i (concat "@" i)))) (table-type (plist-get attr :table-type)) @@ -1570,6 +1573,7 @@ contextual information." ;;; Interactive functions +;;;###autoload (defun org-texinfo-export-to-texinfo (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to a Texinfo file. @@ -1604,6 +1608,7 @@ Return output file's name." (org-export-to-file 'texinfo outfile async subtreep visible-only body-only ext-plist))) +;;;###autoload (defun org-texinfo-export-to-info (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to Texinfo then process through to INFO. diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 4e85066eec..1c43577cdd 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -437,11 +437,7 @@ e.g. \"d:nil\"." (repeat :tag "Specify names of drawers to ignore during export" :inline t (string :tag "Drawer name")))) - :safe (lambda (x) (or (booleanp x) - (and (listp x) - (or (cl-every #'stringp x) - (and (eq (nth 0 x) 'not) - (cl-every #'stringp (cdr x)))))))) + :safe (lambda (x) (or (booleanp x) (consp x)))) (defcustom org-export-with-email nil "Non-nil means insert author email into the exported file. @@ -598,7 +594,7 @@ properties to export, as strings. This option can also be set with the OPTIONS keyword, e.g. \"prop:t\"." :group 'org-export-general - :version "24.4" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "All properties" t) @@ -883,6 +879,29 @@ HTML code while every other back-end will ignore it." (cl-every #'stringp (mapcar #'car x)) (cl-every #'stringp (mapcar #'cdr x))))) +(defcustom org-export-global-macros nil + "Alist between macro names and expansion templates. + +This variable defines macro expansion templates available +globally. Associations follow the pattern + + (NAME . TEMPLATE) + +where NAME is a string beginning with a letter and consisting of +alphanumeric characters only. + +TEMPLATE is the string to which the macro is going to be +expanded. Inside, \"$1\", \"$2\"... are place-holders for +macro's arguments. Moreover, if the template starts with +\"(eval\", it will be parsed as an Elisp expression and evaluated +accordingly." + :group 'org-export-general + :version "26.1" + :package-version '(Org . "9.1") + :type '(repeat + (cons (string :tag "Name") + (string :tag "Template")))) + (defcustom org-export-coding-system nil "Coding system for the exported file." :group 'org-export-general @@ -1433,7 +1452,7 @@ for export. Return options as a plist." (parse (org-element-parse-secondary-string value (org-element-restriction 'keyword))) - (split (org-split-string value)) + (split (split-string value)) (t value)))))))))))) (defun org-export--get-inbuffer-options (&optional backend) @@ -1476,17 +1495,20 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (cond ;; Options in `org-export-special-keywords'. ((equal key "SETUPFILE") - (let ((file - (expand-file-name - (org-unbracket-string "\"" "\"" (org-trim val))))) + (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val))) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) ;; Avoid circular dependencies. - (unless (member file files) + (unless (member uri files) (with-temp-buffer - (setq default-directory - (file-name-directory file)) - (insert (org-file-contents file 'noerror)) + (unless uri-is-url + (setq default-directory + (file-name-directory uri))) + (insert (org-file-contents uri 'noerror)) (let ((org-inhibit-startup t)) (org-mode)) - (funcall get-options (cons file files)))))) + (funcall get-options (cons uri files)))))) ((equal key "OPTIONS") (setq plist (org-combine-plists @@ -1538,7 +1560,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." "\n" (org-trim val)))) (split `(,@(plist-get plist property) - ,@(org-split-string val))) + ,@(split-string val))) ((t) val) (otherwise (if (not (plist-member plist property)) val @@ -1624,17 +1646,22 @@ an alist where associations are (VARIABLE-NAME VALUE)." "BIND") (push (read (format "(%s)" val)) alist) ;; Enter setup file. - (let ((file (expand-file-name - (org-unbracket-string "\"" "\"" val)))) - (unless (member file files) + (let* ((uri (org-unbracket-string "\"" "\"" val)) + (uri-is-url (org-file-url-p uri)) + (uri (if uri-is-url + uri + (expand-file-name uri)))) + ;; Avoid circular dependencies. + (unless (member uri files) (with-temp-buffer - (setq default-directory - (file-name-directory file)) + (unless uri-is-url + (setq default-directory + (file-name-directory uri))) (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents file 'noerror)) + (insert (org-file-contents uri 'noerror)) (setq alist (funcall collect-bind - (cons file files) + (cons uri files) alist)))))))))) alist))))) ;; Return value in appropriate order of appearance. @@ -3010,13 +3037,15 @@ Return code as a string." (org-export-expand-include-keyword) (org-export--delete-comment-trees) (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates nil parsed-keywords) + (org-macro-replace-all + (append org-macro-templates org-export-global-macros) + nil parsed-keywords) ;; Refresh buffer properties and radio targets after ;; potentially invasive previous changes. Likewise, do it ;; again after executing Babel code. (org-set-regexps-and-options) (org-update-radio-target-regexp) - (when org-export-babel-evaluate + (when org-export-use-babel (org-babel-exp-process-buffer) (org-set-regexps-and-options) (org-update-radio-target-regexp)) @@ -3254,116 +3283,119 @@ storing and resolving footnotes. It is created automatically." ;; Expand INCLUDE keywords. (goto-char (point-min)) (while (re-search-forward include-re nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (eq (org-element-type element) 'keyword) - (beginning-of-line) - ;; Extract arguments from keyword's value. - (let* ((value (org-element-property :value element)) - (ind (org-get-indentation)) - location - (file - (and (string-match - "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) - (prog1 - (save-match-data - (let ((matched (match-string 1 value))) - (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" - matched) - (setq location (match-string 2 matched)) - (setq matched - (replace-match "" nil nil matched 1))) - (expand-file-name - (org-unbracket-string "\"" "\"" matched) - dir))) - (setq value (replace-match "" nil nil value))))) - (only-contents - (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" - value) - (prog1 (org-not-nil (match-string 1 value)) - (setq value (replace-match "" nil nil value))))) - (lines - (and (string-match - ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" - value) - (prog1 (match-string 1 value) - (setq value (replace-match "" nil nil value))))) - (env (cond - ((string-match "\\" value) 'literal) - ((string-match "\\" value) - (match-string 1 value)))) - ;; Remove keyword. - (delete-region (point) (line-beginning-position 2)) - (cond - ((not file) nil) - ((not (file-readable-p file)) - (error "Cannot include file %s" file)) - ;; Check if files has already been parsed. Look after - ;; inclusion lines too, as different parts of the same file - ;; can be included too. - ((member (list file lines) included) - (error "Recursive file inclusion: %s" file)) - (t + (unless (org-in-commented-heading-p) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (org-element-property :value element)) + (ind (org-get-indentation)) + location + (file + (and (string-match + "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) + (prog1 + (save-match-data + (let ((matched (match-string 1 value))) + (when (string-match "\\(::\\(.*?\\)\\)\"?\\'" + matched) + (setq location (match-string 2 matched)) + (setq matched + (replace-match "" nil nil matched 1))) + (expand-file-name + (org-unbracket-string "\"" "\"" matched) + dir))) + (setq value (replace-match "" nil nil value))))) + (only-contents + (and (string-match ":only-contents *\\([^: \r\t\n]\\S-*\\)?" + value) + (prog1 (org-not-nil (match-string 1 value)) + (setq value (replace-match "" nil nil value))))) + (lines + (and (string-match + ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" + value) + (prog1 (match-string 1 value) + (setq value (replace-match "" nil nil value))))) + (env (cond + ((string-match "\\" value) 'literal) + ((string-match "\\" value) + (match-string 1 value)))) + ;; Remove keyword. + (delete-region (point) (line-beginning-position 2)) (cond - ((eq env 'literal) - (insert - (let ((ind-str (make-string ind ?\s)) - (arg-str (if (stringp args) (format " %s" args) "")) - (contents - (org-escape-code-in-string - (org-export--prepare-file-contents file lines)))) - (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" - ind-str block arg-str contents ind-str block)))) - ((stringp block) - (insert - (let ((ind-str (make-string ind ?\s)) - (contents - (org-export--prepare-file-contents file lines))) - (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" - ind-str block contents ind-str block)))) + ((not file) nil) + ((not (file-readable-p file)) + (error "Cannot include file %s" file)) + ;; Check if files has already been parsed. Look after + ;; inclusion lines too, as different parts of the same + ;; file can be included too. + ((member (list file lines) included) + (error "Recursive file inclusion: %s" file)) (t - (insert - (with-temp-buffer - (let ((org-inhibit-startup t) - (lines - (if location - (org-export--inclusion-absolute-lines - file location only-contents lines) - lines))) - (org-mode) - (insert - (org-export--prepare-file-contents - file lines ind minlevel - (or (gethash file file-prefix) - (puthash file (cl-incf current-prefix) file-prefix)) - footnotes))) - (org-export-expand-include-keyword - (cons (list file lines) included) - (file-name-directory file) - footnotes) - (buffer-string))))) - ;; Expand footnotes after all files have been included. - ;; Footnotes are stored at end of buffer. - (unless included - (org-with-wide-buffer - (goto-char (point-max)) - (maphash (lambda (k v) (insert (format "\n[fn:%s] %s\n" k v))) - footnotes))))))))))) + (cond + ((eq env 'literal) + (insert + (let ((ind-str (make-string ind ?\s)) + (arg-str (if (stringp args) (format " %s" args) "")) + (contents + (org-escape-code-in-string + (org-export--prepare-file-contents file lines)))) + (format "%s#+BEGIN_%s%s\n%s%s#+END_%s\n" + ind-str block arg-str contents ind-str block)))) + ((stringp block) + (insert + (let ((ind-str (make-string ind ?\s)) + (contents + (org-export--prepare-file-contents file lines))) + (format "%s#+BEGIN_%s\n%s%s#+END_%s\n" + ind-str block contents ind-str block)))) + (t + (insert + (with-temp-buffer + (let ((org-inhibit-startup t) + (lines + (if location + (org-export--inclusion-absolute-lines + file location only-contents lines) + lines))) + (org-mode) + (insert + (org-export--prepare-file-contents + file lines ind minlevel + (or + (gethash file file-prefix) + (puthash file (cl-incf current-prefix) file-prefix)) + footnotes))) + (org-export-expand-include-keyword + (cons (list file lines) included) + (file-name-directory file) + footnotes) + (buffer-string))))) + ;; Expand footnotes after all files have been + ;; included. Footnotes are stored at end of buffer. + (unless included + (org-with-wide-buffer + (goto-char (point-max)) + (maphash (lambda (k v) + (insert (format "\n[fn:%s] %s\n" k v))) + footnotes)))))))))))) (defun org-export--inclusion-absolute-lines (file location only-contents lines) "Resolve absolute lines for an included file with file-link. @@ -4134,12 +4166,56 @@ the provided rules is non-nil. The default rule is This only applies to links without a description." (and (not (org-element-contents link)) (let ((case-fold-search t)) - (catch 'exit - (dolist (rule (or rules org-export-default-inline-image-rule)) - (and (string= (org-element-property :type link) (car rule)) - (string-match-p (cdr rule) - (org-element-property :path link)) - (throw 'exit t))))))) + (cl-some (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match-p (cdr rule) + (org-element-property :path link)))) + (or rules org-export-default-inline-image-rule))))) + +(defun org-export-insert-image-links (data info &optional rules) + "Insert image links in DATA. + +Org syntax does not support nested links. Nevertheless, some +export back-ends support images as descriptions of links. Since +images are really links to image files, we need to make an +exception about links nesting. + +This function recognizes links whose contents are really images +and turn them into proper nested links. It is meant to be used +as a parse tree filter in back-ends supporting such constructs. + +DATA is a parse tree. INFO is the current state of the export +process, as a plist. + +A description is a valid images if it matches any rule in RULES, +if non-nil, or `org-export-default-inline-image-rule' otherwise. +See `org-export-inline-image-p' for more information about the +structure of RULES. + +Return modified DATA." + (let ((link-re (format "\\`\\(?:%s\\|%s\\)\\'" + org-plain-link-re + org-angle-link-re)) + (case-fold-search t)) + (org-element-map data 'link + (lambda (l) + (let ((contents (org-element-interpret-data (org-element-contents l)))) + (when (and (org-string-nw-p contents) + (string-match link-re contents)) + (let ((type (match-string 1 contents)) + (path (match-string 2 contents))) + (when (cl-some (lambda (rule) + (and (string= type (car rule)) + (string-match-p (cdr rule) path))) + (or rules org-export-default-inline-image-rule)) + ;; Replace contents with image link. + (org-element-adopt-elements + (org-element-set-contents l nil) + (with-temp-buffer + (save-excursion (insert contents)) + (org-element-link-parser)))))))) + info nil nil t)) + data) (defun org-export-resolve-coderef (ref info) "Resolve a code reference REF. @@ -4246,12 +4322,10 @@ Assume LINK type is \"fuzzy\". White spaces are not significant." (let* ((search-cells (org-export-string-to-search-cell (org-link-unescape (org-element-property :path link)))) - (link-cache - (or (plist-get info :resolve-fuzzy-link-cache) - (plist-get (plist-put info - :resolve-fuzzy-link-cache - (make-hash-table :test #'equal)) - :resolve-fuzzy-link-cache))) + (link-cache (or (plist-get info :resolve-fuzzy-link-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :resolve-fuzzy-link-cache table) + table))) (cached (gethash search-cells link-cache 'not-found))) (if (not (eq cached 'not-found)) cached (let ((matches @@ -4655,19 +4729,20 @@ code." All special columns will be ignored during export." ;; The table has a special column when every first cell of every row ;; has an empty value or contains a symbol among "/", "#", "!", "$", - ;; "*" "_" and "^". Though, do not consider a first row containing - ;; only empty cells as special. - (let ((special-column-p 'empty)) + ;; "*" "_" and "^". Though, do not consider a first column + ;; containing only empty cells as special. + (let ((special-column? 'empty)) (catch 'exit (dolist (row (org-element-contents table)) (when (eq (org-element-property :type row) 'standard) (let ((value (org-element-contents (car (org-element-contents row))))) - (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) - (setq special-column-p 'special)) - ((not value)) + (cond ((member value + '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column? 'special)) + ((null value)) (t (throw 'exit nil)))))) - (eq special-column-p 'special)))) + (eq special-column? 'special)))) (defun org-export-table-has-header-p (table info) "Non-nil when TABLE has a header. @@ -4675,26 +4750,28 @@ All special columns will be ignored during export." INFO is a plist used as a communication channel. A table has a header when it contains at least two row groups." - (let ((cache (or (plist-get info :table-header-cache) - (plist-get (setq info - (plist-put info :table-header-cache - (make-hash-table :test 'eq))) - :table-header-cache)))) - (or (gethash table cache) - (let ((rowgroup 1) row-flag) - (puthash - table - (org-element-map table 'table-row - (lambda (row) - (cond - ((> rowgroup 1) t) - ((and row-flag (eq (org-element-property :type row) 'rule)) - (cl-incf rowgroup) (setq row-flag nil)) - ((and (not row-flag) (eq (org-element-property :type row) - 'standard)) - (setq row-flag t) nil))) - info 'first-match) - cache))))) + (let* ((cache (or (plist-get info :table-header-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-header-cache table) + table))) + (cached (gethash table cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + (let ((rowgroup 1) row-flag) + (puthash table + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag + (eq (org-element-property :type row) 'rule)) + (cl-incf rowgroup) + (setq row-flag nil)) + ((and (not row-flag) + (eq (org-element-property :type row) 'standard)) + (setq row-flag t) + nil))) + info 'first-match) + cache))))) (defun org-export-table-row-is-special-p (table-row _) "Non-nil if TABLE-ROW is considered special. @@ -4735,21 +4812,24 @@ INFO is a plist used as the communication channel. Return value is the group number, as an integer, or nil for special rows and rows separators. First group is also table's header." - (let ((cache (or (plist-get info :table-row-group-cache) - (plist-get (setq info - (plist-put info :table-row-group-cache - (make-hash-table :test 'eq))) - :table-row-group-cache)))) - (cond ((gethash table-row cache)) - ((eq (org-element-property :type table-row) 'rule) nil) - (t (let ((group 0) row-flag) - (org-element-map (org-export-get-parent table-row) 'table-row - (lambda (row) - (if (eq (org-element-property :type row) 'rule) - (setq row-flag nil) - (unless row-flag (cl-incf group) (setq row-flag t))) - (when (eq table-row row) (puthash table-row group cache))) - info 'first-match)))))) + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-group-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-group-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((group 0) row-flag) + (org-element-map (org-export-get-parent table-row) 'table-row + (lambda (row) + (if (eq (org-element-property :type row) 'rule) + (setq row-flag nil) + (unless row-flag (cl-incf group) (setq row-flag t)) + (puthash row group cache))) + info)) + (gethash table-row cache))))) (defun org-export-table-cell-width (table-cell info) "Return TABLE-CELL contents width. @@ -4764,10 +4844,9 @@ same column as TABLE-CELL, or nil." (columns (length cells)) (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-width-cache) - (plist-get (setq info - (plist-put info :table-cell-width-cache - (make-hash-table :test 'eq))) - :table-cell-width-cache))) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-width-cache table) + table))) (width-vector (or (gethash table cache) (puthash table (make-vector columns 'empty) cache))) (value (aref width-vector column))) @@ -4808,10 +4887,9 @@ Possible values are `left', `right' and `center'." (columns (length cells)) (column (- columns (length (memq table-cell cells)))) (cache (or (plist-get info :table-cell-alignment-cache) - (plist-get (setq info - (plist-put info :table-cell-alignment-cache - (make-hash-table :test 'eq))) - :table-cell-alignment-cache))) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-cell-alignment-cache table) + table))) (align-vector (or (gethash table cache) (puthash table (make-vector columns nil) cache)))) (or (aref align-vector column) @@ -5014,17 +5092,24 @@ INFO is a plist used as a communication channel." (defun org-export-table-row-number (table-row info) "Return TABLE-ROW number. INFO is a plist used as a communication channel. Return value is -zero-based and ignores separators. The function returns nil for -special columns and separators." - (when (and (eq (org-element-property :type table-row) 'standard) - (not (org-export-table-row-is-special-p table-row info))) - (let ((number 0)) - (org-element-map (org-export-get-parent-table table-row) 'table-row - (lambda (row) - (cond ((eq row table-row) number) - ((eq (org-element-property :type row) 'standard) - (cl-incf number) nil))) - info 'first-match)))) +zero-indexed and ignores separators. The function returns nil +for special rows and separators." + (when (eq (org-element-property :type table-row) 'standard) + (let* ((cache (or (plist-get info :table-row-number-cache) + (let ((table (make-hash-table :test #'eq))) + (plist-put info :table-row-number-cache table) + table))) + (cached (gethash table-row cache 'no-cache))) + (if (not (eq cached 'no-cache)) cached + ;; First time a row is queried, populate cache with all the + ;; rows from the table. + (let ((number -1)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (puthash row (cl-incf number) cache))) + info)) + (gethash table-row cache))))) (defun org-export-table-dimensions (table info) "Return TABLE dimensions. @@ -5197,7 +5282,19 @@ Return a list of src-block elements with a caption." ;; `org-export-smart-quotes-alist'. (defconst org-export-smart-quotes-alist - '(("da" + '(("ar" + (primary-opening + :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (primary-closing + :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (secondary-opening :utf-8 "‹" :html "‹" :latex "\\guilsinglleft{}" + :texinfo "@guilsinglleft{}") + (secondary-closing :utf-8 "›" :html "›" :latex "\\guilsinglright{}" + :texinfo "@guilsinglright{}") + (apostrophe :utf-8 "’" :html "’")) + ("da" ;; one may use: »...«, "...", ›...‹, or '...'. ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ ;; LaTeX quotes require Babel! @@ -5304,8 +5401,19 @@ Return a list of src-block elements with a caption." (secondary-closing :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") (apostrophe :utf-8 "’" :html: "'")) + ("sl" + ;; Based on https://sl.wikipedia.org/wiki/Narekovaj + (primary-opening :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (primary-closing :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (secondary-opening + :utf-8 "„" :html "„" :latex "\\glqq{}" :texinfo "@quotedblbase{}") + (secondary-closing + :utf-8 "“" :html "“" :latex "\\grqq{}" :texinfo "@quotedblleft{}") + (apostrophe :utf-8 "’" :html "’")) ("sv" - ;; based on https://sv.wikipedia.org/wiki/Citattecken + ;; Based on https://sv.wikipedia.org/wiki/Citattecken (primary-opening :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") (primary-closing :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") (secondary-opening :utf-8 "’" :html "’" :latex "’" :texinfo "`") @@ -5521,6 +5629,7 @@ them." '(("%e %n: %c" ("fr" :default "%e %n : %c" :html "%e %n : %c")) ("Author" + ("ar" :default "تأليف") ("ca" :default "Autor") ("cs" :default "Autor") ("da" :default "Forfatter") @@ -5541,11 +5650,13 @@ them." ("pl" :default "Autor") ("pt_BR" :default "Autor") ("ru" :html "Автор" :utf-8 "Автор") + ("sl" :default "Avtor") ("sv" :html "Författare") ("uk" :html "Автор" :utf-8 "Автор") ("zh-CN" :html "作者" :utf-8 "作者") ("zh-TW" :html "作者" :utf-8 "作者")) ("Continued from previous page" + ("ar" :default "تتمة الصفحة السابقة") ("de" :default "Fortsetzung von vorheriger Seite") ("es" :html "Continúa de la página anterior" :ascii "Continua de la pagina anterior" :default "Continúa de la página anterior") ("fr" :default "Suite de la page précédente") @@ -5554,8 +5665,10 @@ them." ("nl" :default "Vervolg van vorige pagina") ("pt" :default "Continuação da página anterior") ("ru" :html "(Продолжение)" - :utf-8 "(Продолжение)")) + :utf-8 "(Продолжение)") + ("sl" :default "Nadaljevanje s prejšnje strani")) ("Continued on next page" + ("ar" :default "التتمة في الصفحة التالية") ("de" :default "Fortsetzung nächste Seite") ("es" :html "Continúa en la siguiente página" :ascii "Continua en la siguiente pagina" :default "Continúa en la siguiente página") ("fr" :default "Suite page suivante") @@ -5564,8 +5677,12 @@ them." ("nl" :default "Vervolg op volgende pagina") ("pt" :default "Continua na página seguinte") ("ru" :html "(Продолжение следует)" - :utf-8 "(Продолжение следует)")) + :utf-8 "(Продолжение следует)") + ("sl" :default "Nadaljevanje na naslednji strani")) + ("Created" + ("sl" :default "Ustvarjeno")) ("Date" + ("ar" :default "بتاريخ") ("ca" :default "Data") ("cs" :default "Datum") ("da" :default "Dato") @@ -5585,11 +5702,13 @@ them." ("pl" :default "Data") ("pt_BR" :default "Data") ("ru" :html "Дата" :utf-8 "Дата") + ("sl" :default "Datum") ("sv" :default "Datum") ("uk" :html "Дата" :utf-8 "Дата") ("zh-CN" :html "日期" :utf-8 "日期") ("zh-TW" :html "日期" :utf-8 "日期")) ("Equation" + ("ar" :default "معادلة") ("da" :default "Ligning") ("de" :default "Gleichung") ("es" :ascii "Ecuacion" :html "Ecuación" :default "Ecuación") @@ -5603,9 +5722,11 @@ them." ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") ("ru" :html "Уравнение" :utf-8 "Уравнение") + ("sl" :default "Enačba") ("sv" :default "Ekvation") ("zh-CN" :html "方程" :utf-8 "方程")) ("Figure" + ("ar" :default "شكل") ("da" :default "Figur") ("de" :default "Abbildung") ("es" :default "Figura") @@ -5620,6 +5741,7 @@ them." ("sv" :default "Illustration") ("zh-CN" :html "图" :utf-8 "图")) ("Figure %d:" + ("ar" :default "شكل %d:") ("da" :default "Figur %d") ("de" :default "Abbildung %d:") ("es" :default "Figura %d:") @@ -5632,9 +5754,11 @@ them." ("nn" :default "Illustrasjon %d") ("pt_BR" :default "Figura %d:") ("ru" :html "Рис. %d.:" :utf-8 "Рис. %d.:") + ("sl" :default "Slika %d") ("sv" :default "Illustration %d") ("zh-CN" :html "图%d " :utf-8 "图%d ")) ("Footnotes" + ("ar" :default "الهوامش") ("ca" :html "Peus de pàgina") ("cs" :default "Pozn\xe1mky pod carou") ("da" :default "Fodnoter") @@ -5655,12 +5779,14 @@ them." ("pl" :default "Przypis") ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") ("ru" :html "Сноски" :utf-8 "Сноски") + ("sl" :default "Opombe") ("sv" :default "Fotnoter") ("uk" :html "Примітки" :utf-8 "Примітки") ("zh-CN" :html "脚注" :utf-8 "脚注") ("zh-TW" :html "腳註" :utf-8 "腳註")) ("List of Listings" + ("ar" :default "قائمة بالبرامج") ("da" :default "Programmer") ("de" :default "Programmauflistungsverzeichnis") ("es" :ascii "Indice de Listados de programas" :html "Índice de Listados de programas" :default "Índice de Listados de programas") @@ -5671,8 +5797,10 @@ them." ("nb" :default "Dataprogrammer") ("ru" :html "Список распечаток" :utf-8 "Список распечаток") + ("sl" :default "Seznam programskih izpisov") ("zh-CN" :html "代码目录" :utf-8 "代码目录")) ("List of Tables" + ("ar" :default "قائمة بالجداول") ("da" :default "Tabeller") ("de" :default "Tabellenverzeichnis") ("es" :ascii "Indice de tablas" :html "Índice de tablas" :default "Índice de tablas") @@ -5686,9 +5814,11 @@ them." ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas") ("ru" :html "Список таблиц" :utf-8 "Список таблиц") + ("sl" :default "Seznam tabel") ("sv" :default "Tabeller") ("zh-CN" :html "表格目录" :utf-8 "表格目录")) ("Listing" + ("ar" :default "برنامج") ("da" :default "Program") ("de" :default "Programmlisting") ("es" :default "Listado de programa") @@ -5700,8 +5830,10 @@ them." ("pt_BR" :default "Listagem") ("ru" :html "Распечатка" :utf-8 "Распечатка") + ("sl" :default "Izpis programa") ("zh-CN" :html "代码" :utf-8 "代码")) ("Listing %d:" + ("ar" :default "برنامج %d:") ("da" :default "Program %d") ("de" :default "Programmlisting %d") ("es" :default "Listado de programa %d") @@ -5713,18 +5845,24 @@ them." ("pt_BR" :default "Listagem %d") ("ru" :html "Распечатка %d.:" :utf-8 "Распечатка %d.:") + ("sl" :default "Izpis programa %d") ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) ("References" + ("ar" :default "المراجع") ("fr" :ascii "References" :default "Références") ("de" :default "Quellen") - ("es" :default "Referencias")) + ("es" :default "Referencias") + ("sl" :default "Reference")) ("See figure %s" ("fr" :default "cf. figure %s" - :html "cf. figure %s" :latex "cf.~figure~%s")) + :html "cf. figure %s" :latex "cf.~figure~%s") + ("sl" :default "Glej sliko %s")) ("See listing %s" ("fr" :default "cf. programme %s" - :html "cf. programme %s" :latex "cf.~programme~%s")) + :html "cf. programme %s" :latex "cf.~programme~%s") + ("sl" :default "Glej izpis programa %s")) ("See section %s" + ("ar" :default "انظر قسم %s") ("da" :default "jævnfør afsnit %s") ("de" :default "siehe Abschnitt %s") ("es" :ascii "Vea seccion %s" :html "Vea sección %s" :default "Vea sección %s") @@ -5735,11 +5873,14 @@ them." :ascii "Veja a secao %s") ("ru" :html "См. раздел %s" :utf-8 "См. раздел %s") + ("sl" :default "Glej poglavje %d") ("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节")) ("See table %s" ("fr" :default "cf. tableau %s" - :html "cf. tableau %s" :latex "cf.~tableau~%s")) + :html "cf. tableau %s" :latex "cf.~tableau~%s") + ("sl" :default "Glej tabelo %s")) ("Table" + ("ar" :default "جدول") ("de" :default "Tabelle") ("es" :default "Tabla") ("et" :default "Tabel") @@ -5751,6 +5892,7 @@ them." :utf-8 "Таблица") ("zh-CN" :html "表" :utf-8 "表")) ("Table %d:" + ("ar" :default "جدول %d:") ("da" :default "Tabel %d") ("de" :default "Tabelle %d") ("es" :default "Tabla %d") @@ -5764,9 +5906,11 @@ them." ("pt_BR" :default "Tabela %d") ("ru" :html "Таблица %d.:" :utf-8 "Таблица %d.:") + ("sl" :default "Tabela %d") ("sv" :default "Tabell %d") ("zh-CN" :html "表%d " :utf-8 "表%d ")) ("Table of Contents" + ("ar" :default "قائمة المحتويات") ("ca" :html "Índex") ("cs" :default "Obsah") ("da" :default "Indhold") @@ -5788,11 +5932,13 @@ them." ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") ("ru" :html "Содержание" :utf-8 "Содержание") + ("sl" :default "Kazalo") ("sv" :html "Innehåll") ("uk" :html "Зміст" :utf-8 "Зміст") ("zh-CN" :html "目录" :utf-8 "目录") ("zh-TW" :html "目錄" :utf-8 "目錄")) ("Unknown reference" + ("ar" :default "مرجع غير معرّف") ("da" :default "ukendt reference") ("de" :default "Unbekannter Verweis") ("es" :default "Referencia desconocida") @@ -5803,6 +5949,7 @@ them." :ascii "Referencia desconhecida") ("ru" :html "Неизвестная ссылка" :utf-8 "Неизвестная ссылка") + ("sl" :default "Neznana referenca") ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) "Dictionary for export engine. @@ -6090,29 +6237,37 @@ directory. Return file name as a string." (let* ((visited-file (buffer-file-name (buffer-base-buffer))) (base-name - ;; File name may come from EXPORT_FILE_NAME subtree - ;; property. - (file-name-sans-extension - (or (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) - ;; File name may be extracted from buffer's associated - ;; file, if any. - (and visited-file (file-name-nondirectory visited-file)) - ;; Can't determine file name on our own: Ask user. - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension)))))) + (concat + (file-name-sans-extension + (or + ;; Check EXPORT_FILE_NAME subtree property. + (and subtreep (org-entry-get nil "EXPORT_FILE_NAME" 'selective)) + ;; Check #+EXPORT_FILE_NAME keyword. + (org-with-point-at (point-min) + (catch :found + (let ((case-fold-search t)) + (while (re-search-forward + "^[ \t]*#\\+EXPORT_FILE_NAME:[ \t]+\\S-" nil t) + (let ((element (org-element-at-point))) + (when (eq 'keyword (org-element-type element)) + (throw :found + (org-element-property :value element)))))))) + ;; Extract from buffer's associated file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: ask user. + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (n) (string= extension (file-name-extension n t)))))) + extension)) (output-file ;; Build file name. Enforce EXTENSION over whatever user ;; may have come up with. PUB-DIR, if defined, always has ;; precedence over any provided path. (cond - (pub-dir - (concat (file-name-as-directory pub-dir) - (file-name-nondirectory base-name) - extension)) - ((file-name-absolute-p base-name) (concat base-name extension)) - (t (concat (file-name-as-directory ".") base-name extension))))) + (pub-dir (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name))) + ((file-name-absolute-p base-name) base-name) + (t base-name)))) ;; If writing to OUTPUT-FILE would overwrite original file, append ;; EXTENSION another time to final name. (if (and visited-file (file-equal-p visited-file output-file)) commit 61a5c30e70926f48480b03b79f4f531c8d64418e Author: Alan Mackenzie Date: Mon Sep 18 08:52:24 2017 +0000 Fix irregularities with CC Mode fontification, particularly with "known types" * lisp/progmodes/cc-fonts.el (c-font-lock-declarators): Introduce a new optional parameter, template-class. In "class ", fontify "Y" as a type. (c-font-lock-single-decl): New variable template-class, set to non-nil when we have a construct like the above. Pass this as argument to c-font-lock-declarators. (c-font-lock-cut-off-declarators): Check more rigorously that a declaration being processed starts before the function's starting position. (c-complex-decl-matchers): Remove the redundant clause which fontified "types preceded by, e.g., "struct"". * lisp/progmodes/cc-langs.el (c-template-typename-kwds) (c-template-typename-key): New lang defconsts and defvar. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 5aefdea330..02b685d240 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1026,7 +1026,8 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char pos))))) nil) -(defun c-font-lock-declarators (limit list types not-top) +(defun c-font-lock-declarators (limit list types not-top + &optional template-class) ;; Assuming the point is at the start of a declarator in a declaration, ;; fontify the identifier it declares. (If TYPES is set, it does this via ;; the macro `c-fontify-types-and-refs'.) @@ -1040,6 +1041,11 @@ casts and declarations are fontified. Used on level 2 and higher." ;; non-nil, we are not at the top-level ("top-level" includes being directly ;; inside a class or namespace, etc.). ;; + ;; TEMPLATE-CLASS is non-nil when the declaration is in template delimiters + ;; and was introduced by, e.g. "typename" or "class", such that if there is + ;; a default (introduced by "="), it will be fontified as a type. + ;; E.g. "". + ;; ;; Nil is always returned. The function leaves point at the delimiter after ;; the last declarator it processes. ;; @@ -1112,6 +1118,13 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char next-pos) (setq pos nil) ; So as to terminate the enclosing `while' form. + (if (and template-class + (eq got-init ?=) ; C++ ""? + (c-forward-token-2 1 nil limit) ; Over "=" + (let ((c-promote-possible-types t)) + (c-forward-type t))) ; Over "Y" + (setq list nil)) ; Shouldn't be needed. We can't have a list, here. + (when list ;; Jump past any initializer or function prototype to see if ;; there's a ',' to continue at. @@ -1340,8 +1353,12 @@ casts and declarations are fontified. Used on level 2 and higher." (c-backward-syntactic-ws) (and (c-simple-skip-symbol-backward) (looking-at c-paren-stmt-key)))) - t))) - + t)) + (template-class (and (eq context '<>) + (save-excursion + (goto-char match-pos) + (c-forward-syntactic-ws) + (looking-at c-template-typename-key))))) ;; Fix the `c-decl-id-start' or `c-decl-type-start' property ;; before the first declarator if it's a list. ;; `c-font-lock-declarators' handles the rest. @@ -1353,10 +1370,9 @@ casts and declarations are fontified. Used on level 2 and higher." (if (cadr decl-or-cast) 'c-decl-type-start 'c-decl-id-start))))) - (c-font-lock-declarators (min limit (point-max)) decl-list - (cadr decl-or-cast) (not toplev))) + (cadr decl-or-cast) (not toplev) template-class)) ;; A declaration has been successfully identified, so do all the ;; fontification of types and refs that've been recorded. @@ -1650,7 +1666,8 @@ casts and declarations are fontified. Used on level 2 and higher." ;; font-lock-keyword-face. It always returns NIL to inhibit this and ;; prevent a repeat invocation. See elisp/lispref page "Search-based ;; fontification". - (let ((decl-search-lim (c-determine-limit 1000)) + (let ((here (point)) + (decl-search-lim (c-determine-limit 1000)) paren-state encl-pos token-end context decl-or-cast start-pos top-level c-restricted-<>-arglists c-recognize-knr-p) ; Strictly speaking, bogus, but it @@ -1667,26 +1684,27 @@ casts and declarations are fontified. Used on level 2 and higher." (when (or (bobp) (memq (char-before) '(?\; ?{ ?}))) (setq token-end (point)) - (c-forward-syntactic-ws) - ;; We're now putatively at the declaration. - (setq start-pos (point)) - (setq paren-state (c-parse-state)) - ;; At top level or inside a "{"? - (if (or (not (setq encl-pos - (c-most-enclosing-brace paren-state))) - (eq (char-after encl-pos) ?\{)) - (progn - (setq top-level (c-at-toplevel-p)) - (let ((got-context (c-get-fontification-context - token-end nil top-level))) - (setq context (car got-context) - c-restricted-<>-arglists (cdr got-context))) - (setq decl-or-cast - (c-forward-decl-or-cast-1 token-end context nil)) - (when (consp decl-or-cast) - (goto-char start-pos) - (c-font-lock-single-decl limit decl-or-cast token-end - context top-level))))))) + (c-forward-syntactic-ws here) + (when (< (point) here) + ;; We're now putatively at the declaration. + (setq start-pos (point)) + (setq paren-state (c-parse-state)) + ;; At top level or inside a "{"? + (if (or (not (setq encl-pos + (c-most-enclosing-brace paren-state))) + (eq (char-after encl-pos) ?\{)) + (progn + (setq top-level (c-at-toplevel-p)) + (let ((got-context (c-get-fontification-context + token-end nil top-level))) + (setq context (car got-context) + c-restricted-<>-arglists (cdr got-context))) + (setq decl-or-cast + (c-forward-decl-or-cast-1 token-end context nil)) + (when (consp decl-or-cast) + (goto-char start-pos) + (c-font-lock-single-decl limit decl-or-cast token-end + context top-level)))))))) nil)) (defun c-font-lock-enclosing-decls (limit) @@ -1996,85 +2014,6 @@ on level 2 only and so aren't combined with `c-complex-decl-matchers'." 2 font-lock-type-face) `(,(concat "\\<\\(" re "\\)\\>") 1 'font-lock-type-face))) - - ;; Fontify types preceded by `c-type-prefix-kwds' (e.g. "struct"). - ,@(when (c-lang-const c-type-prefix-kwds) - `((,(byte-compile - `(lambda (limit) - (c-fontify-types-and-refs - ((c-promote-possible-types t) - ;; The font-lock package in Emacs is known to clobber - ;; `parse-sexp-lookup-properties' (when it exists). - (parse-sexp-lookup-properties - (cc-eval-when-compile - (boundp 'parse-sexp-lookup-properties)))) - (save-restriction - ;; Narrow to avoid going past the limit in - ;; `c-forward-type'. - (narrow-to-region (point) limit) - (while (re-search-forward - ,(concat "\\<\\(" - (c-make-keywords-re nil - (c-lang-const c-type-prefix-kwds)) - "\\)\\>") - limit t) - (unless (c-skip-comments-and-strings limit) - (c-forward-syntactic-ws) - ;; Handle prefix declaration specifiers. - (while - (or - (when (or (looking-at c-prefix-spec-kwds-re) - (and (c-major-mode-is 'java-mode) - (looking-at "@[A-Za-z0-9]+"))) - (c-forward-keyword-clause 1) - t) - (when (and c-opt-cpp-prefix - (looking-at - c-noise-macro-with-parens-name-re)) - (c-forward-noise-clause) - t))) - ,(if (c-major-mode-is 'c++-mode) - `(when (and (c-forward-type) - (eq (char-after) ?=)) - ;; In C++ we additionally check for a "class - ;; X = Y" construct which is used in - ;; templates, to fontify Y as a type. - (forward-char) - (c-forward-syntactic-ws) - (c-forward-type)) - `(c-forward-type)) - ))))))))) - - ;; Fontify symbols after closing braces as declaration - ;; identifiers under the assumption that they are part of - ;; declarations like "class Foo { ... } foo;". It's too - ;; expensive to check this accurately by skipping past the - ;; brace block, so we use the heuristic that it's such a - ;; declaration if the first identifier is on the same line as - ;; the closing brace. `c-font-lock-declarations' will later - ;; override it if it turns out to be an new declaration, but - ;; it will be wrong if it's an expression (see the test - ;; decls-8.cc). -;; ,@(when (c-lang-const c-opt-block-decls-with-vars-key) -;; `((,(c-make-font-lock-search-function -;; (concat "}" -;; (c-lang-const c-single-line-syntactic-ws) -;; "\\(" ; 1 + c-single-line-syntactic-ws-depth -;; (c-lang-const c-type-decl-prefix-key) -;; "\\|" -;; (c-lang-const c-symbol-key) -;; "\\)") -;; `((c-font-lock-declarators limit t nil) ; That nil says use `font-lock-variable-name-face'; -;; ; t would mean `font-lock-function-name-face'. -;; (progn -;; (c-put-char-property (match-beginning 0) 'c-type -;; 'c-decl-id-start) -;; ; 'c-decl-type-start) -;; (goto-char (match-beginning -;; ,(1+ (c-lang-const -;; c-single-line-syntactic-ws-depth))))) -;; (goto-char (match-end 0))))))) - ;; Fontify the type in C++ "new" expressions. ,@(when (c-major-mode-is 'c++-mode) ;; This pattern is a probably a "(MATCHER . ANCHORED-HIGHLIGHTER)" diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 7a285f93d3..9495d602e0 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1891,6 +1891,17 @@ the type of that expression." t (c-make-keywords-re t (c-lang-const c-typeof-kwds))) (c-lang-defvar c-typeof-key (c-lang-const c-typeof-key)) +(c-lang-defconst c-template-typename-kwds + "Keywords which, within a template declaration, can introduce a +declaration with a type as a default value. This is used only in +C++ Mode, e.g. \"\"." + t nil + c++ '("class" "typename")) + +(c-lang-defconst c-template-typename-key + t (c-make-keywords-re t (c-lang-const c-template-typename-kwds))) +(c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key)) + (c-lang-defconst c-type-prefix-kwds "Keywords where the following name - if any - is a type name, and where the keyword together with the symbol works as a type in commit 466df76f7df06a03760545fe03d71bc0dc7fe98f Author: Michael Albinus Date: Mon Sep 18 10:00:17 2017 +0200 Cleanup in files-tests.el * test/lisp/files-tests.el (files-tests--make-directory) (files-tests--copy-directory): Cleanup temporary directories. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 3117ea697e..f2a9a32180 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -363,7 +363,8 @@ be invoked with the right arguments." (should-not (make-directory subdir1)) (should-not (make-directory subdir2 t)) (should-error (make-directory a/b)) - (should-not (make-directory a/b t)))) + (should-not (make-directory a/b t)) + (delete-directory dir 'recursive))) (ert-deftest files-test-no-file-write-contents () "Test that `write-contents-functions' permits saving a file. @@ -402,7 +403,8 @@ name (Bug#28412)." (make-directory source) (write-region "" nil file) (copy-directory source dest t t t) - (should (file-exists-p (concat dest "file"))))) + (should (file-exists-p (concat dest "file"))) + (delete-directory dir 'recursive))) (provide 'files-tests) ;;; files-tests.el ends here commit 6359fe630ad06052ee0543b30466a74cd32b69c9 Author: Paul Eggert Date: Sun Sep 17 22:32:31 2017 -0700 Remove old cl-assert calls in 'newline' * lisp/simple.el (newline): Remove cl-assert calls that didn't seem to be helping us debug Bug#18913, and that caused problems as reported in Bug#28280. Suggested by Glenn Morris (Bug#28280#8). diff --git a/lisp/simple.el b/lisp/simple.el index 1ffe181067..4e42fd5241 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -434,10 +434,6 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; Do the rest in post-self-insert-hook, because we want to do it ;; *before* other functions on that hook. (lambda () - ;; We are not going to insert any newlines if arg is - ;; non-positive. - (or (and (numberp arg) (<= arg 0)) - (cl-assert (eq ?\n (char-before)))) ;; Mark the newline(s) `hard'. (if use-hard-newlines (set-hard-newline-properties @@ -456,25 +452,22 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'." ;; starts a page. (or was-page-start (move-to-left-margin nil t))))) - (unwind-protect - (if (not interactive) - ;; FIXME: For non-interactive uses, many calls actually - ;; just want (insert "\n"), so maybe we should do just - ;; that, so as to avoid the risk of filling or running - ;; abbrevs unexpectedly. - (let ((post-self-insert-hook (list postproc))) - (self-insert-command arg)) - (unwind-protect - (progn - (add-hook 'post-self-insert-hook postproc nil t) - (self-insert-command arg)) - ;; We first used let-binding to protect the hook, but that - ;; was naive since add-hook affects the symbol-default - ;; value of the variable, whereas the let-binding might - ;; only protect the buffer-local value. - (remove-hook 'post-self-insert-hook postproc t))) - (cl-assert (not (member postproc post-self-insert-hook))) - (cl-assert (not (member postproc (default-value 'post-self-insert-hook)))))) + (if (not interactive) + ;; FIXME: For non-interactive uses, many calls actually + ;; just want (insert "\n"), so maybe we should do just + ;; that, so as to avoid the risk of filling or running + ;; abbrevs unexpectedly. + (let ((post-self-insert-hook (list postproc))) + (self-insert-command arg)) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc nil t) + (self-insert-command arg)) + ;; We first used let-binding to protect the hook, but that + ;; was naive since add-hook affects the symbol-default + ;; value of the variable, whereas the let-binding might + ;; only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc t)))) nil) (defun set-hard-newline-properties (from to) commit 059184e645037c947528ef4d8d512f6997613be2 Author: Paul Eggert Date: Sun Sep 17 22:01:56 2017 -0700 Avoid crash with C-g C-g in GC Problem reported by Richard Stallman (Bug#17406). Based on fix suggested by Eli Zaretskii (Bug#28279#16). * src/term.c (tty_send_additional_strings): Use only safe accessors, to avoid crash when C-g C-g in GC. diff --git a/src/term.c b/src/term.c index a2ae8c2c6f..065bce45d3 100644 --- a/src/term.c +++ b/src/term.c @@ -155,12 +155,16 @@ tty_ring_bell (struct frame *f) static void tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym) { - Lisp_Object lisp_terminal; - Lisp_Object extra_codes; + /* Use only accessors like CDR_SAFE and assq_no_quit to avoid any + form of quitting or signaling an error, since this function can + run as part of the "emergency escape" procedure invoked in the + middle of GC, where quitting means crashing (Bug#17406). */ + if (! terminal->name) + return; struct tty_display_info *tty = terminal->display_info.tty; - XSETTERMINAL (lisp_terminal, terminal); - for (extra_codes = Fterminal_parameter (lisp_terminal, sym); + for (Lisp_Object extra_codes + = CDR_SAFE (assq_no_quit (sym, terminal->param_alist)); CONSP (extra_codes); extra_codes = XCDR (extra_codes)) { commit 541006c53623cb5fb7dfae475baae5d64fc6e9d0 Author: Paul Eggert Date: Sun Sep 17 20:38:12 2017 -0700 Fix format-time-string %Z bug with negative tz * src/editfns.c (tzlookup): Fix sign error in %Z when a purely numeric zone is negative (Bug#28746). * test/src/editfns-tests.el (format-time-string-with-zone): Add test for this bug. diff --git a/src/editfns.c b/src/editfns.c index b03eb947de..2f8b075817 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -187,7 +187,8 @@ tzlookup (Lisp_Object zone, bool settz) if (sec != 0) prec += 2, numzone = 100 * numzone + sec; } - sprintf (tzbuf, tzbuf_format, prec, numzone, + sprintf (tzbuf, tzbuf_format, prec, + XINT (zone) < 0 ? -numzone : numzone, &"-"[XINT (zone) < 0], hour, min, sec); zone_string = tzbuf; } diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 1c3fde888f..f910afaf71 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -166,6 +166,10 @@ (should (string-equal (format-time-string format look '(-28800 "PST")) "1972-06-30 15:59:59.999 -0800 (PST)")) + ;; Negative UTC offset, as a Lisp integer. + (should (string-equal + (format-time-string format look -28800) + "1972-06-30 15:59:59.999 -0800 (-08)")) ;; Positive UTC offset that is not an hour multiple, as a string. (should (string-equal (format-time-string format look "IST-5:30") commit 679e05eeb97eae5a32fc67f4673b019c873ebcca Author: Paul Eggert Date: Sun Sep 17 17:46:18 2017 -0700 message-citation-line-format %Z is now tz name * etc/NEWS: * lisp/gnus/message.el (message-citation-line-format): Fix doc to match new behavior (Bug#28476). diff --git a/etc/NEWS b/etc/NEWS index a042ce92af..5aa57a7776 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -701,6 +701,12 @@ method is an NNTP select method. *** A new command for sorting articles by readedness marks has been added: 'C-c C-s C-m C-m'. ++++ + +*** In message-citation-line-format the %Z format is now the time zone name +instead of the numeric form. The %z format continues to be the +numeric form. The new behavior is compatible with format-time-string. + ** Ibuffer --- diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 690dd28c8a..a9e66cede1 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -991,7 +991,6 @@ are replaced: %F The first name if present, e.g.: \"John\", else fall back to the mail address. %L The last name if present, e.g.: \"Doe\". - %Z, %z The time zone in the numeric form, e.g.:\"+0000\". All other format specifiers are passed to `format-time-string' which is called using the date from the article your replying to, but commit 4e8888d4383bf6fd87af6d45b6855494edf87a2d Author: Mark Oteiza Date: Sun Sep 17 19:37:08 2017 -0400 Use doc-view or pdf-tools on any window-system * lisp/net/mailcap.el (mailcap-mime-data): Simply check for window-system. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 031d8e1ff0..86587466ef 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -167,11 +167,11 @@ is consulted." ("pdf" (viewer . pdf-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") commit 5f28f0db73c03b98b27e04a458ebb209b5d9acde Author: Paul Eggert Date: Sun Sep 17 15:25:44 2017 -0700 Fix bug with min and max and NaNs * src/data.c (minmax_driver): Fix bug with (min 0 NaN), which mistakenly yielded 0. Also, pacify GCC in a better way. * test/src/data-tests.el (data-tests-min): Test for the bug. diff --git a/src/data.c b/src/data.c index 95bf06e510..e070be6c20 100644 --- a/src/data.c +++ b/src/data.c @@ -3010,16 +3010,16 @@ static Lisp_Object minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { - eassume (0 < nargs); - Lisp_Object accum = args[0]; /* pacify GCC */ - for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) + Lisp_Object accum = args[0]; + CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (accum); + for (ptrdiff_t argnum = 1; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); - if (argnum == 0 || !NILP (arithcompare (val, accum, comparison))) + if (!NILP (arithcompare (val, accum, comparison))) accum = val; - else if (FLOATP (accum) && isnan (XFLOAT_DATA (accum))) - return accum; + else if (FLOATP (val) && isnan (XFLOAT_DATA (val))) + return val; } return accum; } diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 5dc26348a6..8de8c145d4 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -101,7 +101,11 @@ (should (= 3 (apply #'min '(3 8 3)))) (should-error (min 9 8 'foo)) (should-error (min (make-marker))) - (should (eql 1 (min (point-min-marker) 1)))) + (should (eql 1 (min (point-min-marker) 1))) + (should (isnan (min 0.0e+NaN))) + (should (isnan (min 0.0e+NaN 1 2))) + (should (isnan (min 1.0 0.0e+NaN))) + (should (isnan (min 1.0 0.0e+NaN 1.1)))) ;; Bool vector tests. Compactly represent bool vectors as hex ;; strings. commit 37b5e661d298cbfe51422cd515b6696a1cdaa868 Author: Paul Eggert Date: Sun Sep 17 12:56:00 2017 -0700 Fix recently-introduced copy-directory bug Problem reported by Andrew Christianson (Bug#28451): * lisp/files.el (copy-directory): If COPY-CONTENTS, make the destination directory if it does not exist, even if it is a directory name. Simplify, and omit unnecessary test for an already-existing non-directory target, since make-directory diagnoses that for us now. * test/lisp/files-tests.el (files-tests--copy-directory): Test for this bug. diff --git a/lisp/files.el b/lisp/files.el index c55c8097c1..133fed90c3 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5372,7 +5372,7 @@ raised." (while (progn (setq parent (directory-file-name (file-name-directory dir))) - (condition-case err + (condition-case () (files--ensure-directory dir) (file-missing ;; Do not loop if root does not exist (Bug#2309). @@ -5544,16 +5544,14 @@ into NEWNAME instead." ;; If NEWNAME is not a directory name, create it; ;; that is where we will copy the files of DIRECTORY. (make-directory newname parents)) - ;; If NEWNAME is a directory name and COPY-CONTENTS - ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. - ((not copy-contents) - (setq newname (concat newname - (file-name-nondirectory directory))) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t))) + ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil, + ;; create NEWNAME if it is not already a directory; + ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME]. + ((if copy-contents + (or parents (not (file-directory-p newname))) + (setq newname (concat newname + (file-name-nondirectory directory)))) + (make-directory (directory-file-name newname) parents))) ;; Copy recursively. (dolist (file diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index ef216c3f34..3117ea697e 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -393,5 +393,16 @@ name (Bug#28412)." (should (null (save-buffer))) (should (eq (buffer-size) 1)))))) +(ert-deftest files-tests--copy-directory () + (let* ((dir (make-temp-file "files-mkdir-test" t)) + (dirname (file-name-as-directory dir)) + (source (concat dirname "source")) + (dest (concat dirname "dest/new/directory/")) + (file (concat (file-name-as-directory source) "file"))) + (make-directory source) + (write-region "" nil file) + (copy-directory source dest t t t) + (should (file-exists-p (concat dest "file"))))) + (provide 'files-tests) ;;; files-tests.el ends here commit 6bbbc38b3421723521f7cdd4fd617a4fc889aceb Author: Paul Eggert Date: Sun Sep 17 12:56:00 2017 -0700 Merge from Gnulib This incorporates: 2017-09-16 manywarnings: port to GCC on 64-bit MS-Windows 2017-09-13 all: Replace many more http URLs by https URLs * build-aux/config.guess, build-aux/config.sub: * build-aux/gitlog-to-changelog, doc/misc/texinfo.tex: * lib/allocator.h, lib/count-leading-zeros.h: * lib/count-trailing-zeros.h, lib/dup2.c, lib/filevercmp.c: * lib/fstatat.c, lib/fsync.c, lib/ftoastr.c, lib/ftoastr.h: * lib/intprops.h, lib/signal.in.h, lib/stdio-impl.h, lib/stdio.in.h: * lib/unistd.in.h, lib/utimens.c, m4/alloca.m4, m4/extern-inline.m4: * m4/fstatat.m4, m4/gnulib-common.m4, m4/manywarnings.m4: * m4/std-gnu11.m4, m4/sys_types_h.m4, m4/vararrays.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/build-aux/config.guess b/build-aux/config.guess index a744844274..8bd1095f11 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-08-08' +timestamp='2017-09-16' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -15,7 +15,7 @@ timestamp='2017-08-08' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, see . +# along with this program; if not, see . # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a @@ -27,7 +27,7 @@ timestamp='2017-08-08' # Originally written by Per Bothner; maintained since 2000 by Ben Elliston. # # You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess # # Please send patches to . @@ -318,15 +318,6 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in exitcode=$? trap '' 0 exit $exitcode ;; - Alpha\ *:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # Should we change UNAME_MACHINE based on the output of uname instead - # of the specific Alpha model? - echo alpha-pc-interix - exit ;; - 21064:Windows_NT:50:3) - echo alpha-dec-winnt3.5 - exit ;; Amiga*:UNIX_System_V:4.0:*) echo m68k-unknown-sysv4 exit ;; @@ -858,10 +849,6 @@ EOF *:MSYS*:*) echo ${UNAME_MACHINE}-pc-msys exit ;; - i*:windows32*:*) - # uname -m includes "-pc" on this system. - echo ${UNAME_MACHINE}-mingw32 - exit ;; i*:PW*:*) echo ${UNAME_MACHINE}-pc-pw32 exit ;; @@ -877,27 +864,12 @@ EOF echo ia64-unknown-interix${UNAME_RELEASE} exit ;; esac ;; - [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) - echo i${UNAME_MACHINE}-pc-mks - exit ;; - 8664:Windows_NT:*) - echo x86_64-pc-mks - exit ;; - i*:Windows_NT*:* | Pentium*:Windows_NT*:*) - # How do we know it's Interix rather than the generic POSIX subsystem? - # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we - # UNAME_MACHINE based on the output of uname instead of i386? - echo i586-pc-interix - exit ;; i*:UWIN*:*) echo ${UNAME_MACHINE}-pc-uwin exit ;; amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) echo x86_64-unknown-cygwin exit ;; - p*:CYGWIN*:*) - echo powerpcle-unknown-cygwin - exit ;; prep*:SunOS:5.*:*) echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit ;; @@ -1435,9 +1407,9 @@ This script (version $timestamp), has failed to recognize the operating system you are using. If your script is old, overwrite *all* copies of config.guess and config.sub with the latest versions from: - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess + https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess and - http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub + https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub If $0 has already been updated, send the following data and any information you think might be pertinent to config-patches@gnu.org to diff --git a/build-aux/config.sub b/build-aux/config.sub index 40ea5dfe11..95dc3d0724 100755 --- a/build-aux/config.sub +++ b/build-aux/config.sub @@ -2,7 +2,7 @@ # Configuration validation subroutine script. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-04-02' +timestamp='2017-09-16' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -15,7 +15,7 @@ timestamp='2017-04-02' # General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program; if not, see . +# along with this program; if not, see . # # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a @@ -33,7 +33,7 @@ timestamp='2017-04-02' # Otherwise, we print the canonical config type on stdout and succeed. # You can get the latest version of this script from: -# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub +# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub # This file is supposed to be the same for all GNU packages # and recognize all the CPU types, system types and aliases @@ -229,9 +229,6 @@ case $os in -ptx*) basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` ;; - -windowsnt*) - os=`echo $os | sed -e 's/windowsnt/winnt/'` - ;; -psos*) os=-psos ;; @@ -1259,6 +1256,9 @@ case $basic_machine in basic_machine=hppa1.1-winbond os=-proelf ;; + x64) + basic_machine=x86_64-pc + ;; xbox) basic_machine=i686-pc os=-mingw32 @@ -1366,8 +1366,8 @@ esac if [ x"$os" != x"" ] then case $os in - # First match some system type aliases - # that might get confused with valid system types. + # First match some system type aliases that might get confused + # with valid system types. # -solaris* is a basic system type, with this one exception. -auroraux) os=-auroraux @@ -1387,9 +1387,9 @@ case $os in -gnu/linux*) os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; - # First accept the basic system types. + # Now accept the basic system types. # The portable systems comes first. - # Each alternative MUST END IN A *, to match a version number. + # Each alternative MUST end in a * to match a version number. # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index ec5ab9e141..3c94bd56a0 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -33,7 +33,7 @@ use POSIX qw(strftime); (my $ME = $0) =~ s|.*/||; -# use File::Coda; # http://meyering.net/code/Coda/ +# use File::Coda; # https://meyering.net/code/Coda/ END { defined fileno STDOUT or return; close STDOUT and return; diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index a774790c51..9bd75b91e4 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2017-08-23.19} +\def\texinfoversion{2017-09-16.10} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -21,7 +21,7 @@ % General Public License for more details. % % You should have received a copy of the GNU General Public License -% along with this program. If not, see . +% along with this program. If not, see . % % As a special exception, when this file is read by TeX when processing % a Texinfo source document, you may use the result without @@ -30,9 +30,9 @@ % % Please try the latest version of texinfo.tex before submitting bug % reports; you can get the latest version from: -% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or -% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or -% http://www.gnu.org/software/texinfo/ (the Texinfo home page) +% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or +% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or +% https://www.gnu.org/software/texinfo/ (the Texinfo home page) % The texinfo.tex in any given distribution could well be out % of date, so if that's what you're using, please check. % @@ -56,7 +56,7 @@ % extent. You can get the existing language-specific files from the % full Texinfo distribution. % -% The GNU Texinfo home page is http://www.gnu.org/software/texinfo. +% The GNU Texinfo home page is https://www.gnu.org/software/texinfo. \message{Loading texinfo [version \texinfoversion]:} @@ -9446,7 +9446,7 @@ \newif\ifwarnednoepsf \newhelp\noepsfhelp{epsf.tex must be installed for images to work. It is also included in the Texinfo distribution, or you can get - it from ftp://tug.org/tex/epsf.tex.} + it from https://ctan.org/texarchive/macros/texinfo/texinfo/doc/epsf.tex.} % \def\image#1{% \ifx\epsfbox\thisisundefined diff --git a/lib/allocator.h b/lib/allocator.h index 2ecbf1a379..8f79d7435c 100644 --- a/lib/allocator.h +++ b/lib/allocator.h @@ -29,7 +29,7 @@ struct allocator /* Do not use GCC attributes such as __attribute__ ((malloc)) with the function types pointed at by these members, because these attributes do not work with pointers to functions. See - . */ + . */ /* Call ALLOCATE to allocate memory, like 'malloc'. On failure ALLOCATE should return NULL, though not necessarily set errno. When given diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 1b60e28e7f..c8b3dc0511 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -70,7 +70,8 @@ _GL_INLINE_HEADER_BEGIN COUNT_LEADING_ZEROS_INLINE int count_leading_zeros_32 (unsigned int x) { - /* http://graphics.stanford.edu/~seander/bithacks.html */ + /* + */ static const char de_Bruijn_lookup[32] = { 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1, 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0 diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index be7131429c..9f9f07f5a0 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -68,7 +68,8 @@ _GL_INLINE_HEADER_BEGIN COUNT_TRAILING_ZEROS_INLINE int count_trailing_zeros_32 (unsigned int x) { - /* http://graphics.stanford.edu/~seander/bithacks.html */ + /* + */ static const char de_Bruijn_lookup[32] = { 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 diff --git a/lib/dup2.c b/lib/dup2.c index b89f83732f..85c1a44401 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -88,7 +88,7 @@ ms_windows_dup2 (int fd, int desired_fd) } /* Wine 1.0.1 return 0 when desired_fd is negative but not -1: - http://bugs.winehq.org/show_bug.cgi?id=21289 */ + https://bugs.winehq.org/show_bug.cgi?id=21289 */ if (desired_fd < 0) { errno = EBADF; diff --git a/lib/filevercmp.c b/lib/filevercmp.c index 56c9821e36..4026097b38 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -79,7 +79,7 @@ order (unsigned char c) specification can be found in the Debian Policy Manual in the section on the 'Version' control field. This version of the code implements that from s5.6.12 of Debian Policy v3.8.0.1 - http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ + https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ static int _GL_ATTRIBUTE_PURE verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) { diff --git a/lib/fstatat.c b/lib/fstatat.c index d09add037f..67e48d95d7 100644 --- a/lib/fstatat.c +++ b/lib/fstatat.c @@ -111,7 +111,7 @@ stat_func (char const *name, struct stat *st) # endif /* Replacement for Solaris' function by the same name. - + First, try to simulate it via l?stat ("/proc/self/fd/FD/FILE"). Failing that, simulate it via save_cwd/fchdir/(stat|lstat)/restore_cwd. If either the save_cwd or the restore_cwd fails (relatively unlikely), diff --git a/lib/fsync.c b/lib/fsync.c index a52e6642f9..c25f1db657 100644 --- a/lib/fsync.c +++ b/lib/fsync.c @@ -2,8 +2,8 @@ cross-compilers like MinGW. This is derived from sqlite3 sources. - http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c - http://www.sqlite.org/copyright.html + https://www.sqlite.org/src/finfo?name=src/os_win.c + https://www.sqlite.org/copyright.html Written by Richard W.M. Jones diff --git a/lib/ftoastr.c b/lib/ftoastr.c index 029e797b79..bcc79f0367 100644 --- a/lib/ftoastr.c +++ b/lib/ftoastr.c @@ -108,7 +108,7 @@ FTOASTR (char *buf, size_t bufsize, int flags, int width, FLOAT x) Andrysco M, Jhala R, Lerner S. Printing floating-point numbers: a faster, always correct method. ACM SIGPLAN notices - POPL '16. 2016;51(1):555-67 ; draft at - . */ + . */ PROMOTED_FLOAT promoted_x = x; char format[sizeof "%-+ 0*.*Lg"]; diff --git a/lib/ftoastr.h b/lib/ftoastr.h index 3ee05a3033..f73712c941 100644 --- a/lib/ftoastr.h +++ b/lib/ftoastr.h @@ -96,7 +96,7 @@ enum DIG digits. For why the "+ 1" is needed, see "Binary to Decimal Conversion" in David Goldberg's paper "What Every Computer Scientist Should Know About Floating-Point Arithmetic" - . */ + . */ # define _GL_FLOAT_PREC_BOUND(dig) \ (INT_BITS_STRLEN_BOUND ((dig) * _GL_FLOAT_DIG_BITS_BOUND) + 1) diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 9500871b16..d8afec40bc 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -558,6 +558,7 @@ LIBGPM = @LIBGPM@ LIBHESIOD = @LIBHESIOD@ LIBINTL = @LIBINTL@ LIBJPEG = @LIBJPEG@ +LIBLCMS2 = @LIBLCMS2@ LIBMODULES = @LIBMODULES@ LIBOBJS = @LIBOBJS@ LIBOTF_CFLAGS = @LIBOTF_CFLAGS@ diff --git a/lib/intprops.h b/lib/intprops.h index 400ba5b912..a34e81c7b5 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -26,7 +26,7 @@ #define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) /* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see - . */ + . */ #define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v)) /* The extra casts in the following macros work around compiler bugs, @@ -179,7 +179,7 @@ /* Return 1 if A * B would overflow in [MIN,MAX] arithmetic. See above for restrictions. Avoid && and || as they tickle bugs in Sun C 5.11 2010/08/13 and other compilers; see - . */ + . */ #define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \ ((b) < 0 \ ? ((a) < 0 \ @@ -443,7 +443,7 @@ implementation-defined result or signal for values outside T's range. However, code that works around this theoretical problem runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: - http://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html + https://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html As the compiler bug is real, don't try to work around the theoretical problem. */ diff --git a/lib/signal.in.h b/lib/signal.in.h index 1d8ebfa57e..9c32b14962 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -200,7 +200,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1]; /* When also using extern inline, suppress the use of static inline in standard headers of problematic Apple configurations, as Libc at least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., - . + . Perhaps Apple will fix this some day. */ #if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ && (defined __i386__ || defined __x86_64__)) diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 0d606c19c8..8960333687 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -32,7 +32,7 @@ /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */ # if defined __DragonFly__ /* DragonFly */ - /* See . */ + /* See . */ # define fp_ ((struct { struct __FILE_public pub; \ struct { unsigned char *_base; int _size; } _bf; \ void *cookie; \ @@ -49,7 +49,7 @@ fpos_t _offset; \ /* More fields, not relevant here. */ \ } *) fp) - /* See . */ + /* See . */ # define _p pub._p # define _flags pub._flags # define _r pub._r @@ -60,7 +60,7 @@ # if (defined __NetBSD__ && __NetBSD_Version__ >= 105270000) || defined __OpenBSD__ || defined __minix || defined __ANDROID__ /* NetBSD >= 1.5ZA, OpenBSD, Minix 3, Android */ /* See - and */ + and */ struct __sfileext { struct __sbuf _ub; /* ungetc buffer */ @@ -81,7 +81,7 @@ #ifdef __TANDEM /* NonStop Kernel */ # ifndef _IOERR /* These values were determined by the program 'stdioext-flags' at - . */ + . */ # define _IOERR 0x40 # define _IOREAD 0x80 # define _IOWRT 0x4 @@ -132,7 +132,7 @@ struct _gl_real_FILE # define fp_ ((struct _gl_real_FILE *) fp) /* These values were determined by a program similar to the one at - . */ + . */ # define _IOREAD 0x1 # define _IOWRT 0x2 # define _IORW 0x4 diff --git a/lib/stdio.in.h b/lib/stdio.in.h index 5cf31319d9..066e08eba9 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -152,7 +152,7 @@ /* When also using extern inline, suppress the use of static inline in standard headers of problematic Apple configurations, as Libc at least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., - . + . Perhaps Apple will fix this some day. */ #if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ && defined __GNUC__ && defined __STDC__) @@ -610,7 +610,7 @@ _GL_CXXALIAS_SYS (fwrite, size_t, (const void *ptr, size_t s, size_t n, FILE *stream)); /* Work around bug 11959 when fortifying glibc 2.4 through 2.15 - , + , which sometimes causes an unwanted diagnostic for fwrite calls. This affects only function declaration attributes under certain versions of gcc and clang, and is not needed for C++. */ diff --git a/lib/unistd.in.h b/lib/unistd.in.h index 8a383b3d01..c1dd07ff8c 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -379,7 +379,7 @@ _GL_WARN_ON_USE (dup2, "dup2 is unportable - " Close NEWFD first if it is open. Return newfd if successful, otherwise -1 and errno set. See the Linux man page at - . */ + . */ # if @HAVE_DUP3@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define dup3 rpl_dup3 @@ -1149,7 +1149,7 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - " Store the read-end as fd[0] and the write-end as fd[1]. Return 0 upon success, or -1 with errno set upon failure. See also the Linux man page at - . */ + . */ # if @HAVE_PIPE2@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) # define pipe2 rpl_pipe2 diff --git a/lib/utimens.c b/lib/utimens.c index a5716ac810..55545e8ce9 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -196,7 +196,7 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) /* Some Linux-based NFS clients are buggy, and mishandle timestamps of files in NFS file systems in some cases. We have no configure-time test for this, but please see - for references to + for references to some of the problems with Linux 2.6.16. If this affects you, compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to help in some cases, albeit at a cost in performance. But you @@ -250,8 +250,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2]) result = utimensat (AT_FDCWD, file, ts, 0); # ifdef __linux__ /* Work around a kernel bug: - http://bugzilla.redhat.com/442352 - http://bugzilla.redhat.com/449910 + https://bugzilla.redhat.com/show_bug.cgi?id=442352 + https://bugzilla.redhat.com/show_bug.cgi?id=449910 It appears that utimensat can mistakenly return 280 rather than -1 upon ENOSYS failure. FIXME: remove in 2010 or whenever the offending kernels @@ -566,8 +566,8 @@ lutimens (char const *file, struct timespec const timespec[2]) result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW); # ifdef __linux__ /* Work around a kernel bug: - http://bugzilla.redhat.com/442352 - http://bugzilla.redhat.com/449910 + https://bugzilla.redhat.com/show_bug.cgi?id=442352 + https://bugzilla.redhat.com/show_bug.cgi?id=449910 It appears that utimensat can mistakenly return 280 rather than -1 upon ENOSYS failure. FIXME: remove in 2010 or whenever the offending kernels diff --git a/m4/alloca.m4 b/m4/alloca.m4 index 7f0604cbda..d122431649 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 @@ -44,12 +44,12 @@ AC_DEFUN([gl_FUNC_ALLOCA], AC_DEFUN([gl_PREREQ_ALLOCA], [:]) # This works around a bug in autoconf <= 2.68. -# See . +# See . m4_version_prereq([2.69], [] ,[ # This is taken from the following Autoconf patch: -# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 +# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497 # _AC_LIBOBJ_ALLOCA # ----------------- diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4 index 00f960968b..c08af18af6 100644 --- a/m4/extern-inline.m4 +++ b/m4/extern-inline.m4 @@ -11,7 +11,7 @@ AC_DEFUN([gl_EXTERN_INLINE], [/* Please see the Gnulib manual for how to use these macros. Suppress extern inline with HP-UX cc, as it appears to be broken; see - . + . Suppress extern inline with Sun C in standards-conformance mode, as it mishandles inline functions that call each other. E.g., for 'inline void f @@ -28,16 +28,16 @@ AC_DEFUN([gl_EXTERN_INLINE], from calling static functions. This bug is known to occur on: OS X 10.8 and earlier; see: - http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html + https://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html DragonFly; see http://muscles.dragonflybsd.org/bulk/bleeding-edge-potential/latest-per-pkg/ah-tty-0.3.12.log FreeBSD; see: - http://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html + https://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and - for clang but remains for g++; see . + for clang but remains for g++; see . Assume DragonFly and FreeBSD will be similar. */ #if (((defined __APPLE__ && defined __MACH__) \ || defined __DragonFly__ || defined __FreeBSD__) \ diff --git a/m4/fstatat.m4 b/m4/fstatat.m4 index 75cf011040..b29ec9258e 100644 --- a/m4/fstatat.m4 +++ b/m4/fstatat.m4 @@ -20,7 +20,7 @@ AC_DEFUN([gl_FUNC_FSTATAT], HAVE_FSTATAT=0 else dnl Test for an AIX 7.1 bug; see - dnl . + dnl . AC_CACHE_CHECK([whether fstatat (..., 0) works], [gl_cv_func_fstatat_zero_flag], [AC_RUN_IFELSE( diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 36f2acc553..36da841287 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -228,13 +228,13 @@ m4_ifndef([AS_VAR_IF], # This is like AC_PROG_CC_C99, except that # - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60, # - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC -# , +# , # but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99 -# . +# . # Remaining problems: # - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options # to CC twice -# . +# . # - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard. AC_DEFUN([gl_PROG_CC_C99], [ diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index eb89325519..d10bcd08a0 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 12 +# manywarnings.m4 serial 13 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -267,18 +267,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)], # gcc --help=warnings outputs an unusual form for these options; list # them here so that the above 'comm' command doesn't report a false match. - # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal - # and AC_COMPUTE_INT requires it to fit in a long: + # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal. + # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on + # the only platforms where it does not fit in a long, so make that + # a special case. AC_MSG_CHECKING([max safe object size]) AC_COMPUTE_INT([gl_alloc_max], - [(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1 - ? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) - : (size_t) -1], + [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1) + ? -1 + : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1], [[#include #include #include ]], [gl_alloc_max=2147483647]) + case $gl_alloc_max in + -1) gl_alloc_max=9223372036854775807;; + esac AC_MSG_RESULT([$gl_alloc_max]) gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max" gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2" diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index bd34aa1a26..3c2f26f466 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -369,7 +369,7 @@ dnl just the module. Instead, define the (private) symbol dnl _STDC_C99, which suppresses a bogus failure in . dnl The resulting compiler passes the test case here, and that's dnl good enough. For more, please see the thread starting at: -dnl http://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html +dnl https://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html dnl Tru64 -c99 dnl with extended modes being tried first. [[-std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99]], [$1], [$2])[]dnl @@ -458,7 +458,7 @@ dnl preferably extc11. # -------------- # Do not use AU_ALIAS here and in AC_PROG_CC_C99 and AC_PROG_CC_STDC, # as that'd be incompatible with how Automake redefines AC_PROG_CC. See -# . +# . AU_DEFUN([AC_PROG_CC_C89], [AC_REQUIRE([AC_PROG_CC])], [$0 is obsolete; use AC_PROG_CC] diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4 index 34224d7705..06268cfb2d 100644 --- a/m4/sys_types_h.m4 +++ b/m4/sys_types_h.m4 @@ -40,7 +40,7 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS], m4_version_prereq([2.70], [], [ # This is taken from the following Autoconf patch: -# https://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98 +# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=e17a30e987d7ee695fb4294a82d987ec3dc9b974 m4_undefine([AC_HEADER_MAJOR]) AC_DEFUN([AC_HEADER_MAJOR], diff --git a/m4/vararrays.m4 b/m4/vararrays.m4 index 8391121ad3..38a3ed2354 100644 --- a/m4/vararrays.m4 +++ b/m4/vararrays.m4 @@ -27,7 +27,7 @@ AC_DEFUN([AC_C_VARARRAYS], [[/* Test for VLA support. This test is partly inspired from examples in the C standard. Use at least two VLA functions to detect the GCC 3.4.3 bug described in: - http://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html + https://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html */ #ifdef __STDC_NO_VLA__ syntax error; commit 57249fb297237bb942ead1f7a0af0ac20811a9cf Author: Michael Albinus Date: Sun Sep 17 19:16:59 2017 +0200 Fix compatibility problem in Tramp * lisp/net/tramp.el (tramp-interrupt-process): Better error handling. * lisp/net/tramp-compat.el (default-toplevel-value): Move up. (top): Do not call `tramp-change-syntax' anymore. (tramp-compat-directory-name-p): New defalias. * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Use it. * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process): Modify test. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c22869d2cc..760d020f67 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Remote newname. (when (and (file-directory-p newname) - (directory-name-p newname)) + (tramp-compat-directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 5d9a1fd196..214ad040a1 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -23,8 +23,9 @@ ;;; Commentary: -;; Tramp's main Emacs version for development is Emacs 26. This -;; package provides compatibility functions for Emacs 24 and Emacs 25. +;; Tramp's main Emacs version for development is Emacs 27. This +;; package provides compatibility functions for Emacs 24, Emacs 25 and +;; Emacs 26. ;;; Code: @@ -104,6 +105,10 @@ Add the extension of F, if existing." 'tramp-error vec-or-proc (if (fboundp 'user-error) 'user-error 'error) format args)) +;; `default-toplevel-value' has been declared in Emacs 24.4. +(unless (fboundp 'default-toplevel-value) + (defalias 'default-toplevel-value 'symbol-value)) + ;; `file-attribute-*' are introduced in Emacs 25.1. (if (fboundp 'file-attribute-type) @@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer." This is a string of ten letters or dashes as in ls -l." (nth 8 attributes))) -;; `default-toplevel-value' has been declared in Emacs 24.4. -(unless (fboundp 'default-toplevel-value) - (defalias 'default-toplevel-value 'symbol-value)) - ;; `format-message' is new in Emacs 25.1. (unless (fboundp 'format-message) (defalias 'format-message 'format)) +;; `directory-name-p' is new in Emacs 25.1. +(if (fboundp 'directory-name-p) + (defalias 'tramp-compat-directory-name-p 'directory-name-p) + (defsubst tramp-compat-directory-name-p (name) + "Return non-nil if NAME ends with a directory separator character." + (let ((len (length name)) + (lastc ?.)) + (if (> len 0) + (setq lastc (aref name (1- len)))) + (or (= lastc ?/) + (and (memq system-type '(windows-nt ms-dos)) + (= lastc ?\\)))))) + ;; `file-missing' is introduced in Emacs 26.1. (defconst tramp-file-missing (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) @@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted." ((eq tramp-syntax 'sep) 'separate) (t tramp-syntax))) -;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'. -(eval-after-load 'tramp - '(unless - (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values))) - (tramp-compat-funcall - (quote tramp-change-syntax) (tramp-compat-tramp-syntax)))) - (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 7df5aa3b7b..5f145d4fae 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1985,7 +1985,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" ;; scp or rsync DTRT. (progn (when (and (file-directory-p newname) - (not (directory-name-p newname))) + (not (tramp-compat-directory-name-p newname))) (tramp-error v 'file-already-exists newname)) (setq dirname (directory-file-name (expand-file-name dirname)) newname (directory-file-name (expand-file-name newname))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4969566670..ee6baaab12 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -415,7 +415,7 @@ pass to the OPERATION." (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) (when (and (file-directory-p newname) - (not (directory-name-p newname))) + (not (tramp-compat-directory-name-p newname))) (tramp-error v 'file-already-exists newname)) (cond ;; We must use a local temporary directory. @@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." ;; Remote newname. (when (and (file-directory-p newname) - (directory-name-p newname)) + (tramp-compat-directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 45776078be..07c06808bb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4547,16 +4547,17 @@ Only works for Bourne-like shells." (t process))) pid) ;; If it's a Tramp process, send the INT signal remotely. - (when (and (processp proc) (process-live-p proc) - (setq pid (process-get proc 'remote-pid))) - (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) - ;; This is for tramp-sh.el. Other backends do not support this (yet). - (tramp-compat-funcall - 'tramp-send-command - (tramp-get-connection-property proc "vector" nil) - (format "kill -2 %d" pid)) - ;; Report success. - proc))) + (when (and (processp proc) (setq pid (process-get proc 'remote-pid))) + (if (not (process-live-p proc)) + (tramp-error proc 'error "Process %s is not active" proc) + (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) + ;; This is for tramp-sh.el. Other backends do not support this (yet). + (tramp-compat-funcall + 'tramp-send-command + (tramp-get-connection-property proc "vector" nil) + (format "kill -2 %d" pid)) + ;; Report success. + proc)))) ;; `interrupt-process-functions' exists since Emacs 26.1. (when (boundp 'interrupt-process-functions) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e8515302c0..88e97092ed 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3193,15 +3193,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (processp proc)) (should (process-live-p proc)) (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) (should (interrupt-process proc)) ;; Let the process accept the interrupt. (accept-process-output proc 1 nil 0) (should-not (process-live-p proc)) - (should (equal (process-status proc) 'signal)) ;; An interrupted process cannot be interrupted, again. - ;; Does not work reliable. - ;; (should-error (interrupt-process proc) :type 'error)) - ) + (should-error (interrupt-process proc) :type 'error)) ;; Cleanup. (ignore-errors (delete-process proc))))) @@ -3477,7 +3475,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; TODO: This test fails. (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (let* ((default-directory tramp-test-temporary-file-directory) (tmp-name1 (tramp--test-make-temp-name nil quoted)) commit 411bec82c427b238dc67a69637834d2b64566670 Author: Eli Zaretskii Date: Sun Sep 17 19:50:43 2017 +0300 Avoid GCC 7 compilation warning in eval.c * src/eval.c (push_handler_nosignal): Use CACHEABLE to work around GCC compilation warning. Suggested by Paul Eggert in http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00492.html. diff --git a/src/eval.c b/src/eval.c index 62e219631d..39d78364d5 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1428,7 +1428,7 @@ push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype) struct handler * push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) { - struct handler *c = handlerlist->nextfree; + struct handler *CACHEABLE c = handlerlist->nextfree; if (!c) { c = malloc (sizeof *c); commit 34a6774daa31872629c03505f75d737e0df9eacb Author: Mark Oteiza Date: Sun Sep 17 08:27:57 2017 -0400 ; Partially revert c3445aed5194 The pdf-view-mode entry had been added recently and should not have been removed. * lisp/net/mailcap.el: Restore pdf-view-mode entry from the pdf-tools package. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index ed35c220ec..031d8e1ff0 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -164,6 +164,10 @@ is consulted." (non-viewer . t) (type . "application/zip") ("copiousoutput")) + ("pdf" + (viewer . pdf-view-mode) + (type . "application/pdf") + (test . (eq window-system 'x))) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") commit 198ba449845ffa557ac272c3219c703148648f53 Author: Michael Albinus Date: Sun Sep 17 10:08:54 2017 +0200 * lisp/net/trampver.el (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.1. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 91222bd781..51af455e63 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -69,7 +69,8 @@ ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") - ("2.2.13.25.2" . "25.3"))) + ("2.2.13.25.2" . "25.3") + ("2.3.3.26.1" . "26.1"))) (add-hook 'tramp-unload-hook (lambda () commit 3003ac046900f9e7fdaa3161b99dbb1cc8f37b32 Author: Michael Albinus Date: Sun Sep 17 10:03:18 2017 +0200 Adapt Tramp version. Do not merge * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.3.26.1". (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 26.1. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 5d9dcc5635..5151ed5354 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.3-pre +@set trampver 2.3.3.26.1 @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 91222bd781..318e335123 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.3-pre +;; Version: 2.3.3.26.1 ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.3-pre" +(defconst tramp-version "2.3.3.26.1" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.3-pre is not fit for %s" + (format "Tramp 2.3.3.26.1 is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) @@ -69,7 +69,8 @@ ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") - ("2.2.13.25.2" . "25.3"))) + ("2.2.13.25.2" . "25.3") + ("2.3.3.26.1" . "26.1"))) (add-hook 'tramp-unload-hook (lambda () commit 48d39c39e822a792f7c20254c3d9f94aa298be31 Author: Tom Tromey Date: Sat Sep 16 21:46:17 2017 -0600 Search for Syntax section when viewing MDN * lisp/textmodes/css-mode.el (css--mdn-after-render): Also search for "Syntax" section. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index dde9e6a8d9..ce9bbf47e7 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1578,7 +1578,7 @@ to look up will be substituted there." (goto-char (point-min)) (let ((window (get-buffer-window (current-buffer) 'visible))) (when window - (when (re-search-forward "^Summary" nil 'move) + (when (re-search-forward "^\\(Summary\\|Syntax\\)" nil 'move) (beginning-of-line) (set-window-start window (point)))))) commit 9d101376b42e51007e7f83b646e172c52251ae1e Author: Tom Tromey Date: Sat Sep 9 17:20:43 2017 -0600 Allow smerge-keep-current to work for empty hunks Bug#25555 * lisp/vc/smerge-mode.el (smerge-get-current): Allow point to be at match-end. * test/lisp/vc/smerge-mode-tests.el: New file. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 112a9bc524..91be89b5dc 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -725,7 +725,7 @@ this keeps \"UUU\"." (let ((i 3)) (while (or (not (match-end i)) (< (point) (match-beginning i)) - (>= (point) (match-end i))) + (> (point) (match-end i))) (cl-decf i)) i)) diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el new file mode 100644 index 0000000000..204a4b93ab --- /dev/null +++ b/test/lisp/vc/smerge-mode-tests.el @@ -0,0 +1,34 @@ +;; Copyright (C) 2017 Free Software Foundation, Inc + +;; 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 . + +;;; Code: + +(require 'smerge-mode) + +(ert-deftest smerge-mode-test-empty-hunk () + "Regression test for bug #25555" + (with-temp-buffer + (insert "<<<<<<< one\n") + (save-excursion + (insert "=======\nLLL\n>>>>>>> end\n")) + (smerge-mode) + (smerge-keep-current) + (should (equal (buffer-substring (point-min) (point-max)) "")))) + +(provide 'smerge-mode-tests) commit 13aba24adde7e46382daa1e4f0aad194e5232b83 Author: Tom Tromey Date: Sat Sep 16 12:30:36 2017 -0600 Call vc-setup-buffer in vc-git-log-{in,out}going Bug#28427: * lisp/vc/vc-git.el (vc-git-log-incoming, vc-git-log-outgoing): Call vc-setup-buffer. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 095f184ddf..9d7a4d49b8 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1035,6 +1035,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-git-log-outgoing (buffer remote-location) (interactive) + (vc-setup-buffer buffer) (vc-git-command buffer 'async nil "log" @@ -1048,6 +1049,7 @@ If LIMIT is non-nil, show no more than this many entries." (defun vc-git-log-incoming (buffer remote-location) (interactive) + (vc-setup-buffer buffer) (vc-git-command nil 0 nil "fetch") (vc-git-command buffer 'async nil commit 1d599df5e0fbbc52e8592c0aff1d23e978c29b67 Author: Stefan Monnier Date: Sat Sep 16 20:10:31 2017 -0400 Fix last change to textmodes/page-ext.el * lisp/textmodes/page-ext.el (pages-directory): Make buffer writable while we build it (bug#28431). diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index d744bd2cf0..94b68decfb 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -583,6 +583,7 @@ directory for only the accessible portion of the buffer." (with-output-to-temp-buffer pages-directory-buffer (with-current-buffer standard-output (pages-directory-mode) + (setq buffer-read-only nil) (insert "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n) (setq pages-buffer pages-target-buffer) @@ -631,6 +632,7 @@ directory for only the accessible portion of the buffer." ))))) (set-buffer standard-output) + (setq buffer-read-only t) ;; Put positions in increasing order to go with buffer. (setq pages-pos-list (nreverse pages-pos-list)) (if (called-interactively-p 'interactive) commit 546413e1ac5106113812d749178c73ed693331f2 Author: Glenn Morris Date: Sat Sep 16 13:27:25 2017 -0700 * test/src/lcms-tests.el (lcms-whitepoint): Skip if lcms2 not present. (cherry picked from commit 8081df26911c63aadfce4ee8f6a7223d814baeaf) diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index e176cff2dc..962902eb10 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -1,6 +1,6 @@ ;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -67,6 +67,7 @@ B is considered the exact value." (ert-deftest lcms-whitepoint () "Test use of `lcms-temp->white-point'." + (skip-unless (featurep 'lcms2)) (should-error (lcms-temp->white-point 3999)) (should-error (lcms-temp->white-point 25001)) ;; D55 commit a726e09a9a89f85c78b65a96601110bca1a9983b Author: Glenn Morris Date: Sat Sep 16 13:56:44 2017 -0700 * test/src/lcms-tests.el (lcms-cri-cam02-ucs): Skip if lcms2 not present. diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 962902eb10..3d0942c8d1 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -51,6 +51,7 @@ B is considered the exact value." (ert-deftest lcms-cri-cam02-ucs () "Test use of `lcms-cam02-ucs'." + (skip-unless (featurep 'lcms2)) (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error")) (should-error (lcms-cam02-ucs '(0 0 0) 'error)) (should-not commit 8081df26911c63aadfce4ee8f6a7223d814baeaf Author: Glenn Morris Date: Sat Sep 16 13:27:25 2017 -0700 * test/src/lcms-tests.el (lcms-whitepoint): Skip if lcms2 not present. diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 0d6b8db3d4..74648e1979 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -1,6 +1,6 @@ ;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- -;; Copyright (C) 2017 Free Software Foundation, Inc. +;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org @@ -48,6 +48,7 @@ B is considered the exact value." (ert-deftest lcms-whitepoint () "Test use of `lcms-temp->white-point'." + (skip-unless (featurep 'lcms2)) (should-error (lcms-temp->white-point 3999)) (should-error (lcms-temp->white-point 25001)) ;; D55 commit 96aaeaaffac8a93d9c8126ba77ad217a3f323fce Author: Eli Zaretskii Date: Sat Sep 16 22:25:13 2017 +0300 ; * src/lcms.c: Minor stylistic changes in comments. diff --git a/src/lcms.c b/src/lcms.c index cdfbc0ecf9..f543a03039 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -102,7 +102,7 @@ DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0, Each color is a list of L*a*b* coordinates, where the L* channel ranges from 0 to 100, and the a* and b* channels range from -128 to 128. Optional arguments KL, KC, KH are weighting parameters for lightness, -chroma, and hue, respectively. The parameters each default to 1. */) +chroma, and hue, respectively. The parameters each default to 1. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object kL, Lisp_Object kC, Lisp_Object kH) { @@ -163,7 +163,7 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. Each color is a list of XYZ coordinates, with Y scaled about unity. -Optional argument is the XYZ white point, which defaults to illuminant D65. */) +Optional argument is the XYZ white point, which defaults to illuminant D65. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) { cmsViewingConditions vc; @@ -239,7 +239,7 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K. -Valid range of TEMPERATURE is from 4000K to 25000K. */) +Valid range of TEMPERATURE is from 4000K to 25000K. */) (Lisp_Object temperature) { cmsFloat64Number tempK; @@ -292,7 +292,7 @@ void syms_of_lcms2 (void) { DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz, - doc: /* D65 illuminant as a CIE XYZ triple. */); + doc: /* D65 illuminant as a CIE XYZ triple. */); Vlcms_d65_xyz = list3 (make_float (0.950455), make_float (1.0), make_float (1.088753)); commit c3df816585c6b8953fd4075cff894ec2d9ce0596 Author: Eli Zaretskii Date: Sat Sep 16 22:17:55 2017 +0300 Fix compilation warning in etags.c * lib-src/etags.c (etags_mktmp) [DOS_NT]: Don't dereference a NULL pointer. Reported by Richard Copley . diff --git a/lib-src/etags.c b/lib-src/etags.c index 4000f47a41..009cba528d 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -7068,14 +7068,16 @@ etags_mktmp (void) errno = temp_errno; templt = NULL; } - #if defined (DOS_NT) - /* The file name will be used in shell redirection, so it needs to have - DOS-style backslashes, or else the Windows shell will barf. */ - char *p; - for (p = templt; *p; p++) - if (*p == '/') - *p = '\\'; + else + { + /* The file name will be used in shell redirection, so it needs to have + DOS-style backslashes, or else the Windows shell will barf. */ + char *p; + for (p = templt; *p; p++) + if (*p == '/') + *p = '\\'; + } #endif return templt; commit 5490ccc5ebf39759dfd084bbd31f464701a3e775 Author: Mark Oteiza Date: Sat Sep 16 12:49:28 2017 -0400 Add lisp variable lcms-d65-xyz This serves as the default optional argument for functions in this library. * src/lcms.c (lcms-d65-xyz): New variable. (lcms-cam02-ucs): Use it. Use better word in docstring. Fix bug color1 -> color2. * test/src/lcms-tests.el: Add some tests for lcms-cri-cam02-ucs. (lcms-colorspacious-d65): New variable. diff --git a/src/lcms.c b/src/lcms.c index 1f3ace3baa..cdfbc0ecf9 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -162,7 +162,7 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. -Each color is a list of XYZ coordinates, with Y scaled to unity. +Each color is a list of XYZ coordinates, with Y scaled about unity. Optional argument is the XYZ white point, which defaults to illuminant D65. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) { @@ -186,15 +186,11 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1))) signal_error ("Invalid color", color1); if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) - signal_error ("Invalid color", color1); + signal_error ("Invalid color", color2); if (NILP (whitepoint)) - { - xyzw.X = 95.047; - xyzw.Y = 100.0; - xyzw.Z = 108.883; - } + parse_xyz_list (Vlcms_d65_xyz, &xyzw); else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) - signal_error("Invalid white point", whitepoint); + signal_error ("Invalid white point", whitepoint); vc.whitePoint.X = xyzw.X; vc.whitePoint.Y = xyzw.Y; @@ -295,6 +291,12 @@ DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0, void syms_of_lcms2 (void) { + DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz, + doc: /* D65 illuminant as a CIE XYZ triple. */); + Vlcms_d65_xyz = list3 (make_float (0.950455), + make_float (1.0), + make_float (1.088753)); + defsubr (&Slcms_cie_de2000); defsubr (&Slcms_cam02_ucs); defsubr (&Slcms2_available_p); diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 0d6b8db3d4..e176cff2dc 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -33,6 +33,9 @@ (require 'ert) (require 'color) +(defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883) + "D65 white point from colorspacious.") + (defun lcms-approx-p (a b &optional delta) "Check if A and B are within relative error DELTA of one another. B is considered the exact value." @@ -46,6 +49,22 @@ B is considered the exact value." (lcms-approx-p a2 b2 delta) (lcms-approx-p a3 b3 delta)))) +(ert-deftest lcms-cri-cam02-ucs () + "Test use of `lcms-cam02-ucs'." + (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error")) + (should-error (lcms-cam02-ucs '(0 0 0) 'error)) + (should-not + (lcms-approx-p + (let ((lcms-d65-xyz '(0.44757 1.0 0.40745))) + (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))) + (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0)))) + (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5)))) + (should + (lcms-approx-p (lcms-cam02-ucs lcms-colorspacious-d65 + '(0 0 0) + lcms-colorspacious-d65) + 100.0))) + (ert-deftest lcms-whitepoint () "Test use of `lcms-temp->white-point'." (should-error (lcms-temp->white-point 3999)) commit dee96f4a170be134fafd2d11f264952b7e030303 Author: Gemini Lasswell Date: Tue Apr 25 07:42:01 2017 -0700 * lisp/emacs-lisp/cl-macs.el (cl-letf): Fix Edebug spec (bug#24765) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d90e70d3d8..32ba0ac309 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2438,7 +2438,9 @@ As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', the PLACE is not modified before executing BODY. \(fn ((PLACE VALUE) ...) BODY...)" - (declare (indent 1) (debug ((&rest (gate gv-place &optional form)) body))) + (declare (indent 1) (debug ((&rest [&or (symbolp form) + (gate gv-place &optional form)]) + body))) (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) `(let ,bindings ,@body) (cl--letf bindings () () body))) commit 12e864eb30df410906b5fb5d47f0342be7073527 Author: Andy Moreton Date: Sat Sep 16 16:44:39 2017 +0300 Avoid MinGW64 compiler warnings in unexw32.c * src/unexw32.c (pDWP) [MINGW_W64]: Define to "16llx" only for the 64-bit build. diff --git a/src/unexw32.c b/src/unexw32.c index 0c6b48342e..e97a52ba07 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -471,7 +471,7 @@ get_section_info (file_data *p_infile) } /* Format to print a DWORD_PTR value. */ -#ifdef MINGW_W64 +#if defined MINGW_W64 && defined _WIN64 # define pDWP "16llx" #else # define pDWP "08lx" commit 977cd6cb28a37744966ec62f70cf62659f6f302a Author: Eli Zaretskii Date: Sat Sep 16 15:53:03 2017 +0300 Increment Emacs version to 27.0.50 * README: * configure.ac: * nt/README.W32: * src/msdos.c (internal_terminal_init): * msdos/sed2v2.inp: * etc/refcards/ru-refcard.tex: Increment Emacs version to 27.0.50. * etc/NEWS: New file with sections for Emacs 27.1. * etc/NEWS.26: Renamed from etc/NEWS. diff --git a/README b/README index c3cf78f04c..429aa6fde6 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 26.0.50 of GNU Emacs, the extensible, +This directory tree holds version 27.0.50 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index c88471657f..35b7e69daf 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 26.0.50, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 27.0.50, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/etc/NEWS b/etc/NEWS index a042ce92af..371cdf686c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -6,11 +6,12 @@ See the end of the file for license conditions. Please send Emacs bug reports to bug-gnu-emacs@gnu.org. If possible, use M-x report-emacs-bug. -This file is about changes in Emacs version 26. +This file is about changes in Emacs version 27. See file HISTORY for a list of GNU Emacs versions and release dates. -See files NEWS.25, NEWS.24, NEWS.23, NEWS.22, NEWS.21, NEWS.20, -NEWS.19, NEWS.18, and NEWS.1-17 for changes in older Emacs versions. +See files NEWS.26, NEWS.25, NEWS.24, NEWS.23, NEWS.22, NEWS.21, +NEWS.20, NEWS.19, NEWS.18, and NEWS.1-17 for changes in older Emacs +versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. @@ -22,1859 +23,31 @@ Temporary note: When you add a new item, use the appropriate mark if you are sure it applies, -* Installation Changes in Emacs 26.1 - -** By default libgnutls is now required when building Emacs. -Use 'configure --with-gnutls=no' to build even when GnuTLS is missing. - -** GnuTLS version 2.12.2 or later is now required, instead of merely -version 2.6.6 or later. - -** The new option 'configure --with-mailutils' causes Emacs to rely on -GNU Mailutils to retrieve email. It is recommended, and is the -default if GNU Mailutils is installed. When --with-mailutils is not -in effect, the Emacs build procedure by default continues to build and -install a limited 'movemail' substitute that retrieves POP3 email only -via insecure channels; to avoid this problem, use either ---with-mailutils or --without-pop when configuring. - -** The new option 'configure --enable-gcc-warnings=warn-only' causes -GCC to issue warnings without stopping the build. This behavior is -now the default in developer builds. As before, use -'--disable-gcc-warnings' to suppress GCC's warnings, and -'--enable-gcc-warnings' to stop the build if GCC issues warnings. - -** When GCC warnings are enabled, '--enable-check-lisp-object-type' is -now enabled by default when configuring. - -+++ -** The Emacs server now has socket-launching support. This allows -socket based activation, where an external process like systemd can -invoke the Emacs server process upon a socket connection event and -hand the socket over to Emacs. Emacs uses this socket to service -emacsclient commands. This new functionality can be disabled with the -configure option '--disable-libsystemd'. - -+++ -** A systemd user unit file is provided. Use it in the standard way: -systemctl --user enable emacs -(If your Emacs is installed in a non-standard location, you may -need to copy the emacs.service file to eg ~/.config/systemd/user/) - -** New configure option '--disable-build-details' attempts to build an -Emacs that is more likely to be reproducible; that is, if you build -and install Emacs twice, the second Emacs is a copy of the first. -Deterministic builds omit the build date from the output of the -'emacs-version' and 'erc-cmd-SV' functions, and the leave the -following variables nil: 'emacs-build-system', 'emacs-build-time', -'erc-emacs-build-time'. - ---- -** Emacs can now be built with support for Little CMS. - -If the lcms2 library is installed, Emacs will enable features built on -top of that library. The new configure option '--without-lcms2' can -be used to build without lcms2 support even if it is installed. Emacs -linked to Little CMS exposes color management functions in Lisp: the -color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs'. - -** The configure option '--with-gameuser' now defaults to 'no', -as this appears to be the most common configuration in practice. -When it is 'no', the shared game directory and the auxiliary program -update-game-score are no longer needed and are not installed. - -** Emacs no longer works on IRIX. We expect that Emacs users are not -affected by this, as SGI stopped supporting IRIX in December 2013. +* Installation Changes in Emacs 27.1 -* Startup Changes in Emacs 26.1 - -+++ -** New option '--fg-daemon'. This is the same as '--daemon', except -it runs in the foreground and does not fork. This is intended for -modern init systems such as systemd, which manage many of the traditional -aspects of daemon behavior themselves. '--bg-daemon' is now an alias -for '--daemon'. - -+++ -** New option '--module-assertions'. -When given this option, Emacs will perform expensive correctness -checks when dealing with dynamic modules. This is intended for module -authors that wish to verify that their module conforms to the module -requirements. The option makes Emacs abort if a module-related -assertion triggers. - -+++ -** Emacs now supports 24-bit colors on capable text terminals -Terminal is automatically initialized to use 24-bit colors if the -required capabilities are found in terminfo. See the FAQ node -"Colors on a TTY" for more information. - -+++ -** Emacs now obeys the X resource "scrollBar" at startup. -The effect is similar to that of "toolBar" resource on the tool bar. +* Startup Changes in Emacs 27.1 -* Changes in Emacs 26.1 - -** Security vulnerability related to Enriched Text mode is removed. - -+++ -*** Enriched Text mode does not evaluate Lisp in 'display' properties. -This feature allows saving 'display' properties as part of text. -Emacs 'display' properties support evaluation of arbitrary Lisp forms -as part of processing the property for display, so displaying Enriched -Text could be vulnerable to executing arbitrary malicious Lisp code -included in the text (e.g., sent as part of an email message). -Therefore, execution of arbitrary Lisp forms in 'display' properties -decoded by Enriched Text mode is now disabled by default. Customize -the new option 'enriched-allow-eval-in-display-props' to a non-nil -value to allow Lisp evaluation in decoded 'display' properties. - -This vulnerability was introduced in Emacs 21.1. To work around that -in Emacs versions before 25.3, append the following to your ~/.emacs -init file: - - (eval-after-load "enriched" - '(defun enriched-decode-display-prop (start end &optional param) - (list start end))) - -+++ -** Functions in 'write-contents-functions' can fully short-circuit the -'save-buffer' process. Previously, saving a buffer that was not -visiting a file would always prompt for a file name. Now it only does -so if 'write-contents-functions' is nil (or all its functions return -nil). A non-nil buffer-local value for this variable is sufficient -for 'save-some-buffers' to consider the buffer for saving. - ---- -** New variable 'executable-prefix-env' for inserting magic signatures. -This variable affects the format of the interpreter magic number -inserted by 'executable-set-magic'. If non-nil, the magic number now -takes the form "#!/usr/bin/env interpreter", otherwise the value -determined by 'executable-prefix', which is by default -"#!/path/to/interpreter". By default, 'executable-prefix-env' is nil, -so the default behavior is not changed. - -+++ -** The variable 'emacs-version' no longer includes the build number. -This is now stored separately in a new variable, 'emacs-build-number'. - -+++ -** Emacs now provides a limited form of concurrency with Lisp threads. -Concurrency in Emacs Lisp is "mostly cooperative", meaning that -Emacs will only switch execution between threads at well-defined -times: when Emacs waits for input, during blocking operations related -to threads (such as mutex locking), or when the current thread -explicitly yields. Global variables are shared among all threads, but -a 'let' binding is thread-local. Each thread also has its own current -buffer and its own match data. - -See the chapter "Threads" in the ELisp manual for full documentation -of these facilities. - -+++ -** The new user variable 'electric-quote-chars' provides a list -of curved quotes for 'electric-quote-mode', allowing user to choose -the types of quotes to be used. - ---- -** The new user option 'electric-quote-context-sensitive' makes -'electric-quote-mode' context sensitive. If it is non-nil, you can -type an ASCII apostrophe to insert an opening or closing quote, -depending on context. Emacs will replace the apostrophe by an opening -quote character at the beginning of the buffer, the beginning of a -line, after a whitespace character, and after an opening parenthesis; -and it will replace the apostrophe by a closing quote character in all -other cases. - ---- -** The new variable 'electric-quote-inhibit-functions' controls when -to disable electric quoting based on context. Major modes can add -functions to this list; Emacs will temporarily disable -'electric-quote-mode' whenever any of the functions returns non-nil. -This can be used by major modes that derive from 'text-mode' but allow -inline code segments, such as 'markdown-mode'. - -+++ -** The new user variable 'dired-omit-case-fold' allows the user to -customize the case-sensitivity of dired-omit-mode. It defaults to -the same sensitivity as that of the filesystem for the corresponding -dired buffer. - -+++ -** Emacs now uses double buffering to reduce flicker when editing and -resizing graphical Emacs frames on the X Window System. This support -requires the DOUBLE-BUFFER extension, which major X servers have -supported for many years. If your system has this extension, but an -Emacs built with double buffering misbehaves on some displays you use, -you can disable the feature by adding - - '(inhibit-double-buffering . t) - -to default-frame-alist. Or inject this parameter into the selected -frame by evaluating this form: - - (modify-frame-parameters nil '((inhibit-double-buffering . t))) - ---- -The group 'wp', whose label was "text", is now deprecated. -Use the new group 'text', which inherits from 'wp', instead. - -+++ -** The new function 'call-shell-region' executes a command in an -inferior shell with the buffer region as input. - -+++ -** The new user option 'shell-command-dont-erase-buffer' controls -if the output buffer is erased between shell commands; if non-nil, -the output buffer is not erased; this variable also controls where -to set the point in the output buffer: beginning of the output, -end of the buffer or save the point. -When 'shell-command-dont-erase-buffer' is nil, the default value, -the behavior of 'shell-command', 'shell-command-on-region' and -'async-shell-command' is as usual. - -+++ -** The new user option 'async-shell-command-display-buffer' controls -whether the output buffer of an asynchronous command is shown -immediately, or only when there is output. - -+++ -** The new user option 'mouse-select-region-move-to-beginning' -controls the position of point when double-clicking mouse-1 on the end -of a parenthetical grouping or string-delimiter: the default value nil -keeps point at the end of the region, setting it to non-nil moves -point to the beginning of the region. - -+++ -** The new user option 'mouse-drag-and-drop-region' allows to drag the -entire region of text to another place or another buffer. - -+++ -** The new user option 'confirm-kill-processes' allows the user to -skip a confirmation prompt for killing subprocesses when exiting -Emacs. When set to t (the default), Emacs will prompt for -confirmation before killing subprocesses on exit, which is the same -behavior as before. - ---- -** 'find-library-name' will now fall back on looking at 'load-history' -to try to locate libraries that have been loaded with an explicit path -outside 'load-path'. - -+++ -** Faces in 'minibuffer-prompt-properties' no longer overwrite properties -in the text in functions like 'read-from-minibuffer', but instead are -added to the end of the face list. This allows users to say things -like '(read-from-minibuffer (propertize "Enter something: " 'face 'bold))'. - -+++ -** The new variable 'extended-command-suggest-shorter' has been added -to control whether to suggest shorter 'M-x' commands or not. - ---- -** icomplete now respects 'completion-ignored-extensions'. - -+++ -** Non-breaking hyphens are now displayed with the 'nobreak-hyphen' -face instead of the 'escape-glyph' face. - -+++ -** Approximations to quotes are now displayed with the new 'homoglyph' -face instead of the 'escape-glyph' face. - -+++ -** New face 'header-line-highlight'. -This face is the header-line analogue of 'mode-line-highlight'; it -should be the preferred mouse-face for mouse-sensitive elements in the -header line. - ---- -** 'C-x h' ('mark-whole-buffer') will now avoid marking the prompt -part of minibuffers. - ---- -** 'find-library' now takes a prefix argument to pop to a different -window. - ---- -** 'fill-paragraph' no longer marks the buffer as changed unless it -actually changed something. - ---- -** The locale language name 'ca' is now mapped to the language -environment 'Catalan', which has been added. - ---- -** 'align-regexp' has a separate history for its interactive argument. -'align-regexp' no longer shares its history with all other -history-less functions that use 'read-string'. - -+++ -** The networking code has been reworked so that it's more -asynchronous than it was (when specifying :nowait t in -'make-network-process'). How asynchronous it is varies based on the -capabilities of the system, but on a typical GNU/Linux system the DNS -resolution, the connection, and (for TLS streams) the TLS negotiation -are all done without blocking the main Emacs thread. To get -asynchronous TLS, the TLS boot parameters have to be passed in (see -the manual for details). - -Certain process oriented functions (like 'process-datagram-address') -will block until socket setup has been performed. The recommended way -to deal with asynchronous sockets is to avoid interacting with them -until they have changed status to "run". This is most easily done -from a process sentinel. - ---- -** 'make-network-process' and 'open-network-stream' sometimes allowed -:service to be an integer string (e.g., :service "993") and sometimes -required an integer (e.g., :service 993). This difference has been -eliminated, and integer strings work everywhere. - ---- -** It is possible to disable attempted recovery on fatal signals. -Two new variables support disabling attempts to recover from stack -overflow and to avoid automatic auto-save when Emacs is delivered a -fatal signal. 'attempt-stack-overflow-recovery', if set to 'nil', -will disable attempts to recover from C stack overflows; Emacs will -then crash as with any other fatal signal. -'attempt-orderly-shutdown-on-fatal-signal', if set to 'nil', will -disable attempts to auto-save the session and shut down in an orderly -fashion when Emacs receives a fatal signal; instead, Emacs will -terminate immediately. Both variables are non-'nil' by default. -These variables are for users who would like to avoid the small -probability of data corruption due to techniques Emacs uses to recover -in these situations. - -+++ -** File local and directory local variables are now initialized each -time the major mode is set, not just when the file is first visited. -These local variables will thus not vanish on setting a major mode. - -+++ -** A second dir-local file (.dir-locals-2.el) is now accepted. -See the variable 'dir-locals-file-2' for more information. - -+++ -** Connection-local variables can be used to specify local variables -with a value depending on the connected remote server. For details, -see the node "Connection Local Variables" in the ELisp manual. - ---- -** International domain names (IDNA) are now encoded via the new -puny.el library, so that one can visit Web sites with non-ASCII URLs. - -+++ -** The new 'timer-list' command lists all active timers in a buffer, -where you can cancel them with the 'c' command. - -+++ -** 'switch-to-buffer-preserve-window-point' now defaults to t. - -+++ -** The new variable 'debugger-stack-frame-as-list' allows displaying -all call stack frames in a Lisp backtrace buffer as lists. Both -debug.el and edebug.el have been updated to heed to this variable. - ---- -** Values in call stack frames are now displayed using 'cl-prin1'. -The old behaviour of using 'prin1' can be restored by customizing the -new option 'debugger-print-function'. - -+++ -** NUL bytes in text copied to the system clipboard are now replaced with "\0". - -+++ -** The new variable 'x-ctrl-keysym' has been added to the existing -roster of X keysyms. It can be used in combination with another -variable of this kind to swap modifiers in Emacs. - ---- -** New input methods: 'cyrillic-tuvan', 'polish-prefix'. - ---- -** The 'dutch' input method no longer attempts to support Turkish too. -Also, it no longer converts 'IJ' and 'ij' to the compatibility -characters U+0132 LATIN CAPITAL LIGATURE IJ and U+0133 LATIN SMALL -LIGATURE IJ. - -+++ -** File name quoting by adding the prefix "/:" is now possible for the -local part of a remote file name. Thus, if you have a directory named -"/~" on the remote host "foo", you can prevent it from being -substituted by a home directory by writing it as "/foo:/:/~/file". - -+++ -** The new variable 'maximum-scroll-margin' allows having effective -settings of 'scroll-margin' up to half the window size, instead of -always restricting the margin to a quarter of the window. - -+++ -** Emacs can scroll horizontally using mouse, touchpad, and trackbar. -You can enable this by customizing 'mwheel-tilt-scroll-p'. If you -want to reverse the direction of the scroll, customize -'mwheel-flip-direction'. - -+++ -** Emacsclient has a new option -u/--suppress-output. -This option suppresses display of return values from the server -process. - -+++ -** Emacsclient has a new option -T/--tramp. -This helps with using a local Emacs session as the server for a remote -emacsclient. With appropriate setup, one can now set the EDITOR -environment variable on a remote machine to emacsclient, and -use the local Emacs to edit remote files via Tramp. See the node -"emacsclient Options" in the user manual for the details. - ---- -** New user option 'dig-program-options' and extended functionality -for DNS-querying functions 'nslookup-host', 'dns-lookup-host', -and 'run-dig'. Each function now accepts an optional name server -argument interactively (with a prefix argument) and non-interactively. - -+++ -** 'describe-key-briefly' now ignores mouse movement events. - -+++ -** The new variable 'eval-expression-print-maximum-character' prevents -large integers from being displayed as characters by 'M-:' and similar -commands. - ---- -** Two new commands for finding the source code of Emacs Lisp -libraries: 'find-library-other-window' and 'find-library-other-frame'. - -+++ -** The new variable 'display-raw-bytes-as-hex' allows to change the -display of raw bytes from octal to hex. - -+++ -** You can now provide explicit field numbers in format specifiers. -For example, '(format "%2$s %1$s" "X" "Y")' produces "Y X". - -+++ -** Emacs now supports optional display of line numbers in the buffer. -This is similar to what linum-mode provides, but much faster and -doesn't usurp the display margin for the line numbers. Customize the -buffer-local variable 'display-line-numbers' to activate this optional -display. Alternatively, you can use the `display-line-numbers-mode' -minor mode or the global `global-display-line-numbers-mode'. When -using these modes, customize `display-line-numbers-type' with the same -value as you would use with `display-line-numbers'. - -Line numbers are not displayed at all in minibuffer windows and in -tooltips, as they are not useful there. - -Lisp programs can disable line-number display for a particular screen -line by putting the 'display-line-numbers-disable' text property or -overlay property on the first character of that screen line. This is -intended for add-on packages that need a finer control of the display. - -Lisp programs that need to know how much screen estate is used up for -line-number display in a window can use the new function -'line-number-display-width'. - -Linum mode and all similar packages are henceforth becoming obsolete. -Users and developers are encouraged to switch to this new feature -instead. - -+++ -** emacsclient now accepts command-line options in ALTERNATE_EDITOR -and --alternate-editor. For example, ALTERNATE_EDITOR="emacs -Q -nw". -Arguments may be quoted "like this", so that for example an absolute -path containing a space may be specified; quote escaping is not -supported. +* Changes in Emacs 27.1 -* Editing Changes in Emacs 26.1 - -+++ -** New variable 'column-number-indicator-zero-based'. -Traditionally, in Column Number mode, the displayed column number -counts from zero starting at the left margin of the window. This -behavior is now controlled by 'column-number-indicator-zero-based'. -If you would prefer for the displayed column number to count from one, -you may set this variable to nil. (Behind the scenes, there is now a -new mode line construct, '%C', which operates exactly as '%c' does -except that it counts from one.) - -+++ -** New single-line horizontal scrolling mode. -The 'auto-hscroll-mode' variable can now have a new special value, -'current-line', which causes only the line where the cursor is -displayed to be horizontally scrolled when lines are truncated on -display and point moves outside the left or right window margin. - -+++ -** New mode line constructs '%o' and '%q', and user option -'mode-line-percent-position'. '%o' displays the "degree of travel" of -the window through the buffer. Unlike the default '%p', this -percentage approaches 100% as the window approaches the end of the -buffer. '%q' displays the percentage offsets of both the start and -the end of the window, e.g. "5-17%". The new option -'mode-line-percent-position' makes it easier to switch between '%p', -'%P', and these new constructs. - -+++ -** Two new user options 'list-matching-lines-jump-to-current-line' and -'list-matching-lines-current-line-face' to show highlighted the current -line in *Occur* buffer. - -+++ -** The 'occur' command can now operate on the region. - -+++ -** New bindings for 'query-replace-map'. -'undo', undo the last replacement; bound to 'u'. -'undo-all', undo all replacements; bound to 'U'. - ---- -** 'delete-trailing-whitespace' deletes whitespace after form feed. -In modes where form feed was treated as a whitespace character, -'delete-trailing-whitespace' would keep lines containing it unchanged. -It now deletes whitespace after the last form feed thus behaving the -same as in modes where the character is not whitespace. - ---- -** Emacs no longer prompts about editing a changed file when the file's -content is unchanged. Instead of only checking the modification time, -Emacs now also checks the file's actual content before prompting the user. - ---- -** Various casing improvements. - -*** 'upcase', 'upcase-region' et al. convert title case characters -(such as Dz) into their upper case form (such as DZ). - -*** 'capitalize', 'upcase-initials' et al. make use of title-case forms -of initial characters (correctly producing for example Džungla instead -of incorrect DŽungla). - -*** Characters which turn into multiple ones when cased are correctly handled. -For example, fi ligature is converted to FI when upper cased. - -*** Greek small sigma is correctly handled when at the end of the word. -Strings such as ΌΣΟΣ are now correctly converted to Όσος when -capitalized instead of incorrect Όσοσ (compare lowercase sigma at the -end of the word). - -+++ -** Emacs can now auto-save buffers to visited files in a more robust -manner via the new mode 'auto-save-visited-mode'. Unlike -'auto-save-visited-file-name', this mode uses the normal saving -procedure and therefore obeys saving hooks. -'auto-save-visited-file-name' is now obsolete. - -+++ -** New behavior of 'mark-defun'. -Prefix argument selects that many (or that many more) defuns. -Negative prefix arg flips the direction of selection. Also, -'mark-defun' between defuns correctly selects N following defuns (or --N previous for negative arguments). Finally, comments preceding the -defun are selected unless they are separated from the defun by a blank -line. - ---- -** New command 'replace-buffer-contents'. -This command replaces the contents of the accessible portion of the -current buffer with the contents of the accessible portion of a -different buffer while keeping point, mark, markers, and text -properties as intact as possible. - -+++ -** New commands 'apropos-local-variable' and 'apropos-local-value. -These are buffer-local versions of 'apropos-variable' and -'apropos-value', respectively. They show buffer-local variables whose -names and values, respectively, match a given pattern. - -+++ -** More user control of reordering bidirectional text for display. -The two new variables, 'bidi-paragraph-start-re' and -'bidi-paragraph-separate-re', allow customization of what exactly are -paragraphs, for the purposes of bidirectional display. +* Editing Changes in Emacs 27.1 -* Changes in Specialized Modes and Packages in Emacs 26.1 - ---- -** New function `cl-generic-p'. - -** Dired - -+++ -*** You can answer 'all' in 'dired-do-delete' to delete recursively all -remaining directories without more prompts. - -+++ -*** Dired supports wildcards in the directory part of the file names. - -+++ -*** You can now use '`?`' in 'dired-do-shell-command'. -It gets replaced by the current file name, like ' ? '. - -+++ -*** A new option 'dired-always-read-filesystem' default to nil. -If non-nil, buffers visiting files are reverted before search them; -for instance, in 'dired-mark-files-containing-regexp' a non-nil value -of this option means the file is revisited in a temporary buffer; -this temporary buffer is the actual buffer searched: the original buffer -visiting the file is not modified. - ---- -*** Users can now customize mouse clicks in Dired in a more flexible way. -The new command 'dired-mouse-find-file' can be bound to a mouse click -and used to visit files/directories in Dired in the selected window. -The new command 'dired-mouse-find-file-other-frame' similarly visits -files/directories in another frame. You can write your own commands -that invoke 'dired-mouse-find-file' with non-default optional -arguments, to tailor the effects of mouse clicks on file names in -Dired buffers. - -+++ -*** In wdired, when editing files to contain slash characters, -the resulting directories are automatically created. Whether to do -this is controlled by the 'wdired-create-parent-directories' variable. - -+++ -*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for -viewing HTML files and the like. - ---- -*** New variable 'dired-clean-confirm-killing-deleted-buffers' -controls whether Dired asks to kill buffers visiting deleted files and -directories. The default is t, so Dired asks for confirmation, to -keep previous behavior. - ---- -** html2text is now marked obsolete. - ---- -** smerge-refine-regions can refine regions in separate buffers - ---- -** Info menu and index completion uses substring completion by default. -This can be customized via the info-menu category in -completion-category-override. - -+++ -** The ancestor buffer is shown by default in 3-way merges. -A new option ediff-show-ancestor and a new toggle -ediff-toggle-show-ancestor. - ---- -** TeX: Add luatex and xetex as alternatives to pdftex - -** Electric-Buffer-menu - -+++ -*** Key 'U' is bound to 'Buffer-menu-unmark-all' and key 'M-DEL' is -bound to 'Buffer-menu-unmark-all-buffers'. - -** bs - ---- -*** Two new commands 'bs-unmark-all', bound to 'U', and -'bs-unmark-previous', bound to . - -** Buffer-menu - -+++ -*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and -'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. - ---- -** Checkdoc - -*** 'checkdoc-arguments-in-order-flag' now defaults to nil. - -** Gnus - ---- -*** The .newsrc file will now only be saved if the native select -method is an NNTP select method. - -+++ -*** A new command for sorting articles by readedness marks has been -added: 'C-c C-s C-m C-m'. - -** Ibuffer - ---- -*** New command 'ibuffer-jump'. - ---- -*** New filter commands 'ibuffer-filter-by-basename', -'ibuffer-filter-by-file-extension', 'ibuffer-filter-by-directory', -'ibuffer-filter-by-starred-name', 'ibuffer-filter-by-modified' -and 'ibuffer-filter-by-visiting-file'; bound respectively -to '/b', '/.', '//', '/*', '/i' and '/v'. - ---- -*** Two new commands 'ibuffer-filter-chosen-by-completion' -and 'ibuffer-and-filter', the second bound to '/&'. - ---- -*** The commands 'ibuffer-pop-filter', 'ibuffer-pop-filter-group', -'ibuffer-or-filter' and 'ibuffer-filter-disable' have the alternative -bindings '/', '/S-', '/|' and '/DEL', respectively. - ---- -*** The data format specifying filters has been extended to allow -explicit logical 'and', and a more flexible form for logical 'not'. -See 'ibuffer-filtering-qualifiers' doc string for full details. - ---- -*** A new command 'ibuffer-copy-buffername-as-kill'; bound -to 'B'. - ---- -*** New command 'ibuffer-change-marks'; bound to '* c'. - ---- -*** A new command 'ibuffer-mark-by-locked' to mark -all locked buffers; bound to '% L'. - ---- -*** A new option 'ibuffer-locked-char' to indicate -locked buffers; Ibuffer shows a new column displaying -'ibuffer-locked-char' for locked buffers. - ---- -*** A new command 'ibuffer-unmark-all-marks' to unmark -all buffers without asking confirmation; bound to -'U'; 'ibuffer-do-replace-regexp' bound to 'r'. - ---- -*** A new command 'ibuffer-mark-by-content-regexp' to mark buffers -whose content matches a regexp; bound to '% g'. - ---- -*** Two new options 'ibuffer-never-search-content-name' and -'ibuffer-never-search-content-mode' used by -'ibuffer-mark-by-content-regexp'. - -** Browse-URL - ---- -*** Support for opening links to man pages in Man or WoMan mode. - -** Comint - ---- -*** New user option 'comint-move-point-for-matching-input' to control -where to place point after C-c M-r and C-c M-s. - -** Compilation mode - ---- -*** Messages from CMake are now recognized. - -+++ -*** The number of errors, warnings, and informational messages is now -displayed in the mode line. These are updated as compilation -proceeds. - -** Grep - ---- -*** Grep commands will now use GNU grep's '--null' option if -available, which allows distinguishing the filename from contents if -they contain colons. This can be controlled by the new custom option -'grep-use-null-filename-separator'. - ---- -*** The grep/rgrep/lgrep functions will now ask about saving files -before running. This is controlled by the 'grep-save-buffers' -variable. - -** Edebug - ---- -*** Edebug can be prevented from pausing 1 second after reaching a -breakpoint (e.g. with "f" and "o") by customizing the new option -'edebug-sit-on-break'. - -+++ -*** New customizable option 'edebug-max-depth' -This allows to enlarge the maximum recursion depth when instrumenting -code. - -** Eshell - ---- -*** 'eshell-input-filter's value is now a named function -'eshell-input-filter-default', and has a new custom option -'eshell-input-filter-initial-space' to ignore adding commands prefixed -with blank space to eshell history. - -** eww - -+++ -*** New 'M-RET' command for opening a link at point in a new eww buffer. - -+++ -*** A new 's' command for switching to another eww buffer via the minibuffer. - ---- -*** The 'o' command ('shr-save-contents') has moved to 'O' to avoid collision -with the 'o' command from 'image-map'. - -+++ -*** A new command 'C' ('eww-toggle-colors') can be used to toggle -whether to use the HTML-specified colors or not. The user can also -customize the 'shr-use-colors' variable. - ---- -*** Images that are being loaded are now marked with gray -"placeholder" images of the size specified by the HTML. They are then -replaced by the real images asynchronously, which will also now -respect width/height HTML specs (unless they specify widths/heights -bigger than the current window). - ---- -*** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'. -'shr-copy-url' now only copies the url at point; users who wish to -avoid accidentally accessing remote links may rebind 'w' and 'u' in -'eww-link-keymap' to it. - - -** Ido - ---- -*** The commands 'find-alternate-file-other-window', -'dired-other-window', 'dired-other-frame', and -'display-buffer-other-window' are now remapped to Ido equivalents if -Ido mode is active. - -** Images - -+++ -*** Images are automatically scaled before displaying based on the -'image-scaling-factor' variable (if Emacs supports scaling the images -in question). - -+++ -*** It's now possible to specify aspect-ratio preserving combinations -of :width/:max-height and :height/:max-width keywords. In either -case, the "max" keywords win. (Previously some combinations would, -depending on the aspect ratio of the image, just be ignored and in -other instances this would lead to the aspect ratio not being -preserved.) - -+++ -*** Images inserted with 'insert-image' and related functions get a -keymap put into the text properties (or overlays) that span the -image. This keymap binds keystrokes for manipulating size and -rotation, as well as saving the image to a file. These commands are -also available in 'image-mode'. - -+++ -*** A new library for creating and manipulating SVG images has been -added. See the "SVG Images" section in the Lisp reference manual for -details. - -+++ -*** New setf-able function to access and set image parameters is -provided: 'image-property'. - ---- -*** New commands 'image-scroll-left' and 'image-scroll-right' -for 'image-mode' that complement 'image-scroll-up' and -'image-scroll-down': they have the same prefix arg behavior and stop -at image boundaries. - -** Image-Dired - ---- -*** Now provides a minor mode 'image-dired-minor-mode' which replaces -the function 'image-dired-setup-dired-keybindings'. - ---- -*** Thumbnail generation is now asynchronous. -The number of concurrent processes is limited by the variable -'image-dired-thumb-job-limit'. - ---- -*** 'image-dired-thumbnail-storage' has a new option 'standard-large' -for generating 256x256 thumbnails according to the Thumbnail Managing -Standard. - ---- -*** Inherits movement keys from 'image-mode' for viewing full images. -This includes the usual char, line, and page movement commands. - ---- -*** All the -options types have been changed to argument lists -instead of shell command strings. This change affects -'image-dired-cmd-create-thumbnail-options', -'image-dired-cmd-create-temp-image-options', -'image-dired-cmd-rotate-thumbnail-options', -'image-dired-cmd-rotate-original-options', -'image-dired-cmd-write-exif-data-options', -'image-dired-cmd-read-exif-data-options', and introduces -'image-dired-cmd-pngnq-options', 'image-dired-cmd-pngcrush-options', -'image-dired-cmd-create-standard-thumbnail-options' - ---- -*** Recognizes more tools by default, including pngnq-s9 and OptiPNG - ---- -*** 'find-file' and related commands now work on thumbnails and -displayed images, providing a default argument of the original file name -via an addition to 'file-name-at-point-functions'. - ---- -** The default 'Info-default-directory-list' no longer checks some obsolete -directory suffixes (gnu, gnu/lib, gnu/lib/emacs, emacs, lib, lib/emacs) -when searching for info directories. - -+++ -** The commands that add ChangeLog entries now prefer a VCS root directory -for the ChangeLog file, if none already exists. Customize -'change-log-directory-files' to nil for the old behavior. - ---- -** Support for non-string values of 'time-stamp-format' has been removed. - -** Message - ---- -*** 'message-use-idna' now defaults to t (because Emacs comes with -built-in IDNA support now). - ---- -*** When sending HTML messages with embedded images, and you have -exiftool installed, and you rotate images with EXIF data (i.e., -JPEGs), the rotational information will be inserted into the outgoing -image in the message. (The original image will not have its -orientation affected.) - ---- -*** The 'message-valid-fqdn-regexp' variable has been removed, since -there are now top-level domains added all the time. Message will no -longer warn about sending emails to top-level domains it hasn't heard -about. - -*** 'message-beginning-of-line' (bound to C-a) understands folded headers. -In 'visual-line-mode' it will look for the true beginning of a header -while in non-'visual-line-mode' it will move the point to the indented -header's value. - -** Package - -+++ -*** The new variable 'package-gnupghome-dir' has been added to control -where the GnuPG home directory (used for signature verification) is -located and whether GnuPG's option "--homedir" is used or not. - ---- -*** Deleting a package no longer respects 'delete-by-moving-to-trash'. - -** Tramp - -+++ -*** The method part of remote file names is mandatory now. -A valid remote file name starts with "/method:host:" or -"/method:user@host:". - -+++ -*** The new pseudo method "-" is a marker for the default method. -"/-::" is the shortest remote file name then. - -+++ -*** The command 'tramp-change-syntax' allows to choose an alternative -remote file name syntax. - -+++ -*** New connection method "sg", which supports editing files under a -different group ID. - -+++ -*** New connection method "doas" for OpenBSD hosts. - -+++ -*** New connection method "gdrive", which allows to access Google -Drive onsite repositories. - -+++ -*** Gateway methods in Tramp have been removed. -Instead, the Tramp manual documents how to configure ssh and PuTTY -accordingly. - -+++ -*** Setting the "ENV" environment variable in -'tramp-remote-process-environment' enables reading of shell -initialization files. - ---- -*** Tramp is able now to send SIGINT to remote asynchronous processes. - ---- -*** Variable 'tramp-completion-mode' is obsoleted. - ---- -** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'. - -** JS mode - ---- -*** JS mode now sets 'comment-multi-line' to t. - ---- -*** New variable 'js-indent-align-list-continuation', when set to nil, -will not align continuations of bracketed lists, but will indent them -by the fixed width 'js-indent-level'. - -** CSS mode - ---- -*** Support for completing attribute values, at-rules, bang-rules, -HTML tags, classes and IDs using the 'completion-at-point' command. -Completion candidates for HTML classes and IDs are retrieved from open -HTML mode buffers. - ---- -*** CSS mode now binds 'C-h S' to a function that will show -information about a CSS construct (an at-rule, property, pseudo-class, -pseudo-element, with the default being guessed from context). By -default the information is looked up on the Mozilla Developer Network, -but this can be customized using 'css-lookup-url-format'. - ---- -*** CSS colors are fontified using the color they represent as the -background. For instance, #ff0000 would be fontified with a red -background. - -+++ -** Emacs now supports character name escape sequences in character and -string literals. The syntax variants \N{character name} and -\N{U+code} are supported. - -+++ -** Prog mode has some support for multi-mode indentation. -This allows better indentation support in modes that support multiple -programming languages in the same buffer, like literate programming -environments or ANTLR programs with embedded Python code. - -A major mode can provide indentation context for a sub-mode through -the 'prog-indentation-context' variable. To support this, modes that -provide indentation should use 'prog-widen' instead of 'widen' and -'prog-first-column' instead of a literal zero. See the node -"Mode-Specific Indent" in the ELisp manual for more details. - -** ERC - ---- -*** New variable 'erc-default-port-tls' used to connect to TLS IRC -servers. - -** URL - -+++ -*** The new function 'url-cookie-delete-cookie' can be used to -programmatically delete all cookies, or cookies from a specific -domain. - -+++ -*** 'url-retrieve-synchronously' now takes an optional timeout parameter. - ---- -*** The URL package now support HTTPS over proxies supporting CONNECT. - -+++ -*** 'url-user-agent' now defaults to 'default', and the User-Agent -string is computed dynamically based on 'url-privacy-level'. - -** VC and related modes - ---- -*** The VC state indicator in the mode line now defaults to more -colorful faces to make it more obvious to the user what the state is. -See the 'vc-faces' customization group. - -+++ -*** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various -branch-related commands on a keymap bound to 'B'. - -** CC mode - ---- -*** Opening a .h file will turn C or C++ mode depending on language used. -This is done with the help of 'c-or-c++-mode' function which analyses -contents of the buffer to determine whether it's a C or C++ source -file. - ---- -** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses -to a format suitable for reverse lookup zone files. - -** Ispell - -+++ -*** Enchant is now supported as a spell-checker. - -Enchant is a meta-spell-checker that uses providers -such as Hunspell to do the actual checking. With it, users can use -spell-checkers not directly supported by Emacs, such as Voikko, Hspell -and AppleSpell, more easily share personal word-lists with other -programs, and configure different spelling-checkers for different -languages. (Version 2.1.0 or later of Enchant is required.) - -** Flymake - -+++ -*** Emacs no longer prompts the user before killing Flymake processes on exit. +* Changes in Specialized Modes and Packages in Emacs 27.1 -* New Modes and Packages in Emacs 26.1 - -** New Elisp data-structure library 'radix-tree'. - -** New library 'xdg' with utilities for some XDG standards and specs. - -** HTML - -+++ -*** A new submode of 'html-mode', 'mhtml-mode', is now the default -mode for *.html files. This mode handles indentation, -fontification, and commenting for embedded JavaScript and CSS. - -** New mode 'conf-toml-mode' is a sub-mode of conf-mode, specialized - for editing TOML files. - -** New mode 'conf-desktop-mode' is a sub-mode of conf-unix-mode, -specialized for editing freedesktop.org desktop entries. - -** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. - -** New major mode 'less-css-mode' (a minor variant of 'css-mode') for -editing Less files. +* New Modes and Packages in Emacs 27.1 -* Incompatible Lisp Changes in Emacs 26.1 - ---- -*** password-data is now a hash-table -so that `password-read' can use any object for the `key' argument. - -+++ -*** Command 'dired-mark-extension' now automatically prepends a '.' to the -extension when not present. The new command 'dired-mark-suffix' behaves -similarly but it doesn't prepend a '.'. - -+++ -** Certain cond/pcase/cl-case forms are now compiled using a faster jump -table implementation. This uses a new bytecode op 'switch', which -isn't compatible with previous Emacs versions. This functionality can -be disabled by setting 'byte-compile-cond-use-jump-table' to nil. - ---- -** The alist 'ucs-names' is now a hash table. - ---- -** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. -The incumbent 'if-let' and 'when-let' are now marked obsolete. -'if-let*' and 'when-let*' do not accept the single tuple special case. -New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax -of the same name. 'if-let*' and 'when-let*' now accept the same -binding syntax as 'and-let*'. - ---- -** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term -mode to send the same escape sequences that xterm does. This makes -things like forward-word in readline work. - ---- -** hideshow mode got four key bindings that are analogous to outline -mode bindings: 'C-c @ C-a', 'C-c @ C-t', 'C-c @ C-d', and 'C-c @ C-e.' - ---- -** Customizable variable 'query-replace-from-to-separator' -now doesn't propertize the string value of the separator. -Instead, text properties are added by query-replace-read-from. -Additionally, the new nil value restores pre-24.5 behavior -of not providing replacement pairs via the history. - ---- -** Some obsolete functions, variables, and faces have been removed: -*** make-variable-frame-local. Variables cannot be frame-local any more. -*** From subr.el: window-dot, set-window-dot, read-input, show-buffer, -eval-current-buffer, string-to-int -*** icomplete-prospects-length. -*** All the default-FOO variables that hold the default value of the -FOO variable. Use 'default-value' and 'setq-default' to access and -change FOO, respectively. The exhaustive list of removed variables is: -'default-mode-line-format', 'default-header-line-format', -'default-line-spacing', 'default-abbrev-mode', 'default-ctl-arrow', -'default-truncate-lines', 'default-left-margin', 'default-tab-width', -'default-case-fold-search', 'default-left-margin-width', -'default-right-margin-width', 'default-left-fringe-width', -'default-right-fringe-width', 'default-fringes-outside-margins', -'default-scroll-bar-width', 'default-vertical-scroll-bar', -'default-indicate-empty-lines', 'default-indicate-buffer-boundaries', -'default-fringe-indicator-alist', 'default-fringe-cursor-alist', -'default-scroll-up-aggressively', 'default-scroll-down-aggressively', -'default-fill-column', 'default-cursor-type', -'default-cursor-in-non-selected-windows', -'default-buffer-file-coding-system', 'default-major-mode', and -'default-enable-multibyte-characters'. -*** Many variables obsoleted in 22.1 referring to face symbols - -+++ -** The variable 'text-quoting-style' no longer affects the treatment -of curved quotes in format arguments to functions like 'message' and -'format-message'. In particular, when this variable's value is -'grave', all quotes in formats are output as-is. - ---- -** Functions like 'check-declare-file' and 'check-declare-directory' -now generate less chatter and more-compact diagnostics. The auxiliary -function 'check-declare-errmsg' has been removed. - -+++ -** The regular expression character class [:blank:] now matches -Unicode horizontal whitespace as defined in the Unicode Technical -Standard #18. If you only want to match space and tab, use [ \t] -instead. - -+++ -** 'min' and 'max' no longer round their results. -Formerly, they returned a floating-point value if any argument was -floating-point, which was sometimes numerically incorrect. For -example, on a 64-bit host (max 1e16 10000000000000001) now returns its -second argument instead of its first. - -+++ -** The variable 'old-style-backquotes' has been made internal and -renamed to 'lread--old-style-backquotes'. No user code should use -this variable. - ---- -** To avoid confusion caused by "smart quotes", the reader no longer -accepts Lisp symbols which begin with the following quotation -characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. - -+++ -** 'default-file-name-coding-system' now defaults to a coding system -that does not process CRLF. For example, it defaults to utf-8-unix -instead of to utf-8. Before this change, Emacs would sometimes -mishandle file names containing these control characters. - -+++ -** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no -longer quietly mutate the target of a local symbolic link, so that -Emacs can access and copy them reliably regardless of their contents. -The following changes are involved. - ---- -*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to -symbolic links whose targets begin with "/" and contain ":". For -example, if a symbolic link "x" has a target "/y:z:", '(file-symlink-p -"x")' now returns "/y:z:" rather than "/:/y:z:". - ---- -*** 'make-symbolic-link' no longer looks for file name handlers of -target when creating a symbolic link. For example, -'(make-symbolic-link "/y:z:" "x")' now creates a symbolic link to -"/y:z:" instead of failing. - -+++ -*** 'make-symbolic-link' removes the remote part of a link target if -target and newname have the same remote part. For example, -'(make-symbolic-link "/x:y:a" "/x:y:b")' creates a link with the -literal string "a"; and '(make-symbolic-link "/x:y:a" "/x:z:b")' -creates a link with the literal string "/x:y:a" instead of failing. - -+++ -*** 'make-symbolic-link' now expands a link target with leading "~" -only when the optional third arg is an integer, as when invoked -interactively. For example, '(make-symbolic-link "~y" "x")' now -creates a link with target the literal string "~y"; to get the old -behavior, use '(make-symbolic-link (expand-file-name "~y") "x")'. To -avoid this expansion in interactive use, you can now prefix the link -target with "/:". For example, '(make-symbolic-link "/:~y" "x" 1)' -now creates a link to literal "~y". - -+++ -** 'file-truename' returns a quoted file name if the target of a -symbolic link has remote file name syntax. - -+++ -** Module functions are now implemented slightly differently; in -particular, the function 'internal--module-call' has been removed. -Code that depends on undocumented internals of the module system might -break. - ---- -** The argument LOCKNAME of 'write-region' is propagated to file name -handlers now. - ---- -** When built against recent versions of GTK+, Emacs always uses -gtk_window_move for moving frames and ignores the value of the -variable 'x-gtk-use-window-move'. The variable is now obsolete. - -+++ -** Several functions that create or rename files now treat their -destination argument specially only when it is a directory name, i.e., -when it ends in '/' on GNU and other POSIX-like systems. When the -destination argument D of one of these functions is an existing -directory and the intent is to act on an entry in that directory, D -should now be a directory name. For example, (rename-file "e" "f/") -renames to 'f/e'. Although this formerly happened sometimes even when -D was not a directory name, as in (rename-file "e" "f") where 'f' -happened to be a directory, the old behavior often contradicted the -documentation and had inherent races that led to security holes. A -call like (rename-file C D) that used the old, undocumented behavior -can be written as (rename-file C (file-name-as-directory D)), a -formulation portable to both older and newer versions of Emacs. -Affected functions include add-name-to-file, copy-directory, -copy-file, format-write-file, gnus-copy-file, make-symbolic-link, -rename-file, thumbs-rename-images, and write-file. - ---- -** The list returned by 'overlays-at' is now in decreasing priority order. -The documentation of this function always said the order should be -that of decreasing priority, if the 2nd argument of the function is -non-nil, but the code returned the list in the increasing order of -priority instead. Now the code does what the documentation says it -should do. +* Incompatible Lisp Changes in Emacs 27.1 -* Lisp Changes in Emacs 26.1 - -+++ -** The function 'assoc' now takes an optional third argument TESTFN. -This argument, when non-nil, is used for comparison instead of -'equal'. - -+++ -** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. -If non-nil, the argument specifies a function to use for comparison, -instead of, respectively, 'assq' and 'eql'. - -+++ -** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 -contain the same elements, regardless of the order. - -+++ -** The new function 'mapbacktrace' applies a function to all frames of -the current stack trace. - -+++ -** The new function 'file-name-case-insensitive-p' tests whether a -given file is on a case-insensitive filesystem. - -+++ -** Several accessors for the value returned by 'file-attributes' -have been added. They are: 'file-attribute-type', -'file-attribute-link-number', 'file-attribute-user-id', -'file-attribute-group-id', 'file-attribute-access-time', -'file-attribute-modification-time', -'file-attribute-status-change-time', 'file-attribute-size', -'file-attribute-modes', 'file-attribute-inode-number', -'file-attribute-device-number' and 'file-attribute-collect'. - -+++ -** The new function 'buffer-hash' computes a fast, non-consing hash of -a buffer's contents. - -+++ -** 'interrupt-process' now consults the list 'interrupt-process-functions', -to determine which function has to be called in order to deliver the -SIGINT signal. This allows Tramp to send the SIGINT signal to remote -asynchronous processes. The hitherto existing implementation has been -moved to 'internal-default-interrupt-process'. - -+++ -** The new function 'read-multiple-choice' prompts for multiple-choice -questions, with a handy way to display help texts. - ---- -** 'comment-indent-function' values may now return a cons to specify a -range of indentation. - -+++ -** New optional argument TEXT in 'make-temp-file'. - ---- -** New function `define-symbol-prop'. - -** Checksum/Hash - -+++ -** New function 'secure-hash-algorithms' to list the algorithms that -'secure-hash' supports. -See the node "(elisp) Checksum/Hash" in the ELisp manual for details. - -+++ -** Emacs now exposes the GnuTLS cryptographic API with the functions -'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and -'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt' -and 'gnutls-symmetric-decrypt'. -See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details. - -+++ -** Emacs now supports records for user-defined types, via the new -functions 'make-record', 'record', and 'recordp'. Records are now -used internally to represent cl-defstruct and defclass instances, for -example. - -+++ -** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' -to decide which buffers to ask about, if the PRED argument is nil. -The default value of 'save-some-buffers-default-predicate' is nil, -which means ask about all file-visiting buffers. - ---- -** string-(to|as|make)-(uni|multi)byte are now declared obsolete. - -+++ -** New variable 'while-no-input-ignore-events' which allow -setting which special events 'while-no-input' should ignore. -It is a list of symbols. - ---- -** New function 'undo-amalgamate-change-group' to get rid of -undo-boundaries between two states. - ---- -** New var 'definition-prefixes' is a hash table mapping prefixes to -the files where corresponding definitions can be found. This can be -used to fetch definitions that are not yet loaded, for example for -'C-h f'. - ---- -** New var 'syntax-ppss-table' to control the syntax-table used in -'syntax-ppss'. - -+++ -** 'define-derived-mode' can now specify an :after-hook form, which -gets evaluated after the new mode's hook has run. This can be used to -incorporate configuration changes made in the mode hook into the -mode's setup. - ---- -** Autoload files can be generated without timestamps, -by setting 'autoload-timestamps' to nil. -FIXME As an experiment, nil is the current default. -If no insurmountable problems before next release, it can stay that way. - ---- -** 'gnutls-boot' now takes a parameter ':complete-negotiation' that -says that negotiation should complete even on non-blocking sockets. - ---- -** There is now a new variable 'flyspell-sort-corrections-function' -that allows changing the way corrections are sorted. - ---- -** The new command 'fortune-message' has been added, which displays -fortunes in the echo area. - -+++ -** New function 'func-arity' returns information about the argument list -of an arbitrary function. This generalizes 'subr-arity' for functions -that are not built-in primitives. We recommend using this new -function instead of 'subr-arity'. - ---- -** New function 'region-bounds' can be used in the interactive spec -to provide region boundaries (for rectangular regions more than one) -to an interactively callable function as a single argument instead of -two separate arguments region-beginning and region-end. - -+++ -** 'parse-partial-sexp' state has a new element. Element 10 is -non-nil when the last character scanned might be the first character -of a two character construct, i.e., a comment delimiter or escaped -character. Its value is the syntax of that last character. - -+++ -** 'parse-partial-sexp's state, element 9, has now been confirmed as -permanent and documented, and may be used by Lisp programs. Its value -is a list of currently open parenthesis positions, starting with the -outermost parenthesis. - ---- -** 'read-color' will now display the color names using the color itself -as the background color. - ---- -** The function 'redirect-debugging-output' now works on platforms -other than GNU/Linux. - -+++ -** The new function 'string-version-lessp' compares strings by -interpreting consecutive runs of numerical characters as numbers, and -compares their numerical values. According to this predicate, -"foo2.png" is smaller than "foo12.png". - ---- -** Numeric comparisons and 'logb' no longer return incorrect answers -due to internal rounding errors. For example, (< most-positive-fixnum -(+ 1.0 most-positive-fixnum)) now correctly returns t on 64-bit hosts. - ---- -** The functions 'ffloor', 'fceiling', 'ftruncate' and 'fround' now -accept only floating-point arguments, as per their documentation. -Formerly, they quietly accepted integer arguments and sometimes -returned nonsensical answers, e.g., (< N (ffloor N)) could return t. - ---- -** On hosts like GNU/Linux x86-64 where a 'long double' fraction -contains at least EMACS_INT_WIDTH - 3 bits, 'format' no longer returns -incorrect answers due to internal rounding errors when formatting -Emacs integers with %e, %f, or %g conversions. For example, on these -hosts (eql N (string-to-number (format "%.0f" N))) now returns t for -all Emacs integers N. - ---- -** Calls that accept floating-point integers (for use on hosts with -limited integer range) now signal an error if arguments are not -integral. For example (decode-char 'ascii 0.5) now signals an error. - -+++ -** The new function 'char-from-name' converts a Unicode name string -to the corresponding character code. - -+++ -** New functions 'sxhash-eq' and 'sxhash-eql' return hash codes of a -Lisp object suitable for use with 'eq' and 'eql' correspondingly. If -two objects are 'eq' ('eql'), then the result of 'sxhash-eq' -('sxhash-eql') on them will be the same. - -+++ -** Function 'sxhash' has been renamed to 'sxhash-equal' for -consistency with the new functions. For compatibility, 'sxhash' -remains as an alias to 'sxhash-equal'. - -+++ -** 'make-hash-table' now defaults to a rehash threshold of 0.8125 -instead of 0.8, to avoid rounding glitches. - -+++ -** New function 'add-variable-watcher' can be used to call a function -when a symbol's value is changed. This is used to implement the new -debugger command 'debug-on-variable-change'. - -+++ -** Time conversion functions that accept a time zone rule argument now -allow it to be OFFSET or a list (OFFSET ABBR), where the integer -OFFSET is a count of seconds east of Universal Time, and the string -ABBR is a time zone abbreviation. The affected functions are -'current-time-string', 'current-time-zone', 'decode-time', -'format-time-string', and 'set-time-zone-rule'. - -+++ -** 'format-time-string' now formats "%q" to the calendar quarter. - -+++ -** New built-in function 'mapcan'. -It avoids unnecessary consing (and garbage collection). - -+++ -** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. - -+++ -** 'gensym' is now part of Elisp. - ---- -** Low-level list functions like 'length' and 'member' now do a better -job of signaling list cycles instead of looping indefinitely. - -+++ -** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' -can be used for creation of temporary files of remote or mounted directories. - -+++ -** On GNU platforms when operating on a local file, 'file-attributes' -no longer suffers from a race when called while another process is -altering the filesystem. On non-GNU platforms 'file-attributes' -attempts to detect the race, and returns nil if it does so. - -+++ -** The new function 'file-local-name' can be used to specify arguments -of remote processes. - -+++ -** The new functions 'file-name-quote', 'file-name-unquote' and -'file-name-quoted-p' can be used to quote / unquote file names with -the prefix "/:". - -+++ -** The new error 'file-missing', a subcategory of 'file-error', is now -signaled instead of 'file-error' if a file operation acts on a file -that does not exist. - -+++ -** The function 'delete-directory' no longer signals an error when -operating recursively and when some other process deletes the directory -or its files before 'delete-directory' gets to them. - -+++ -*** New error type 'user-search-failed' like 'search-failed' but -avoids debugger like 'user-error'. - -+++ -** The function 'line-number-at-pos' now takes a second optional -argument 'absolute'. If this parameter is nil, the default, this -function keeps on returning the line number taking potential narrowing -into account. If this parameter is non-nil, the function ignores -narrowing and returns the absolute line number. - ---- -** The function 'color-distance' now takes a second optional argument -'metric'. When non-nil, it should be a function of two arguments that -accepts two colors and returns a number. - -** Changes in Frame and Window Handling - -+++ -*** Resizing a frame no longer runs 'window-configuration-change-hook'. -'window-size-change-functions' should be used instead. - -+++ -*** The new function 'frame-size-changed-p' can tell whether a frame has -been resized since the last time 'window-size-change-functions' has been -run. - -+++ -*** The function 'frame-geometry' now also returns the width of a -frame's outer border. - -+++ -*** New frame parameters and changed semantics for older ones - -+++ -**** 'z-group' positions a frame above or below all others. - -+++ -**** 'min-width' and 'min-height' specify the absolute minimum size of a -frame. - -+++ -**** 'parent-frame' makes a frame the child frame of another Emacs -frame. The section "Child Frames" in the Elisp manual describes the -intrinsics of that relationship. - -+++ -**** 'delete-before' triggers deletion of one frame before that of -another. - -+++ -**** 'mouse-wheel-frame' specifies another frame whose windows shall be -scrolled instead. - -+++ -**** 'no-other-frame' has 'next-frame' and 'previous-frame' skip this -frame. - -+++ -**** 'skip-taskbar' removes a frame's icon from the taskbar and has -Alt- skip this frame. - -+++ -**** 'no-focus-on-map' avoids that a frame gets input focus when mapped. - -+++ -**** 'no-accept-focus' means that a frame does not want to get input -focus via the mouse. - -+++ -**** 'undecorated' removes the window manager decorations from a frame. - -+++ -**** 'override-redirect' tells the window manager to disregard this -frame. - -+++ -**** 'width' and 'height' allow to specify pixel values and ratios now. - -+++ -**** 'left' and 'top' allow to specify ratios now. - -+++ -**** 'keep-ratio' preserves size and position of child frames when their -parent frame is resized. - -+++ -**** 'no-special-glyphs' suppresses display of truncation and -continuation glyphs in a frame. - -+++ -**** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of -frames and exiting from minibuffer individually. - -+++ -**** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes' -handle fitting a frame to its buffer individually. - -+++ -**** 'drag-internal-border', 'drag-with-header-line', -'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible' -allow to drag and resize frames with the mouse. - -*** The new function 'frame-list-z-order' returns a list of all frames -in Z (stacking) order. - -+++ -*** The function 'x-focus-frame' optionally tries to not activate its -frame. - -+++ -*** The variable 'focus-follows-mouse' has a third meaningful value -'auto-raise' to indicate that the window manager automatically raises a -frame when the mouse pointer enters it. - -+++ -*** The new function 'frame-restack' puts a frame above or below -another on the display. - -+++ -*** The new face 'internal-border' specifies the background of a frame's -internal border. - -+++ -*** The NORECORD argument of 'select-window' now has a meaningful value -'mark-for-redisplay' which is like any other non-nil value but marks -WINDOW for redisplay. - -+++ -*** Support for side windows is now official. -The display action function 'display-buffer-in-side-window' will -display its buffer in a side window. Functions for toggling all side -windows on a frame, changing and reversing the layout of side windows -and returning the main (major non-side) window of a frame are -provided. For details consult the section "Side Windows" in the Elisp -manual. - -+++ -*** Support for atomic windows - rectangular compositions of windows -treated by 'split-window', 'delete-window' and 'delete-other-windows' -like a single live window - is now official. For details consult the -section "Atomic Windows" in the Elisp manual. - -+++ -*** New 'display-buffer' alist entry 'window-parameters' allows to -assign window parameters to the window used for displaying the buffer. - -+++ -*** New function 'display-buffer-reuse-mode-window' is an action function -suitable for use in 'display-buffer-alist'. For example, to avoid -creating a new window when opening man pages when there's already one, -use - -(add-to-list 'display-buffer-alist - '("\\`\\*Man .*\\*\\'" . - (display-buffer-reuse-mode-window - (inhibit-same-window . nil) - (mode . Man-mode)))) - -+++ -*** New window parameter 'no-delete-other-windows' prevents that -its window gets deleted by 'delete-other-windows'. - -+++ -*** New window parameters 'mode-line-format' and 'header-line-format' -allow to override the buffer-local formats for this window. - -+++ -*** New command 'window-swap-states' swaps the states of two live -windows. - -+++ -*** New functions 'window-pixel-width-before-size-change' and -'window-pixel-height-before-size-change' support detecting which -window changed size when 'window-size-change-functions' are run. - -+++ -*** The new function 'window-lines-pixel-dimensions' returns the pixel -dimensions of a window's text lines. - -+++ -*** The new function 'window-largest-empty-rectangle' returns the -dimensions of the largest rectangular area not occupying any text in a -window's body. - -+++ -*** The semantics of 'mouse-autoselect-window' has changed slightly. -For details see the section "Mouse Window Auto-selection" in the Elisp -manual. - ---- -** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality -can be replicated simply by setting 'comment-auto-fill-only-comments'. - -** New pcase pattern 'rx' to match against a rx-style regular expression. -For details, see the doc string of 'rx--pcase-macroexpander'. +* Lisp Changes in Emacs 27.1 -* Changes in Emacs 26.1 on Non-Free Operating Systems - -+++ -** Intercepting hotkeys on Windows 7 and later now works better. -The new keyboard hooking code properly grabs system hotkeys such as -Win-* and Alt-TAB, in a way that Emacs can get at them before the -system. This makes the 'w32-register-hot-key' functionality work -again on all versions of MS-Windows starting with Windows 7. On -Windows NT and later you can now register any hotkey combination. (On -Windows 9X, the previous limitations, spelled out in the Emacs manual, -still apply.) - ---- -** 'convert-standard-filename' no longer mirrors slashes on MS-Windows. -Previously, on MS-Windows this function converted slash characters in -file names into backslashes. It no longer does that. If your Lisp -program used 'convert-standard-filename' to prepare file names to be -passed to subprocesses (which is not the recommended usage of that -function), you will now have to mirror slashes in your application -code. One possible way is this: - - (let ((start 0)) - (while (string-match "/" file-name start) - (aset file-name (match-beginning 0) ?\\) - (setq start (match-end 0)))) - ---- -** GUI sessions on MS-Windows now treat SIGINT like Posix platforms do. -The effect of delivering a Ctrl-C (SIGINT) signal to a GUI Emacs on -MS-Windows is now the same as on Posix platforms -- Emacs saves the -session and exits. In particular, this will happen if you start -emacs.exe from the Windows shell, then type Ctrl-C into that shell's -window. - ---- -** 'signal-process' supports SIGTRAP on Windows XP and later. -The 'kill' emulation on Windows now maps SIGTRAP to a call to the -'DebugBreakProcess' API. This causes the receiving process to break -execution and return control to the debugger. If no debugger is -attached to the receiving process, the call is typically ignored. -This is in contrast to the default action on POSIX Systems, where it -causes the receiving process to terminate with a core dump if no -debugger has been attached to it. - ---- -** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work -on macOS. - ---- -** Emacs can now be run as a GUI application from the command line on -macOS. - -+++ -** 'ns-appearance' and 'ns-transparent-titlebar' change the appearance -of frame decorations on macOS 10.9+. - ---- -** 'ns-use-thin-smoothing' enables thin font smoothing on macOS 10.8+. - ---- -** 'process-attributes' on Darwin systems now returns more information. +* Changes in Emacs 27.1 on Non-Free Operating Systems ---------------------------------------------------------------------- diff --git a/etc/NEWS.26 b/etc/NEWS.26 new file mode 100644 index 0000000000..a042ce92af --- /dev/null +++ b/etc/NEWS.26 @@ -0,0 +1,1901 @@ +GNU Emacs NEWS -- history of user-visible changes. + +Copyright (C) 2014-2017 Free Software Foundation, Inc. +See the end of the file for license conditions. + +Please send Emacs bug reports to bug-gnu-emacs@gnu.org. +If possible, use M-x report-emacs-bug. + +This file is about changes in Emacs version 26. + +See file HISTORY for a list of GNU Emacs versions and release dates. +See files NEWS.25, NEWS.24, NEWS.23, NEWS.22, NEWS.21, NEWS.20, +NEWS.19, NEWS.18, and NEWS.1-17 for changes in older Emacs versions. + +You can narrow news to a specific version by calling 'view-emacs-news' +with a prefix argument or by typing C-u C-h C-n. + +Temporary note: ++++ indicates that all necessary documentation updates are complete. + (This means all relevant manuals in doc/ AND lisp doc-strings.) +--- means no change in the manuals is needed. +When you add a new item, use the appropriate mark if you are sure it applies, + + +* Installation Changes in Emacs 26.1 + +** By default libgnutls is now required when building Emacs. +Use 'configure --with-gnutls=no' to build even when GnuTLS is missing. + +** GnuTLS version 2.12.2 or later is now required, instead of merely +version 2.6.6 or later. + +** The new option 'configure --with-mailutils' causes Emacs to rely on +GNU Mailutils to retrieve email. It is recommended, and is the +default if GNU Mailutils is installed. When --with-mailutils is not +in effect, the Emacs build procedure by default continues to build and +install a limited 'movemail' substitute that retrieves POP3 email only +via insecure channels; to avoid this problem, use either +--with-mailutils or --without-pop when configuring. + +** The new option 'configure --enable-gcc-warnings=warn-only' causes +GCC to issue warnings without stopping the build. This behavior is +now the default in developer builds. As before, use +'--disable-gcc-warnings' to suppress GCC's warnings, and +'--enable-gcc-warnings' to stop the build if GCC issues warnings. + +** When GCC warnings are enabled, '--enable-check-lisp-object-type' is +now enabled by default when configuring. + ++++ +** The Emacs server now has socket-launching support. This allows +socket based activation, where an external process like systemd can +invoke the Emacs server process upon a socket connection event and +hand the socket over to Emacs. Emacs uses this socket to service +emacsclient commands. This new functionality can be disabled with the +configure option '--disable-libsystemd'. + ++++ +** A systemd user unit file is provided. Use it in the standard way: +systemctl --user enable emacs +(If your Emacs is installed in a non-standard location, you may +need to copy the emacs.service file to eg ~/.config/systemd/user/) + +** New configure option '--disable-build-details' attempts to build an +Emacs that is more likely to be reproducible; that is, if you build +and install Emacs twice, the second Emacs is a copy of the first. +Deterministic builds omit the build date from the output of the +'emacs-version' and 'erc-cmd-SV' functions, and the leave the +following variables nil: 'emacs-build-system', 'emacs-build-time', +'erc-emacs-build-time'. + +--- +** Emacs can now be built with support for Little CMS. + +If the lcms2 library is installed, Emacs will enable features built on +top of that library. The new configure option '--without-lcms2' can +be used to build without lcms2 support even if it is installed. Emacs +linked to Little CMS exposes color management functions in Lisp: the +color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs'. + +** The configure option '--with-gameuser' now defaults to 'no', +as this appears to be the most common configuration in practice. +When it is 'no', the shared game directory and the auxiliary program +update-game-score are no longer needed and are not installed. + +** Emacs no longer works on IRIX. We expect that Emacs users are not +affected by this, as SGI stopped supporting IRIX in December 2013. + + +* Startup Changes in Emacs 26.1 + ++++ +** New option '--fg-daemon'. This is the same as '--daemon', except +it runs in the foreground and does not fork. This is intended for +modern init systems such as systemd, which manage many of the traditional +aspects of daemon behavior themselves. '--bg-daemon' is now an alias +for '--daemon'. + ++++ +** New option '--module-assertions'. +When given this option, Emacs will perform expensive correctness +checks when dealing with dynamic modules. This is intended for module +authors that wish to verify that their module conforms to the module +requirements. The option makes Emacs abort if a module-related +assertion triggers. + ++++ +** Emacs now supports 24-bit colors on capable text terminals +Terminal is automatically initialized to use 24-bit colors if the +required capabilities are found in terminfo. See the FAQ node +"Colors on a TTY" for more information. + ++++ +** Emacs now obeys the X resource "scrollBar" at startup. +The effect is similar to that of "toolBar" resource on the tool bar. + + +* Changes in Emacs 26.1 + +** Security vulnerability related to Enriched Text mode is removed. + ++++ +*** Enriched Text mode does not evaluate Lisp in 'display' properties. +This feature allows saving 'display' properties as part of text. +Emacs 'display' properties support evaluation of arbitrary Lisp forms +as part of processing the property for display, so displaying Enriched +Text could be vulnerable to executing arbitrary malicious Lisp code +included in the text (e.g., sent as part of an email message). +Therefore, execution of arbitrary Lisp forms in 'display' properties +decoded by Enriched Text mode is now disabled by default. Customize +the new option 'enriched-allow-eval-in-display-props' to a non-nil +value to allow Lisp evaluation in decoded 'display' properties. + +This vulnerability was introduced in Emacs 21.1. To work around that +in Emacs versions before 25.3, append the following to your ~/.emacs +init file: + + (eval-after-load "enriched" + '(defun enriched-decode-display-prop (start end &optional param) + (list start end))) + ++++ +** Functions in 'write-contents-functions' can fully short-circuit the +'save-buffer' process. Previously, saving a buffer that was not +visiting a file would always prompt for a file name. Now it only does +so if 'write-contents-functions' is nil (or all its functions return +nil). A non-nil buffer-local value for this variable is sufficient +for 'save-some-buffers' to consider the buffer for saving. + +--- +** New variable 'executable-prefix-env' for inserting magic signatures. +This variable affects the format of the interpreter magic number +inserted by 'executable-set-magic'. If non-nil, the magic number now +takes the form "#!/usr/bin/env interpreter", otherwise the value +determined by 'executable-prefix', which is by default +"#!/path/to/interpreter". By default, 'executable-prefix-env' is nil, +so the default behavior is not changed. + ++++ +** The variable 'emacs-version' no longer includes the build number. +This is now stored separately in a new variable, 'emacs-build-number'. + ++++ +** Emacs now provides a limited form of concurrency with Lisp threads. +Concurrency in Emacs Lisp is "mostly cooperative", meaning that +Emacs will only switch execution between threads at well-defined +times: when Emacs waits for input, during blocking operations related +to threads (such as mutex locking), or when the current thread +explicitly yields. Global variables are shared among all threads, but +a 'let' binding is thread-local. Each thread also has its own current +buffer and its own match data. + +See the chapter "Threads" in the ELisp manual for full documentation +of these facilities. + ++++ +** The new user variable 'electric-quote-chars' provides a list +of curved quotes for 'electric-quote-mode', allowing user to choose +the types of quotes to be used. + +--- +** The new user option 'electric-quote-context-sensitive' makes +'electric-quote-mode' context sensitive. If it is non-nil, you can +type an ASCII apostrophe to insert an opening or closing quote, +depending on context. Emacs will replace the apostrophe by an opening +quote character at the beginning of the buffer, the beginning of a +line, after a whitespace character, and after an opening parenthesis; +and it will replace the apostrophe by a closing quote character in all +other cases. + +--- +** The new variable 'electric-quote-inhibit-functions' controls when +to disable electric quoting based on context. Major modes can add +functions to this list; Emacs will temporarily disable +'electric-quote-mode' whenever any of the functions returns non-nil. +This can be used by major modes that derive from 'text-mode' but allow +inline code segments, such as 'markdown-mode'. + ++++ +** The new user variable 'dired-omit-case-fold' allows the user to +customize the case-sensitivity of dired-omit-mode. It defaults to +the same sensitivity as that of the filesystem for the corresponding +dired buffer. + ++++ +** Emacs now uses double buffering to reduce flicker when editing and +resizing graphical Emacs frames on the X Window System. This support +requires the DOUBLE-BUFFER extension, which major X servers have +supported for many years. If your system has this extension, but an +Emacs built with double buffering misbehaves on some displays you use, +you can disable the feature by adding + + '(inhibit-double-buffering . t) + +to default-frame-alist. Or inject this parameter into the selected +frame by evaluating this form: + + (modify-frame-parameters nil '((inhibit-double-buffering . t))) + +--- +The group 'wp', whose label was "text", is now deprecated. +Use the new group 'text', which inherits from 'wp', instead. + ++++ +** The new function 'call-shell-region' executes a command in an +inferior shell with the buffer region as input. + ++++ +** The new user option 'shell-command-dont-erase-buffer' controls +if the output buffer is erased between shell commands; if non-nil, +the output buffer is not erased; this variable also controls where +to set the point in the output buffer: beginning of the output, +end of the buffer or save the point. +When 'shell-command-dont-erase-buffer' is nil, the default value, +the behavior of 'shell-command', 'shell-command-on-region' and +'async-shell-command' is as usual. + ++++ +** The new user option 'async-shell-command-display-buffer' controls +whether the output buffer of an asynchronous command is shown +immediately, or only when there is output. + ++++ +** The new user option 'mouse-select-region-move-to-beginning' +controls the position of point when double-clicking mouse-1 on the end +of a parenthetical grouping or string-delimiter: the default value nil +keeps point at the end of the region, setting it to non-nil moves +point to the beginning of the region. + ++++ +** The new user option 'mouse-drag-and-drop-region' allows to drag the +entire region of text to another place or another buffer. + ++++ +** The new user option 'confirm-kill-processes' allows the user to +skip a confirmation prompt for killing subprocesses when exiting +Emacs. When set to t (the default), Emacs will prompt for +confirmation before killing subprocesses on exit, which is the same +behavior as before. + +--- +** 'find-library-name' will now fall back on looking at 'load-history' +to try to locate libraries that have been loaded with an explicit path +outside 'load-path'. + ++++ +** Faces in 'minibuffer-prompt-properties' no longer overwrite properties +in the text in functions like 'read-from-minibuffer', but instead are +added to the end of the face list. This allows users to say things +like '(read-from-minibuffer (propertize "Enter something: " 'face 'bold))'. + ++++ +** The new variable 'extended-command-suggest-shorter' has been added +to control whether to suggest shorter 'M-x' commands or not. + +--- +** icomplete now respects 'completion-ignored-extensions'. + ++++ +** Non-breaking hyphens are now displayed with the 'nobreak-hyphen' +face instead of the 'escape-glyph' face. + ++++ +** Approximations to quotes are now displayed with the new 'homoglyph' +face instead of the 'escape-glyph' face. + ++++ +** New face 'header-line-highlight'. +This face is the header-line analogue of 'mode-line-highlight'; it +should be the preferred mouse-face for mouse-sensitive elements in the +header line. + +--- +** 'C-x h' ('mark-whole-buffer') will now avoid marking the prompt +part of minibuffers. + +--- +** 'find-library' now takes a prefix argument to pop to a different +window. + +--- +** 'fill-paragraph' no longer marks the buffer as changed unless it +actually changed something. + +--- +** The locale language name 'ca' is now mapped to the language +environment 'Catalan', which has been added. + +--- +** 'align-regexp' has a separate history for its interactive argument. +'align-regexp' no longer shares its history with all other +history-less functions that use 'read-string'. + ++++ +** The networking code has been reworked so that it's more +asynchronous than it was (when specifying :nowait t in +'make-network-process'). How asynchronous it is varies based on the +capabilities of the system, but on a typical GNU/Linux system the DNS +resolution, the connection, and (for TLS streams) the TLS negotiation +are all done without blocking the main Emacs thread. To get +asynchronous TLS, the TLS boot parameters have to be passed in (see +the manual for details). + +Certain process oriented functions (like 'process-datagram-address') +will block until socket setup has been performed. The recommended way +to deal with asynchronous sockets is to avoid interacting with them +until they have changed status to "run". This is most easily done +from a process sentinel. + +--- +** 'make-network-process' and 'open-network-stream' sometimes allowed +:service to be an integer string (e.g., :service "993") and sometimes +required an integer (e.g., :service 993). This difference has been +eliminated, and integer strings work everywhere. + +--- +** It is possible to disable attempted recovery on fatal signals. +Two new variables support disabling attempts to recover from stack +overflow and to avoid automatic auto-save when Emacs is delivered a +fatal signal. 'attempt-stack-overflow-recovery', if set to 'nil', +will disable attempts to recover from C stack overflows; Emacs will +then crash as with any other fatal signal. +'attempt-orderly-shutdown-on-fatal-signal', if set to 'nil', will +disable attempts to auto-save the session and shut down in an orderly +fashion when Emacs receives a fatal signal; instead, Emacs will +terminate immediately. Both variables are non-'nil' by default. +These variables are for users who would like to avoid the small +probability of data corruption due to techniques Emacs uses to recover +in these situations. + ++++ +** File local and directory local variables are now initialized each +time the major mode is set, not just when the file is first visited. +These local variables will thus not vanish on setting a major mode. + ++++ +** A second dir-local file (.dir-locals-2.el) is now accepted. +See the variable 'dir-locals-file-2' for more information. + ++++ +** Connection-local variables can be used to specify local variables +with a value depending on the connected remote server. For details, +see the node "Connection Local Variables" in the ELisp manual. + +--- +** International domain names (IDNA) are now encoded via the new +puny.el library, so that one can visit Web sites with non-ASCII URLs. + ++++ +** The new 'timer-list' command lists all active timers in a buffer, +where you can cancel them with the 'c' command. + ++++ +** 'switch-to-buffer-preserve-window-point' now defaults to t. + ++++ +** The new variable 'debugger-stack-frame-as-list' allows displaying +all call stack frames in a Lisp backtrace buffer as lists. Both +debug.el and edebug.el have been updated to heed to this variable. + +--- +** Values in call stack frames are now displayed using 'cl-prin1'. +The old behaviour of using 'prin1' can be restored by customizing the +new option 'debugger-print-function'. + ++++ +** NUL bytes in text copied to the system clipboard are now replaced with "\0". + ++++ +** The new variable 'x-ctrl-keysym' has been added to the existing +roster of X keysyms. It can be used in combination with another +variable of this kind to swap modifiers in Emacs. + +--- +** New input methods: 'cyrillic-tuvan', 'polish-prefix'. + +--- +** The 'dutch' input method no longer attempts to support Turkish too. +Also, it no longer converts 'IJ' and 'ij' to the compatibility +characters U+0132 LATIN CAPITAL LIGATURE IJ and U+0133 LATIN SMALL +LIGATURE IJ. + ++++ +** File name quoting by adding the prefix "/:" is now possible for the +local part of a remote file name. Thus, if you have a directory named +"/~" on the remote host "foo", you can prevent it from being +substituted by a home directory by writing it as "/foo:/:/~/file". + ++++ +** The new variable 'maximum-scroll-margin' allows having effective +settings of 'scroll-margin' up to half the window size, instead of +always restricting the margin to a quarter of the window. + ++++ +** Emacs can scroll horizontally using mouse, touchpad, and trackbar. +You can enable this by customizing 'mwheel-tilt-scroll-p'. If you +want to reverse the direction of the scroll, customize +'mwheel-flip-direction'. + ++++ +** Emacsclient has a new option -u/--suppress-output. +This option suppresses display of return values from the server +process. + ++++ +** Emacsclient has a new option -T/--tramp. +This helps with using a local Emacs session as the server for a remote +emacsclient. With appropriate setup, one can now set the EDITOR +environment variable on a remote machine to emacsclient, and +use the local Emacs to edit remote files via Tramp. See the node +"emacsclient Options" in the user manual for the details. + +--- +** New user option 'dig-program-options' and extended functionality +for DNS-querying functions 'nslookup-host', 'dns-lookup-host', +and 'run-dig'. Each function now accepts an optional name server +argument interactively (with a prefix argument) and non-interactively. + ++++ +** 'describe-key-briefly' now ignores mouse movement events. + ++++ +** The new variable 'eval-expression-print-maximum-character' prevents +large integers from being displayed as characters by 'M-:' and similar +commands. + +--- +** Two new commands for finding the source code of Emacs Lisp +libraries: 'find-library-other-window' and 'find-library-other-frame'. + ++++ +** The new variable 'display-raw-bytes-as-hex' allows to change the +display of raw bytes from octal to hex. + ++++ +** You can now provide explicit field numbers in format specifiers. +For example, '(format "%2$s %1$s" "X" "Y")' produces "Y X". + ++++ +** Emacs now supports optional display of line numbers in the buffer. +This is similar to what linum-mode provides, but much faster and +doesn't usurp the display margin for the line numbers. Customize the +buffer-local variable 'display-line-numbers' to activate this optional +display. Alternatively, you can use the `display-line-numbers-mode' +minor mode or the global `global-display-line-numbers-mode'. When +using these modes, customize `display-line-numbers-type' with the same +value as you would use with `display-line-numbers'. + +Line numbers are not displayed at all in minibuffer windows and in +tooltips, as they are not useful there. + +Lisp programs can disable line-number display for a particular screen +line by putting the 'display-line-numbers-disable' text property or +overlay property on the first character of that screen line. This is +intended for add-on packages that need a finer control of the display. + +Lisp programs that need to know how much screen estate is used up for +line-number display in a window can use the new function +'line-number-display-width'. + +Linum mode and all similar packages are henceforth becoming obsolete. +Users and developers are encouraged to switch to this new feature +instead. + ++++ +** emacsclient now accepts command-line options in ALTERNATE_EDITOR +and --alternate-editor. For example, ALTERNATE_EDITOR="emacs -Q -nw". +Arguments may be quoted "like this", so that for example an absolute +path containing a space may be specified; quote escaping is not +supported. + + +* Editing Changes in Emacs 26.1 + ++++ +** New variable 'column-number-indicator-zero-based'. +Traditionally, in Column Number mode, the displayed column number +counts from zero starting at the left margin of the window. This +behavior is now controlled by 'column-number-indicator-zero-based'. +If you would prefer for the displayed column number to count from one, +you may set this variable to nil. (Behind the scenes, there is now a +new mode line construct, '%C', which operates exactly as '%c' does +except that it counts from one.) + ++++ +** New single-line horizontal scrolling mode. +The 'auto-hscroll-mode' variable can now have a new special value, +'current-line', which causes only the line where the cursor is +displayed to be horizontally scrolled when lines are truncated on +display and point moves outside the left or right window margin. + ++++ +** New mode line constructs '%o' and '%q', and user option +'mode-line-percent-position'. '%o' displays the "degree of travel" of +the window through the buffer. Unlike the default '%p', this +percentage approaches 100% as the window approaches the end of the +buffer. '%q' displays the percentage offsets of both the start and +the end of the window, e.g. "5-17%". The new option +'mode-line-percent-position' makes it easier to switch between '%p', +'%P', and these new constructs. + ++++ +** Two new user options 'list-matching-lines-jump-to-current-line' and +'list-matching-lines-current-line-face' to show highlighted the current +line in *Occur* buffer. + ++++ +** The 'occur' command can now operate on the region. + ++++ +** New bindings for 'query-replace-map'. +'undo', undo the last replacement; bound to 'u'. +'undo-all', undo all replacements; bound to 'U'. + +--- +** 'delete-trailing-whitespace' deletes whitespace after form feed. +In modes where form feed was treated as a whitespace character, +'delete-trailing-whitespace' would keep lines containing it unchanged. +It now deletes whitespace after the last form feed thus behaving the +same as in modes where the character is not whitespace. + +--- +** Emacs no longer prompts about editing a changed file when the file's +content is unchanged. Instead of only checking the modification time, +Emacs now also checks the file's actual content before prompting the user. + +--- +** Various casing improvements. + +*** 'upcase', 'upcase-region' et al. convert title case characters +(such as Dz) into their upper case form (such as DZ). + +*** 'capitalize', 'upcase-initials' et al. make use of title-case forms +of initial characters (correctly producing for example Džungla instead +of incorrect DŽungla). + +*** Characters which turn into multiple ones when cased are correctly handled. +For example, fi ligature is converted to FI when upper cased. + +*** Greek small sigma is correctly handled when at the end of the word. +Strings such as ΌΣΟΣ are now correctly converted to Όσος when +capitalized instead of incorrect Όσοσ (compare lowercase sigma at the +end of the word). + ++++ +** Emacs can now auto-save buffers to visited files in a more robust +manner via the new mode 'auto-save-visited-mode'. Unlike +'auto-save-visited-file-name', this mode uses the normal saving +procedure and therefore obeys saving hooks. +'auto-save-visited-file-name' is now obsolete. + ++++ +** New behavior of 'mark-defun'. +Prefix argument selects that many (or that many more) defuns. +Negative prefix arg flips the direction of selection. Also, +'mark-defun' between defuns correctly selects N following defuns (or +-N previous for negative arguments). Finally, comments preceding the +defun are selected unless they are separated from the defun by a blank +line. + +--- +** New command 'replace-buffer-contents'. +This command replaces the contents of the accessible portion of the +current buffer with the contents of the accessible portion of a +different buffer while keeping point, mark, markers, and text +properties as intact as possible. + ++++ +** New commands 'apropos-local-variable' and 'apropos-local-value. +These are buffer-local versions of 'apropos-variable' and +'apropos-value', respectively. They show buffer-local variables whose +names and values, respectively, match a given pattern. + ++++ +** More user control of reordering bidirectional text for display. +The two new variables, 'bidi-paragraph-start-re' and +'bidi-paragraph-separate-re', allow customization of what exactly are +paragraphs, for the purposes of bidirectional display. + + +* Changes in Specialized Modes and Packages in Emacs 26.1 + +--- +** New function `cl-generic-p'. + +** Dired + ++++ +*** You can answer 'all' in 'dired-do-delete' to delete recursively all +remaining directories without more prompts. + ++++ +*** Dired supports wildcards in the directory part of the file names. + ++++ +*** You can now use '`?`' in 'dired-do-shell-command'. +It gets replaced by the current file name, like ' ? '. + ++++ +*** A new option 'dired-always-read-filesystem' default to nil. +If non-nil, buffers visiting files are reverted before search them; +for instance, in 'dired-mark-files-containing-regexp' a non-nil value +of this option means the file is revisited in a temporary buffer; +this temporary buffer is the actual buffer searched: the original buffer +visiting the file is not modified. + +--- +*** Users can now customize mouse clicks in Dired in a more flexible way. +The new command 'dired-mouse-find-file' can be bound to a mouse click +and used to visit files/directories in Dired in the selected window. +The new command 'dired-mouse-find-file-other-frame' similarly visits +files/directories in another frame. You can write your own commands +that invoke 'dired-mouse-find-file' with non-default optional +arguments, to tailor the effects of mouse clicks on file names in +Dired buffers. + ++++ +*** In wdired, when editing files to contain slash characters, +the resulting directories are automatically created. Whether to do +this is controlled by the 'wdired-create-parent-directories' variable. + ++++ +*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for +viewing HTML files and the like. + +--- +*** New variable 'dired-clean-confirm-killing-deleted-buffers' +controls whether Dired asks to kill buffers visiting deleted files and +directories. The default is t, so Dired asks for confirmation, to +keep previous behavior. + +--- +** html2text is now marked obsolete. + +--- +** smerge-refine-regions can refine regions in separate buffers + +--- +** Info menu and index completion uses substring completion by default. +This can be customized via the info-menu category in +completion-category-override. + ++++ +** The ancestor buffer is shown by default in 3-way merges. +A new option ediff-show-ancestor and a new toggle +ediff-toggle-show-ancestor. + +--- +** TeX: Add luatex and xetex as alternatives to pdftex + +** Electric-Buffer-menu + ++++ +*** Key 'U' is bound to 'Buffer-menu-unmark-all' and key 'M-DEL' is +bound to 'Buffer-menu-unmark-all-buffers'. + +** bs + +--- +*** Two new commands 'bs-unmark-all', bound to 'U', and +'bs-unmark-previous', bound to . + +** Buffer-menu + ++++ +*** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and +'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. + +--- +** Checkdoc + +*** 'checkdoc-arguments-in-order-flag' now defaults to nil. + +** Gnus + +--- +*** The .newsrc file will now only be saved if the native select +method is an NNTP select method. + ++++ +*** A new command for sorting articles by readedness marks has been +added: 'C-c C-s C-m C-m'. + +** Ibuffer + +--- +*** New command 'ibuffer-jump'. + +--- +*** New filter commands 'ibuffer-filter-by-basename', +'ibuffer-filter-by-file-extension', 'ibuffer-filter-by-directory', +'ibuffer-filter-by-starred-name', 'ibuffer-filter-by-modified' +and 'ibuffer-filter-by-visiting-file'; bound respectively +to '/b', '/.', '//', '/*', '/i' and '/v'. + +--- +*** Two new commands 'ibuffer-filter-chosen-by-completion' +and 'ibuffer-and-filter', the second bound to '/&'. + +--- +*** The commands 'ibuffer-pop-filter', 'ibuffer-pop-filter-group', +'ibuffer-or-filter' and 'ibuffer-filter-disable' have the alternative +bindings '/', '/S-', '/|' and '/DEL', respectively. + +--- +*** The data format specifying filters has been extended to allow +explicit logical 'and', and a more flexible form for logical 'not'. +See 'ibuffer-filtering-qualifiers' doc string for full details. + +--- +*** A new command 'ibuffer-copy-buffername-as-kill'; bound +to 'B'. + +--- +*** New command 'ibuffer-change-marks'; bound to '* c'. + +--- +*** A new command 'ibuffer-mark-by-locked' to mark +all locked buffers; bound to '% L'. + +--- +*** A new option 'ibuffer-locked-char' to indicate +locked buffers; Ibuffer shows a new column displaying +'ibuffer-locked-char' for locked buffers. + +--- +*** A new command 'ibuffer-unmark-all-marks' to unmark +all buffers without asking confirmation; bound to +'U'; 'ibuffer-do-replace-regexp' bound to 'r'. + +--- +*** A new command 'ibuffer-mark-by-content-regexp' to mark buffers +whose content matches a regexp; bound to '% g'. + +--- +*** Two new options 'ibuffer-never-search-content-name' and +'ibuffer-never-search-content-mode' used by +'ibuffer-mark-by-content-regexp'. + +** Browse-URL + +--- +*** Support for opening links to man pages in Man or WoMan mode. + +** Comint + +--- +*** New user option 'comint-move-point-for-matching-input' to control +where to place point after C-c M-r and C-c M-s. + +** Compilation mode + +--- +*** Messages from CMake are now recognized. + ++++ +*** The number of errors, warnings, and informational messages is now +displayed in the mode line. These are updated as compilation +proceeds. + +** Grep + +--- +*** Grep commands will now use GNU grep's '--null' option if +available, which allows distinguishing the filename from contents if +they contain colons. This can be controlled by the new custom option +'grep-use-null-filename-separator'. + +--- +*** The grep/rgrep/lgrep functions will now ask about saving files +before running. This is controlled by the 'grep-save-buffers' +variable. + +** Edebug + +--- +*** Edebug can be prevented from pausing 1 second after reaching a +breakpoint (e.g. with "f" and "o") by customizing the new option +'edebug-sit-on-break'. + ++++ +*** New customizable option 'edebug-max-depth' +This allows to enlarge the maximum recursion depth when instrumenting +code. + +** Eshell + +--- +*** 'eshell-input-filter's value is now a named function +'eshell-input-filter-default', and has a new custom option +'eshell-input-filter-initial-space' to ignore adding commands prefixed +with blank space to eshell history. + +** eww + ++++ +*** New 'M-RET' command for opening a link at point in a new eww buffer. + ++++ +*** A new 's' command for switching to another eww buffer via the minibuffer. + +--- +*** The 'o' command ('shr-save-contents') has moved to 'O' to avoid collision +with the 'o' command from 'image-map'. + ++++ +*** A new command 'C' ('eww-toggle-colors') can be used to toggle +whether to use the HTML-specified colors or not. The user can also +customize the 'shr-use-colors' variable. + +--- +*** Images that are being loaded are now marked with gray +"placeholder" images of the size specified by the HTML. They are then +replaced by the real images asynchronously, which will also now +respect width/height HTML specs (unless they specify widths/heights +bigger than the current window). + +--- +*** The 'w' command on links is now 'shr-maybe-probe-and-copy-url'. +'shr-copy-url' now only copies the url at point; users who wish to +avoid accidentally accessing remote links may rebind 'w' and 'u' in +'eww-link-keymap' to it. + + +** Ido + +--- +*** The commands 'find-alternate-file-other-window', +'dired-other-window', 'dired-other-frame', and +'display-buffer-other-window' are now remapped to Ido equivalents if +Ido mode is active. + +** Images + ++++ +*** Images are automatically scaled before displaying based on the +'image-scaling-factor' variable (if Emacs supports scaling the images +in question). + ++++ +*** It's now possible to specify aspect-ratio preserving combinations +of :width/:max-height and :height/:max-width keywords. In either +case, the "max" keywords win. (Previously some combinations would, +depending on the aspect ratio of the image, just be ignored and in +other instances this would lead to the aspect ratio not being +preserved.) + ++++ +*** Images inserted with 'insert-image' and related functions get a +keymap put into the text properties (or overlays) that span the +image. This keymap binds keystrokes for manipulating size and +rotation, as well as saving the image to a file. These commands are +also available in 'image-mode'. + ++++ +*** A new library for creating and manipulating SVG images has been +added. See the "SVG Images" section in the Lisp reference manual for +details. + ++++ +*** New setf-able function to access and set image parameters is +provided: 'image-property'. + +--- +*** New commands 'image-scroll-left' and 'image-scroll-right' +for 'image-mode' that complement 'image-scroll-up' and +'image-scroll-down': they have the same prefix arg behavior and stop +at image boundaries. + +** Image-Dired + +--- +*** Now provides a minor mode 'image-dired-minor-mode' which replaces +the function 'image-dired-setup-dired-keybindings'. + +--- +*** Thumbnail generation is now asynchronous. +The number of concurrent processes is limited by the variable +'image-dired-thumb-job-limit'. + +--- +*** 'image-dired-thumbnail-storage' has a new option 'standard-large' +for generating 256x256 thumbnails according to the Thumbnail Managing +Standard. + +--- +*** Inherits movement keys from 'image-mode' for viewing full images. +This includes the usual char, line, and page movement commands. + +--- +*** All the -options types have been changed to argument lists +instead of shell command strings. This change affects +'image-dired-cmd-create-thumbnail-options', +'image-dired-cmd-create-temp-image-options', +'image-dired-cmd-rotate-thumbnail-options', +'image-dired-cmd-rotate-original-options', +'image-dired-cmd-write-exif-data-options', +'image-dired-cmd-read-exif-data-options', and introduces +'image-dired-cmd-pngnq-options', 'image-dired-cmd-pngcrush-options', +'image-dired-cmd-create-standard-thumbnail-options' + +--- +*** Recognizes more tools by default, including pngnq-s9 and OptiPNG + +--- +*** 'find-file' and related commands now work on thumbnails and +displayed images, providing a default argument of the original file name +via an addition to 'file-name-at-point-functions'. + +--- +** The default 'Info-default-directory-list' no longer checks some obsolete +directory suffixes (gnu, gnu/lib, gnu/lib/emacs, emacs, lib, lib/emacs) +when searching for info directories. + ++++ +** The commands that add ChangeLog entries now prefer a VCS root directory +for the ChangeLog file, if none already exists. Customize +'change-log-directory-files' to nil for the old behavior. + +--- +** Support for non-string values of 'time-stamp-format' has been removed. + +** Message + +--- +*** 'message-use-idna' now defaults to t (because Emacs comes with +built-in IDNA support now). + +--- +*** When sending HTML messages with embedded images, and you have +exiftool installed, and you rotate images with EXIF data (i.e., +JPEGs), the rotational information will be inserted into the outgoing +image in the message. (The original image will not have its +orientation affected.) + +--- +*** The 'message-valid-fqdn-regexp' variable has been removed, since +there are now top-level domains added all the time. Message will no +longer warn about sending emails to top-level domains it hasn't heard +about. + +*** 'message-beginning-of-line' (bound to C-a) understands folded headers. +In 'visual-line-mode' it will look for the true beginning of a header +while in non-'visual-line-mode' it will move the point to the indented +header's value. + +** Package + ++++ +*** The new variable 'package-gnupghome-dir' has been added to control +where the GnuPG home directory (used for signature verification) is +located and whether GnuPG's option "--homedir" is used or not. + +--- +*** Deleting a package no longer respects 'delete-by-moving-to-trash'. + +** Tramp + ++++ +*** The method part of remote file names is mandatory now. +A valid remote file name starts with "/method:host:" or +"/method:user@host:". + ++++ +*** The new pseudo method "-" is a marker for the default method. +"/-::" is the shortest remote file name then. + ++++ +*** The command 'tramp-change-syntax' allows to choose an alternative +remote file name syntax. + ++++ +*** New connection method "sg", which supports editing files under a +different group ID. + ++++ +*** New connection method "doas" for OpenBSD hosts. + ++++ +*** New connection method "gdrive", which allows to access Google +Drive onsite repositories. + ++++ +*** Gateway methods in Tramp have been removed. +Instead, the Tramp manual documents how to configure ssh and PuTTY +accordingly. + ++++ +*** Setting the "ENV" environment variable in +'tramp-remote-process-environment' enables reading of shell +initialization files. + +--- +*** Tramp is able now to send SIGINT to remote asynchronous processes. + +--- +*** Variable 'tramp-completion-mode' is obsoleted. + +--- +** 'auto-revert-use-notify' is set back to t in 'global-auto-revert-mode'. + +** JS mode + +--- +*** JS mode now sets 'comment-multi-line' to t. + +--- +*** New variable 'js-indent-align-list-continuation', when set to nil, +will not align continuations of bracketed lists, but will indent them +by the fixed width 'js-indent-level'. + +** CSS mode + +--- +*** Support for completing attribute values, at-rules, bang-rules, +HTML tags, classes and IDs using the 'completion-at-point' command. +Completion candidates for HTML classes and IDs are retrieved from open +HTML mode buffers. + +--- +*** CSS mode now binds 'C-h S' to a function that will show +information about a CSS construct (an at-rule, property, pseudo-class, +pseudo-element, with the default being guessed from context). By +default the information is looked up on the Mozilla Developer Network, +but this can be customized using 'css-lookup-url-format'. + +--- +*** CSS colors are fontified using the color they represent as the +background. For instance, #ff0000 would be fontified with a red +background. + ++++ +** Emacs now supports character name escape sequences in character and +string literals. The syntax variants \N{character name} and +\N{U+code} are supported. + ++++ +** Prog mode has some support for multi-mode indentation. +This allows better indentation support in modes that support multiple +programming languages in the same buffer, like literate programming +environments or ANTLR programs with embedded Python code. + +A major mode can provide indentation context for a sub-mode through +the 'prog-indentation-context' variable. To support this, modes that +provide indentation should use 'prog-widen' instead of 'widen' and +'prog-first-column' instead of a literal zero. See the node +"Mode-Specific Indent" in the ELisp manual for more details. + +** ERC + +--- +*** New variable 'erc-default-port-tls' used to connect to TLS IRC +servers. + +** URL + ++++ +*** The new function 'url-cookie-delete-cookie' can be used to +programmatically delete all cookies, or cookies from a specific +domain. + ++++ +*** 'url-retrieve-synchronously' now takes an optional timeout parameter. + +--- +*** The URL package now support HTTPS over proxies supporting CONNECT. + ++++ +*** 'url-user-agent' now defaults to 'default', and the User-Agent +string is computed dynamically based on 'url-privacy-level'. + +** VC and related modes + +--- +*** The VC state indicator in the mode line now defaults to more +colorful faces to make it more obvious to the user what the state is. +See the 'vc-faces' customization group. + ++++ +*** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various +branch-related commands on a keymap bound to 'B'. + +** CC mode + +--- +*** Opening a .h file will turn C or C++ mode depending on language used. +This is done with the help of 'c-or-c++-mode' function which analyses +contents of the buffer to determine whether it's a C or C++ source +file. + +--- +** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses +to a format suitable for reverse lookup zone files. + +** Ispell + ++++ +*** Enchant is now supported as a spell-checker. + +Enchant is a meta-spell-checker that uses providers +such as Hunspell to do the actual checking. With it, users can use +spell-checkers not directly supported by Emacs, such as Voikko, Hspell +and AppleSpell, more easily share personal word-lists with other +programs, and configure different spelling-checkers for different +languages. (Version 2.1.0 or later of Enchant is required.) + +** Flymake + ++++ +*** Emacs no longer prompts the user before killing Flymake processes on exit. + + +* New Modes and Packages in Emacs 26.1 + +** New Elisp data-structure library 'radix-tree'. + +** New library 'xdg' with utilities for some XDG standards and specs. + +** HTML + ++++ +*** A new submode of 'html-mode', 'mhtml-mode', is now the default +mode for *.html files. This mode handles indentation, +fontification, and commenting for embedded JavaScript and CSS. + +** New mode 'conf-toml-mode' is a sub-mode of conf-mode, specialized + for editing TOML files. + +** New mode 'conf-desktop-mode' is a sub-mode of conf-unix-mode, +specialized for editing freedesktop.org desktop entries. + +** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. + +** New major mode 'less-css-mode' (a minor variant of 'css-mode') for +editing Less files. + + +* Incompatible Lisp Changes in Emacs 26.1 + +--- +*** password-data is now a hash-table +so that `password-read' can use any object for the `key' argument. + ++++ +*** Command 'dired-mark-extension' now automatically prepends a '.' to the +extension when not present. The new command 'dired-mark-suffix' behaves +similarly but it doesn't prepend a '.'. + ++++ +** Certain cond/pcase/cl-case forms are now compiled using a faster jump +table implementation. This uses a new bytecode op 'switch', which +isn't compatible with previous Emacs versions. This functionality can +be disabled by setting 'byte-compile-cond-use-jump-table' to nil. + +--- +** The alist 'ucs-names' is now a hash table. + +--- +** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. +The incumbent 'if-let' and 'when-let' are now marked obsolete. +'if-let*' and 'when-let*' do not accept the single tuple special case. +New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax +of the same name. 'if-let*' and 'when-let*' now accept the same +binding syntax as 'and-let*'. + +--- +** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term +mode to send the same escape sequences that xterm does. This makes +things like forward-word in readline work. + +--- +** hideshow mode got four key bindings that are analogous to outline +mode bindings: 'C-c @ C-a', 'C-c @ C-t', 'C-c @ C-d', and 'C-c @ C-e.' + +--- +** Customizable variable 'query-replace-from-to-separator' +now doesn't propertize the string value of the separator. +Instead, text properties are added by query-replace-read-from. +Additionally, the new nil value restores pre-24.5 behavior +of not providing replacement pairs via the history. + +--- +** Some obsolete functions, variables, and faces have been removed: +*** make-variable-frame-local. Variables cannot be frame-local any more. +*** From subr.el: window-dot, set-window-dot, read-input, show-buffer, +eval-current-buffer, string-to-int +*** icomplete-prospects-length. +*** All the default-FOO variables that hold the default value of the +FOO variable. Use 'default-value' and 'setq-default' to access and +change FOO, respectively. The exhaustive list of removed variables is: +'default-mode-line-format', 'default-header-line-format', +'default-line-spacing', 'default-abbrev-mode', 'default-ctl-arrow', +'default-truncate-lines', 'default-left-margin', 'default-tab-width', +'default-case-fold-search', 'default-left-margin-width', +'default-right-margin-width', 'default-left-fringe-width', +'default-right-fringe-width', 'default-fringes-outside-margins', +'default-scroll-bar-width', 'default-vertical-scroll-bar', +'default-indicate-empty-lines', 'default-indicate-buffer-boundaries', +'default-fringe-indicator-alist', 'default-fringe-cursor-alist', +'default-scroll-up-aggressively', 'default-scroll-down-aggressively', +'default-fill-column', 'default-cursor-type', +'default-cursor-in-non-selected-windows', +'default-buffer-file-coding-system', 'default-major-mode', and +'default-enable-multibyte-characters'. +*** Many variables obsoleted in 22.1 referring to face symbols + ++++ +** The variable 'text-quoting-style' no longer affects the treatment +of curved quotes in format arguments to functions like 'message' and +'format-message'. In particular, when this variable's value is +'grave', all quotes in formats are output as-is. + +--- +** Functions like 'check-declare-file' and 'check-declare-directory' +now generate less chatter and more-compact diagnostics. The auxiliary +function 'check-declare-errmsg' has been removed. + ++++ +** The regular expression character class [:blank:] now matches +Unicode horizontal whitespace as defined in the Unicode Technical +Standard #18. If you only want to match space and tab, use [ \t] +instead. + ++++ +** 'min' and 'max' no longer round their results. +Formerly, they returned a floating-point value if any argument was +floating-point, which was sometimes numerically incorrect. For +example, on a 64-bit host (max 1e16 10000000000000001) now returns its +second argument instead of its first. + ++++ +** The variable 'old-style-backquotes' has been made internal and +renamed to 'lread--old-style-backquotes'. No user code should use +this variable. + +--- +** To avoid confusion caused by "smart quotes", the reader no longer +accepts Lisp symbols which begin with the following quotation +characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. + ++++ +** 'default-file-name-coding-system' now defaults to a coding system +that does not process CRLF. For example, it defaults to utf-8-unix +instead of to utf-8. Before this change, Emacs would sometimes +mishandle file names containing these control characters. + ++++ +** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no +longer quietly mutate the target of a local symbolic link, so that +Emacs can access and copy them reliably regardless of their contents. +The following changes are involved. + +--- +*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to +symbolic links whose targets begin with "/" and contain ":". For +example, if a symbolic link "x" has a target "/y:z:", '(file-symlink-p +"x")' now returns "/y:z:" rather than "/:/y:z:". + +--- +*** 'make-symbolic-link' no longer looks for file name handlers of +target when creating a symbolic link. For example, +'(make-symbolic-link "/y:z:" "x")' now creates a symbolic link to +"/y:z:" instead of failing. + ++++ +*** 'make-symbolic-link' removes the remote part of a link target if +target and newname have the same remote part. For example, +'(make-symbolic-link "/x:y:a" "/x:y:b")' creates a link with the +literal string "a"; and '(make-symbolic-link "/x:y:a" "/x:z:b")' +creates a link with the literal string "/x:y:a" instead of failing. + ++++ +*** 'make-symbolic-link' now expands a link target with leading "~" +only when the optional third arg is an integer, as when invoked +interactively. For example, '(make-symbolic-link "~y" "x")' now +creates a link with target the literal string "~y"; to get the old +behavior, use '(make-symbolic-link (expand-file-name "~y") "x")'. To +avoid this expansion in interactive use, you can now prefix the link +target with "/:". For example, '(make-symbolic-link "/:~y" "x" 1)' +now creates a link to literal "~y". + ++++ +** 'file-truename' returns a quoted file name if the target of a +symbolic link has remote file name syntax. + ++++ +** Module functions are now implemented slightly differently; in +particular, the function 'internal--module-call' has been removed. +Code that depends on undocumented internals of the module system might +break. + +--- +** The argument LOCKNAME of 'write-region' is propagated to file name +handlers now. + +--- +** When built against recent versions of GTK+, Emacs always uses +gtk_window_move for moving frames and ignores the value of the +variable 'x-gtk-use-window-move'. The variable is now obsolete. + ++++ +** Several functions that create or rename files now treat their +destination argument specially only when it is a directory name, i.e., +when it ends in '/' on GNU and other POSIX-like systems. When the +destination argument D of one of these functions is an existing +directory and the intent is to act on an entry in that directory, D +should now be a directory name. For example, (rename-file "e" "f/") +renames to 'f/e'. Although this formerly happened sometimes even when +D was not a directory name, as in (rename-file "e" "f") where 'f' +happened to be a directory, the old behavior often contradicted the +documentation and had inherent races that led to security holes. A +call like (rename-file C D) that used the old, undocumented behavior +can be written as (rename-file C (file-name-as-directory D)), a +formulation portable to both older and newer versions of Emacs. +Affected functions include add-name-to-file, copy-directory, +copy-file, format-write-file, gnus-copy-file, make-symbolic-link, +rename-file, thumbs-rename-images, and write-file. + +--- +** The list returned by 'overlays-at' is now in decreasing priority order. +The documentation of this function always said the order should be +that of decreasing priority, if the 2nd argument of the function is +non-nil, but the code returned the list in the increasing order of +priority instead. Now the code does what the documentation says it +should do. + + +* Lisp Changes in Emacs 26.1 + ++++ +** The function 'assoc' now takes an optional third argument TESTFN. +This argument, when non-nil, is used for comparison instead of +'equal'. + ++++ +** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. +If non-nil, the argument specifies a function to use for comparison, +instead of, respectively, 'assq' and 'eql'. + ++++ +** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 +contain the same elements, regardless of the order. + ++++ +** The new function 'mapbacktrace' applies a function to all frames of +the current stack trace. + ++++ +** The new function 'file-name-case-insensitive-p' tests whether a +given file is on a case-insensitive filesystem. + ++++ +** Several accessors for the value returned by 'file-attributes' +have been added. They are: 'file-attribute-type', +'file-attribute-link-number', 'file-attribute-user-id', +'file-attribute-group-id', 'file-attribute-access-time', +'file-attribute-modification-time', +'file-attribute-status-change-time', 'file-attribute-size', +'file-attribute-modes', 'file-attribute-inode-number', +'file-attribute-device-number' and 'file-attribute-collect'. + ++++ +** The new function 'buffer-hash' computes a fast, non-consing hash of +a buffer's contents. + ++++ +** 'interrupt-process' now consults the list 'interrupt-process-functions', +to determine which function has to be called in order to deliver the +SIGINT signal. This allows Tramp to send the SIGINT signal to remote +asynchronous processes. The hitherto existing implementation has been +moved to 'internal-default-interrupt-process'. + ++++ +** The new function 'read-multiple-choice' prompts for multiple-choice +questions, with a handy way to display help texts. + +--- +** 'comment-indent-function' values may now return a cons to specify a +range of indentation. + ++++ +** New optional argument TEXT in 'make-temp-file'. + +--- +** New function `define-symbol-prop'. + +** Checksum/Hash + ++++ +** New function 'secure-hash-algorithms' to list the algorithms that +'secure-hash' supports. +See the node "(elisp) Checksum/Hash" in the ELisp manual for details. + ++++ +** Emacs now exposes the GnuTLS cryptographic API with the functions +'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and +'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt' +and 'gnutls-symmetric-decrypt'. +See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details. + ++++ +** Emacs now supports records for user-defined types, via the new +functions 'make-record', 'record', and 'recordp'. Records are now +used internally to represent cl-defstruct and defclass instances, for +example. + ++++ +** 'save-some-buffers' now uses 'save-some-buffers-default-predicate' +to decide which buffers to ask about, if the PRED argument is nil. +The default value of 'save-some-buffers-default-predicate' is nil, +which means ask about all file-visiting buffers. + +--- +** string-(to|as|make)-(uni|multi)byte are now declared obsolete. + ++++ +** New variable 'while-no-input-ignore-events' which allow +setting which special events 'while-no-input' should ignore. +It is a list of symbols. + +--- +** New function 'undo-amalgamate-change-group' to get rid of +undo-boundaries between two states. + +--- +** New var 'definition-prefixes' is a hash table mapping prefixes to +the files where corresponding definitions can be found. This can be +used to fetch definitions that are not yet loaded, for example for +'C-h f'. + +--- +** New var 'syntax-ppss-table' to control the syntax-table used in +'syntax-ppss'. + ++++ +** 'define-derived-mode' can now specify an :after-hook form, which +gets evaluated after the new mode's hook has run. This can be used to +incorporate configuration changes made in the mode hook into the +mode's setup. + +--- +** Autoload files can be generated without timestamps, +by setting 'autoload-timestamps' to nil. +FIXME As an experiment, nil is the current default. +If no insurmountable problems before next release, it can stay that way. + +--- +** 'gnutls-boot' now takes a parameter ':complete-negotiation' that +says that negotiation should complete even on non-blocking sockets. + +--- +** There is now a new variable 'flyspell-sort-corrections-function' +that allows changing the way corrections are sorted. + +--- +** The new command 'fortune-message' has been added, which displays +fortunes in the echo area. + ++++ +** New function 'func-arity' returns information about the argument list +of an arbitrary function. This generalizes 'subr-arity' for functions +that are not built-in primitives. We recommend using this new +function instead of 'subr-arity'. + +--- +** New function 'region-bounds' can be used in the interactive spec +to provide region boundaries (for rectangular regions more than one) +to an interactively callable function as a single argument instead of +two separate arguments region-beginning and region-end. + ++++ +** 'parse-partial-sexp' state has a new element. Element 10 is +non-nil when the last character scanned might be the first character +of a two character construct, i.e., a comment delimiter or escaped +character. Its value is the syntax of that last character. + ++++ +** 'parse-partial-sexp's state, element 9, has now been confirmed as +permanent and documented, and may be used by Lisp programs. Its value +is a list of currently open parenthesis positions, starting with the +outermost parenthesis. + +--- +** 'read-color' will now display the color names using the color itself +as the background color. + +--- +** The function 'redirect-debugging-output' now works on platforms +other than GNU/Linux. + ++++ +** The new function 'string-version-lessp' compares strings by +interpreting consecutive runs of numerical characters as numbers, and +compares their numerical values. According to this predicate, +"foo2.png" is smaller than "foo12.png". + +--- +** Numeric comparisons and 'logb' no longer return incorrect answers +due to internal rounding errors. For example, (< most-positive-fixnum +(+ 1.0 most-positive-fixnum)) now correctly returns t on 64-bit hosts. + +--- +** The functions 'ffloor', 'fceiling', 'ftruncate' and 'fround' now +accept only floating-point arguments, as per their documentation. +Formerly, they quietly accepted integer arguments and sometimes +returned nonsensical answers, e.g., (< N (ffloor N)) could return t. + +--- +** On hosts like GNU/Linux x86-64 where a 'long double' fraction +contains at least EMACS_INT_WIDTH - 3 bits, 'format' no longer returns +incorrect answers due to internal rounding errors when formatting +Emacs integers with %e, %f, or %g conversions. For example, on these +hosts (eql N (string-to-number (format "%.0f" N))) now returns t for +all Emacs integers N. + +--- +** Calls that accept floating-point integers (for use on hosts with +limited integer range) now signal an error if arguments are not +integral. For example (decode-char 'ascii 0.5) now signals an error. + ++++ +** The new function 'char-from-name' converts a Unicode name string +to the corresponding character code. + ++++ +** New functions 'sxhash-eq' and 'sxhash-eql' return hash codes of a +Lisp object suitable for use with 'eq' and 'eql' correspondingly. If +two objects are 'eq' ('eql'), then the result of 'sxhash-eq' +('sxhash-eql') on them will be the same. + ++++ +** Function 'sxhash' has been renamed to 'sxhash-equal' for +consistency with the new functions. For compatibility, 'sxhash' +remains as an alias to 'sxhash-equal'. + ++++ +** 'make-hash-table' now defaults to a rehash threshold of 0.8125 +instead of 0.8, to avoid rounding glitches. + ++++ +** New function 'add-variable-watcher' can be used to call a function +when a symbol's value is changed. This is used to implement the new +debugger command 'debug-on-variable-change'. + ++++ +** Time conversion functions that accept a time zone rule argument now +allow it to be OFFSET or a list (OFFSET ABBR), where the integer +OFFSET is a count of seconds east of Universal Time, and the string +ABBR is a time zone abbreviation. The affected functions are +'current-time-string', 'current-time-zone', 'decode-time', +'format-time-string', and 'set-time-zone-rule'. + ++++ +** 'format-time-string' now formats "%q" to the calendar quarter. + ++++ +** New built-in function 'mapcan'. +It avoids unnecessary consing (and garbage collection). + ++++ +** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. + ++++ +** 'gensym' is now part of Elisp. + +--- +** Low-level list functions like 'length' and 'member' now do a better +job of signaling list cycles instead of looping indefinitely. + ++++ +** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' +can be used for creation of temporary files of remote or mounted directories. + ++++ +** On GNU platforms when operating on a local file, 'file-attributes' +no longer suffers from a race when called while another process is +altering the filesystem. On non-GNU platforms 'file-attributes' +attempts to detect the race, and returns nil if it does so. + ++++ +** The new function 'file-local-name' can be used to specify arguments +of remote processes. + ++++ +** The new functions 'file-name-quote', 'file-name-unquote' and +'file-name-quoted-p' can be used to quote / unquote file names with +the prefix "/:". + ++++ +** The new error 'file-missing', a subcategory of 'file-error', is now +signaled instead of 'file-error' if a file operation acts on a file +that does not exist. + ++++ +** The function 'delete-directory' no longer signals an error when +operating recursively and when some other process deletes the directory +or its files before 'delete-directory' gets to them. + ++++ +*** New error type 'user-search-failed' like 'search-failed' but +avoids debugger like 'user-error'. + ++++ +** The function 'line-number-at-pos' now takes a second optional +argument 'absolute'. If this parameter is nil, the default, this +function keeps on returning the line number taking potential narrowing +into account. If this parameter is non-nil, the function ignores +narrowing and returns the absolute line number. + +--- +** The function 'color-distance' now takes a second optional argument +'metric'. When non-nil, it should be a function of two arguments that +accepts two colors and returns a number. + +** Changes in Frame and Window Handling + ++++ +*** Resizing a frame no longer runs 'window-configuration-change-hook'. +'window-size-change-functions' should be used instead. + ++++ +*** The new function 'frame-size-changed-p' can tell whether a frame has +been resized since the last time 'window-size-change-functions' has been +run. + ++++ +*** The function 'frame-geometry' now also returns the width of a +frame's outer border. + ++++ +*** New frame parameters and changed semantics for older ones + ++++ +**** 'z-group' positions a frame above or below all others. + ++++ +**** 'min-width' and 'min-height' specify the absolute minimum size of a +frame. + ++++ +**** 'parent-frame' makes a frame the child frame of another Emacs +frame. The section "Child Frames" in the Elisp manual describes the +intrinsics of that relationship. + ++++ +**** 'delete-before' triggers deletion of one frame before that of +another. + ++++ +**** 'mouse-wheel-frame' specifies another frame whose windows shall be +scrolled instead. + ++++ +**** 'no-other-frame' has 'next-frame' and 'previous-frame' skip this +frame. + ++++ +**** 'skip-taskbar' removes a frame's icon from the taskbar and has +Alt- skip this frame. + ++++ +**** 'no-focus-on-map' avoids that a frame gets input focus when mapped. + ++++ +**** 'no-accept-focus' means that a frame does not want to get input +focus via the mouse. + ++++ +**** 'undecorated' removes the window manager decorations from a frame. + ++++ +**** 'override-redirect' tells the window manager to disregard this +frame. + ++++ +**** 'width' and 'height' allow to specify pixel values and ratios now. + ++++ +**** 'left' and 'top' allow to specify ratios now. + ++++ +**** 'keep-ratio' preserves size and position of child frames when their +parent frame is resized. + ++++ +**** 'no-special-glyphs' suppresses display of truncation and +continuation glyphs in a frame. + ++++ +**** 'auto-hide-function' and 'minibuffer-exit' handle auto hiding of +frames and exiting from minibuffer individually. + ++++ +**** 'fit-frame-to-buffer-margins' and 'fit-frame-to-buffer-sizes' +handle fitting a frame to its buffer individually. + ++++ +**** 'drag-internal-border', 'drag-with-header-line', +'drag-with-mode-line', 'snap-width', 'top-visible' and 'bottom-visible' +allow to drag and resize frames with the mouse. + +*** The new function 'frame-list-z-order' returns a list of all frames +in Z (stacking) order. + ++++ +*** The function 'x-focus-frame' optionally tries to not activate its +frame. + ++++ +*** The variable 'focus-follows-mouse' has a third meaningful value +'auto-raise' to indicate that the window manager automatically raises a +frame when the mouse pointer enters it. + ++++ +*** The new function 'frame-restack' puts a frame above or below +another on the display. + ++++ +*** The new face 'internal-border' specifies the background of a frame's +internal border. + ++++ +*** The NORECORD argument of 'select-window' now has a meaningful value +'mark-for-redisplay' which is like any other non-nil value but marks +WINDOW for redisplay. + ++++ +*** Support for side windows is now official. +The display action function 'display-buffer-in-side-window' will +display its buffer in a side window. Functions for toggling all side +windows on a frame, changing and reversing the layout of side windows +and returning the main (major non-side) window of a frame are +provided. For details consult the section "Side Windows" in the Elisp +manual. + ++++ +*** Support for atomic windows - rectangular compositions of windows +treated by 'split-window', 'delete-window' and 'delete-other-windows' +like a single live window - is now official. For details consult the +section "Atomic Windows" in the Elisp manual. + ++++ +*** New 'display-buffer' alist entry 'window-parameters' allows to +assign window parameters to the window used for displaying the buffer. + ++++ +*** New function 'display-buffer-reuse-mode-window' is an action function +suitable for use in 'display-buffer-alist'. For example, to avoid +creating a new window when opening man pages when there's already one, +use + +(add-to-list 'display-buffer-alist + '("\\`\\*Man .*\\*\\'" . + (display-buffer-reuse-mode-window + (inhibit-same-window . nil) + (mode . Man-mode)))) + ++++ +*** New window parameter 'no-delete-other-windows' prevents that +its window gets deleted by 'delete-other-windows'. + ++++ +*** New window parameters 'mode-line-format' and 'header-line-format' +allow to override the buffer-local formats for this window. + ++++ +*** New command 'window-swap-states' swaps the states of two live +windows. + ++++ +*** New functions 'window-pixel-width-before-size-change' and +'window-pixel-height-before-size-change' support detecting which +window changed size when 'window-size-change-functions' are run. + ++++ +*** The new function 'window-lines-pixel-dimensions' returns the pixel +dimensions of a window's text lines. + ++++ +*** The new function 'window-largest-empty-rectangle' returns the +dimensions of the largest rectangular area not occupying any text in a +window's body. + ++++ +*** The semantics of 'mouse-autoselect-window' has changed slightly. +For details see the section "Mouse Window Auto-selection" in the Elisp +manual. + +--- +** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality +can be replicated simply by setting 'comment-auto-fill-only-comments'. + +** New pcase pattern 'rx' to match against a rx-style regular expression. +For details, see the doc string of 'rx--pcase-macroexpander'. + + +* Changes in Emacs 26.1 on Non-Free Operating Systems + ++++ +** Intercepting hotkeys on Windows 7 and later now works better. +The new keyboard hooking code properly grabs system hotkeys such as +Win-* and Alt-TAB, in a way that Emacs can get at them before the +system. This makes the 'w32-register-hot-key' functionality work +again on all versions of MS-Windows starting with Windows 7. On +Windows NT and later you can now register any hotkey combination. (On +Windows 9X, the previous limitations, spelled out in the Emacs manual, +still apply.) + +--- +** 'convert-standard-filename' no longer mirrors slashes on MS-Windows. +Previously, on MS-Windows this function converted slash characters in +file names into backslashes. It no longer does that. If your Lisp +program used 'convert-standard-filename' to prepare file names to be +passed to subprocesses (which is not the recommended usage of that +function), you will now have to mirror slashes in your application +code. One possible way is this: + + (let ((start 0)) + (while (string-match "/" file-name start) + (aset file-name (match-beginning 0) ?\\) + (setq start (match-end 0)))) + +--- +** GUI sessions on MS-Windows now treat SIGINT like Posix platforms do. +The effect of delivering a Ctrl-C (SIGINT) signal to a GUI Emacs on +MS-Windows is now the same as on Posix platforms -- Emacs saves the +session and exits. In particular, this will happen if you start +emacs.exe from the Windows shell, then type Ctrl-C into that shell's +window. + +--- +** 'signal-process' supports SIGTRAP on Windows XP and later. +The 'kill' emulation on Windows now maps SIGTRAP to a call to the +'DebugBreakProcess' API. This causes the receiving process to break +execution and return control to the debugger. If no debugger is +attached to the receiving process, the call is typically ignored. +This is in contrast to the default action on POSIX Systems, where it +causes the receiving process to terminate with a core dump if no +debugger has been attached to it. + +--- +** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work +on macOS. + +--- +** Emacs can now be run as a GUI application from the command line on +macOS. + ++++ +** 'ns-appearance' and 'ns-transparent-titlebar' change the appearance +of frame decorations on macOS 10.9+. + +--- +** 'ns-use-thin-smoothing' enables thin font smoothing on macOS 10.8+. + +--- +** 'process-attributes' on Darwin systems now returns more information. + + +---------------------------------------------------------------------- +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 . + + +Local variables: +coding: utf-8 +mode: outline +paragraph-separate: "[ ]*$" +end: diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index 866dd7948f..a168e08525 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -40,7 +40,7 @@ \newlength{\ColThreeWidth} \setlength{\ColThreeWidth}{25mm} -\newcommand{\versionemacs}[0]{26} % version of Emacs this is for +\newcommand{\versionemacs}[0]{27} % version of Emacs this is for \newcommand{\cyear}[0]{2017} % copyright year \newcommand\shortcopyrightnotice[0]{\vskip 1ex plus 2 fill diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index ba1bb4eecd..7769ba3049 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ /^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION VERSION/ /^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/ -/^#undef VERSION/s/^.*$/#define VERSION "26.0.50"/ +/^#undef VERSION/s/^.*$/#define VERSION "27.0.50"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index a670687ef2..f0f4997892 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 25.1.50 for MS-Windows + Emacs version 27.0.50 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You diff --git a/src/msdos.c b/src/msdos.c index 5b025753d9..ae9cbeefaf 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1791,7 +1791,7 @@ internal_terminal_init (void) } Vinitial_window_system = Qpc; - Vwindow_system_version = make_number (26); /* RE Emacs version */ + Vwindow_system_version = make_number (27); /* RE Emacs version */ tty->terminal->type = output_msdos_raw; /* If Emacs was dumped on DOS/V machine, forget the stale VRAM commit 625cee531623feddbe3174fad52c7db96ec60bb3 Author: Eli Zaretskii Date: Sat Sep 16 15:34:15 2017 +0300 Start emacs-26 release branch * configure.ac: * nt/README.W32: * README: * msdos/sed2v2.inp: Increment Emacs version to 26.0.60. * lisp/cus-edit.el (customize-changed-options-previous-release): Update value to "25.3". diff --git a/README b/README index c3cf78f04c..46cff5876f 100644 --- a/README +++ b/README @@ -2,7 +2,7 @@ Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. -This directory tree holds version 26.0.50 of GNU Emacs, the extensible, +This directory tree holds version 26.0.60 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. The file INSTALL in this directory says how to build and install GNU diff --git a/configure.ac b/configure.ac index c88471657f..6452038d1b 100644 --- a/configure.ac +++ b/configure.ac @@ -23,7 +23,7 @@ dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. -AC_INIT(GNU Emacs, 26.0.50, bug-gnu-emacs@gnu.org) +AC_INIT(GNU Emacs, 26.0.60, bug-gnu-emacs@gnu.org) dnl Set emacs_config_options to the options of 'configure', quoted for the shell, dnl and then quoted again for a C string. Separate options with spaces. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 1e13e95047..6b67555770 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1159,7 +1159,7 @@ Show the buffer in another window, but don't select it." (unless (eq symbol basevar) (message "`%s' is an alias for `%s'" symbol basevar)))) -(defvar customize-changed-options-previous-release "24.5" +(defvar customize-changed-options-previous-release "25.3" "Version for `customize-changed-options' to refer back to by default.") ;; Packages will update this variable, so make it available. diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index ba1bb4eecd..be685710fd 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -66,7 +66,7 @@ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ /^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION VERSION/ /^#undef PENDING_OUTPUT_COUNT/s/^.*$/#define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_ptr - (FILE)->_base)/ -/^#undef VERSION/s/^.*$/#define VERSION "26.0.50"/ +/^#undef VERSION/s/^.*$/#define VERSION "26.0.60"/ /^#undef SYSTEM_TYPE/s/^.*$/#define SYSTEM_TYPE "ms-dos"/ /^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ diff --git a/nt/README.W32 b/nt/README.W32 index a670687ef2..bec0b66ac5 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -1,7 +1,7 @@ Copyright (C) 2001-2017 Free Software Foundation, Inc. See the end of the file for license conditions. - Emacs version 25.1.50 for MS-Windows + Emacs version 26.0.60 for MS-Windows This README file describes how to set up and run a precompiled distribution of the latest version of GNU Emacs for MS-Windows. You commit 4ea37c2b8b0c5a68fde59770c3536195e0972217 Author: Alan Mackenzie Date: Sat Sep 16 11:31:38 2017 +0000 Cope better with C++ and Objective-C protection keywords in class declarations This fix fixes the fontification of a method inside a class at the time it is typed, when there is a protection keyword clause preceding it. * lisp/progmodes/cc-engine.el (c-forward-keyword-clause): Handle protection keywords. (c-looking-at-decl-block): Avoid scanning forward over protection keyword clauses too eagerly. * lisp/progmodes/cc-langs.el (c-protection-key c-post-protection-token): New lang defconsts and defvars. * lisp/progmodes/cc-mode.el (c-fl-decl-start): When we encounter a protection keyword following a semicolon or brace, move forward over it before attempting to parse a type. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d5083ed248..05b391a3d3 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6924,7 +6924,7 @@ comment at the start of cc-engine.el for more info." ;; recognized are those specified by `c-type-list-kwds', ;; `c-ref-list-kwds', `c-colon-type-list-kwds', ;; `c-paren-nontype-kwds', `c-paren-type-kwds', `c-<>-type-kwds', - ;; and `c-<>-arglist-kwds'. + ;; `c-<>-arglist-kwds', and `c-protection-kwds'. ;; ;; This function records identifier ranges on ;; `c-record-type-identifiers' and `c-record-ref-identifiers' if @@ -6994,6 +6994,17 @@ comment at the start of cc-engine.el for more info." (not (looking-at c-symbol-start)) (c-safe (c-forward-sexp) t)) (c-forward-syntactic-ws) + (setq safe-pos (point))) + + ((and (c-keyword-member kwd-sym 'c-protection-kwds) + (or (null c-post-protection-token) + (and (looking-at c-post-protection-token) + (save-excursion + (goto-char (match-end 0)) + (not (c-end-of-current-token)))))) + (if c-post-protection-token + (goto-char (match-end 0))) + (c-forward-syntactic-ws) (setq safe-pos (point)))) (when (c-keyword-member kwd-sym 'c-colon-type-list-kwds) @@ -10169,8 +10180,16 @@ comment at the start of cc-engine.el for more info." ;; Could be more restrictive wrt invalid keywords, ;; but that'd only occur in invalid code so there's ;; no use spending effort on it. - (let ((end (match-end 0))) - (unless (c-forward-keyword-clause 0) + (let ((end (match-end 0)) + (kwd-sym (c-keyword-sym (match-string 0)))) + (unless + (and kwd-sym + ;; Moving over a protection kwd and the following + ;; ":" (in C++ Mode) to the next token could take + ;; us all the way up to `kwd-start', leaving us + ;; no chance to update `first-specifier-pos'. + (not (c-keyword-member kwd-sym 'c-protection-kwds)) + (c-forward-keyword-clause 0)) (goto-char end) (c-forward-syntactic-ws))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ef6b88c372..7a285f93d3 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2284,6 +2284,18 @@ one of `c-type-list-kwds', `c-ref-list-kwds', c++ '("private" "protected" "public") objc '("@private" "@protected" "@public")) +(c-lang-defconst c-protection-key + ;; A regexp match an element of `c-protection-kwds' cleanly. + t (c-make-keywords-re t (c-lang-const c-protection-kwds))) +(c-lang-defvar c-protection-key (c-lang-const c-protection-key)) + +(c-lang-defconst c-post-protection-token + "The token which (may) follow a protection keyword, +e.g. the \":\" in C++ Mode's \"public:\". nil if there is no such token." + t nil + c++ ":") +(c-lang-defvar c-post-protection-token (c-lang-const c-post-protection-token)) + (c-lang-defconst c-block-decls-with-vars "Keywords introducing declarations that can contain a block which might be followed by variable declarations, e.g. like \"foo\" in diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 354dee82df..8867453e85 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1526,14 +1526,17 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (> (point) bod-lim) (progn (c-forward-syntactic-ws) (setq bo-decl (point)) - ;; Are we looking at a keyword such as "template" or - ;; "typedef" which can decorate a type, or the type itself? - (when (or (looking-at c-prefix-spec-kwds-re) - (c-forward-type t)) - ;; We've found another candidate position. - (setq new-pos (min new-pos bo-decl)) - (goto-char bo-decl)) - t) + (or (not (looking-at c-protection-key)) + (c-forward-keyword-clause 1))) + (progn + ;; Are we looking at a keyword such as "template" or + ;; "typedef" which can decorate a type, or the type itself? + (when (or (looking-at c-prefix-spec-kwds-re) + (c-forward-type t)) + ;; We've found another candidate position. + (setq new-pos (min new-pos bo-decl)) + (goto-char bo-decl)) + t) ;; Try and go out a level to search again. (progn (c-backward-syntactic-ws bod-lim) commit 2d53f8783ff8e48d91809741adab6a2402587fad Author: Eli Zaretskii Date: Sat Sep 16 13:02:31 2017 +0300 Fix order of sorted overlays returned by 'overlays-at' * src/buffer.c (Foverlays_at): If SORTED is non-nil, reverse the list of results, to have their order as per the documentation. (Bug#28390) * etc/NEWS: Mention the change in the behavior of overlays-at. diff --git a/etc/NEWS b/etc/NEWS index ce828043bb..a042ce92af 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1336,6 +1336,14 @@ Affected functions include add-name-to-file, copy-directory, copy-file, format-write-file, gnus-copy-file, make-symbolic-link, rename-file, thumbs-rename-images, and write-file. +--- +** The list returned by 'overlays-at' is now in decreasing priority order. +The documentation of this function always said the order should be +that of decreasing priority, if the 2nd argument of the function is +non-nil, but the code returned the list in the increasing order of +priority instead. Now the code does what the documentation says it +should do. + * Lisp Changes in Emacs 26.1 diff --git a/src/buffer.c b/src/buffer.c index bc28ac7d1a..76670b8954 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -4179,6 +4179,12 @@ If SORTED is non-nil, then sort them by decreasing priority. */) /* Make a list of them all. */ result = Flist (noverlays, overlay_vec); + /* The doc string says the list should be in decreasing order of + priority, so we reverse the list, because sort_overlays sorts in + the increasing order of priority. */ + if (!NILP (sorted)) + result = Fnreverse (result); + xfree (overlay_vec); return result; } commit a103dbe36022cd2454eaeed96def1c777c049762 Author: Eli Zaretskii Date: Sat Sep 16 12:45:24 2017 +0300 Disable execution of unsafe Lisp by Enriched Text mode * src/xdisp.c (handle_display_spec): If the display property is wrapped in 'disable-eval' form, disable Lisp evaluation while processing this property. (handle_single_display_spec): Accept new argument ENABLE_EVAL_P. If that argument is false, don't evaluate Lisp while processing display properties. * lisp/textmodes/enriched.el (enriched-allow-eval-in-display-props): New defcustom. (enriched-decode-display-prop): If enriched-allow-eval-in-display-props is nil, wrap the display property with 'disable-eval' to disable Lisp evaluation when the display property is processed for display. (Bug#28350) * lisp/gnus/mm-view.el (mm-inline-text): Re-enable processing of enriched text. * doc/lispref/display.texi (Display Property): Document the 'disable-eval' wrapping of 'display' properties. * doc/emacs/text.texi (Enriched Properties): Document 'enriched-allow-eval-in-display-props'. * etc/NEWS: Describe the security issues with Enriched Text mode and their solution. diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index 3b54aa8263..496b43ce1e 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -2398,6 +2398,23 @@ these special properties from the text in the region. The @code{invisible} and @code{intangible} properties are not saved. +@vindex enriched-allow-eval-in-display-props +@cindex security, when displaying enriched text + Enriched mode also supports saving and restoring @code{display} +properties (@pxref{Display Property,,,elisp, the Emacs Lisp Reference +Manual}), which affect how text is displayed on the screen, and also +allow displaying images and strings that come from sources other than +buffer text. The @code{display} properties also support execution of +arbitrary Lisp forms as part of processing the property for display, +thus providing a means to dynamically tailor the display to some +conditions that can only be known at display time. Since execution of +arbitrary Lisp opens Emacs to potential attacks, especially when the +source of enriched text is outside of Emacs or even outside of your +system (e.g., if it was received in an email message), such execution +is by default disabled in Enriched mode. You can enable it by +customizing the variable @code{enriched-allow-eval-in-display-props} +to a non-@code{nil} value. + @node Text Based Tables @section Editing Text-based Tables @cindex table mode diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 1dbc0bbb5b..3dae984f33 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -4486,6 +4486,17 @@ for the @code{display} property, only one of the values takes effect, following the rules of @code{get-char-property}. @xref{Examining Properties}. +@cindex display property, unsafe evaluation +@cindex security, and display specifications + Some of the display specifications allow inclusion of Lisp forms, +which are evaluated at display time. This could be unsafe in certain +situations, e.g., when the display specification was generated by some +external program/agent. Wrapping a display specification in a list +that begins with the special symbol @code{disable-eval}, as in +@w{@code{('disable-eval @var{spec})}}, will disable evaluation of any +Lisp in @var{spec}, while still supporting all the other display +property features. + The rest of this section describes several kinds of display specifications and what they mean. diff --git a/etc/NEWS b/etc/NEWS index 016868d5a3..ce828043bb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -117,6 +117,28 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 +** Security vulnerability related to Enriched Text mode is removed. + ++++ +*** Enriched Text mode does not evaluate Lisp in 'display' properties. +This feature allows saving 'display' properties as part of text. +Emacs 'display' properties support evaluation of arbitrary Lisp forms +as part of processing the property for display, so displaying Enriched +Text could be vulnerable to executing arbitrary malicious Lisp code +included in the text (e.g., sent as part of an email message). +Therefore, execution of arbitrary Lisp forms in 'display' properties +decoded by Enriched Text mode is now disabled by default. Customize +the new option 'enriched-allow-eval-in-display-props' to a non-nil +value to allow Lisp evaluation in decoded 'display' properties. + +This vulnerability was introduced in Emacs 21.1. To work around that +in Emacs versions before 25.3, append the following to your ~/.emacs +init file: + + (eval-after-load "enriched" + '(defun enriched-decode-display-prop (start end &optional param) + (list start end))) + +++ ** Functions in 'write-contents-functions' can fully short-circuit the 'save-buffer' process. Previously, saving a buffer that was not diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 86e217131a..d7a41b8493 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -362,12 +362,10 @@ (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) - ;; Disabled in Emacs 25.3 to avoid execution of arbitrary Lisp - ;; forms in display properties supported by enriched.el. - ;; (when (member type '("enriched" "richtext")) - ;; (set-text-properties (point-min) (point-max) nil) - ;; (ignore-errors - ;; (enriched-decode (point-min) (point-max)))) + (when (member type '("enriched" "richtext")) + (set-text-properties (point-min) (point-max) nil) + (ignore-errors + (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index d90c207575..be5cd6b731 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -147,6 +147,22 @@ them and their old values to `enriched-old-bindings'." :type 'hook :group 'enriched) +(defcustom enriched-allow-eval-in-display-props nil + "If non-nil allow to evaluate arbitrary forms in display properties. + +Enriched mode recognizes display properties of text stored using +an extension command to the text/enriched format, \"x-display\". +These properties must not, by default, include evaluation of +Lisp forms, otherwise they are not applied. Customize this option +to t to turn off this safety feature, and allow Enriched mode to +apply display properties which evaluate arbitrary Lisp forms. +Note, however, that applying unsafe display properties could +execute malicious Lisp code, if that code came from an external source." + :risky t + :type 'boolean + :version "26.1" + :group 'enriched) + (defvar enriched-old-bindings nil "Store old variable values that we change when entering mode. The value is a list of \(VAR VALUE VAR VALUE...).") @@ -503,9 +519,8 @@ the range of text to assign text property SYMBOL with value VALUE." (error nil))))) (unless prop (message "Warning: invalid parameter %s" param)) - ;; Disabled in Emacs 25.3 to avoid execution of arbitrary Lisp - ;; forms in display properties stored within enriched text. - ;; (list start end 'display prop))) - (list start end))) + (if enriched-allow-eval-in-display-props + (list start end 'display prop) + (list start end 'display (list 'disable-eval prop))))) ;;; enriched.el ends here diff --git a/src/xdisp.c b/src/xdisp.c index 8ca9037a00..dc5dbb0576 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -876,9 +876,9 @@ static int face_before_or_after_it_pos (struct it *, bool); static ptrdiff_t next_overlay_change (ptrdiff_t); static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object, Lisp_Object, struct text_pos *, ptrdiff_t, bool); -static int handle_single_display_spec (struct it *, Lisp_Object, - Lisp_Object, Lisp_Object, - struct text_pos *, ptrdiff_t, int, bool); +static int handle_single_display_spec (struct it *, Lisp_Object, Lisp_Object, + Lisp_Object, struct text_pos *, + ptrdiff_t, int, bool, bool); static int underlying_face_id (struct it *); #define face_before_it_pos(IT) face_before_or_after_it_pos (IT, true) @@ -4748,6 +4748,14 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, ptrdiff_t bufpos, bool frame_window_p) { int replacing = 0; + bool enable_eval = true; + + /* Support (disable-eval PROP) which is used by enriched.el. */ + if (CONSP (spec) && EQ (XCAR (spec), Qdisable_eval)) + { + enable_eval = false; + spec = XCAR (XCDR (spec)); + } if (CONSP (spec) /* Simple specifications. */ @@ -4771,7 +4779,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { int rv = handle_single_display_spec (it, XCAR (spec), object, overlay, position, bufpos, - replacing, frame_window_p); + replacing, frame_window_p, + enable_eval); if (rv != 0) { replacing = rv; @@ -4789,7 +4798,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, { int rv = handle_single_display_spec (it, AREF (spec, i), object, overlay, position, bufpos, - replacing, frame_window_p); + replacing, frame_window_p, + enable_eval); if (rv != 0) { replacing = rv; @@ -4802,7 +4812,8 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, } else replacing = handle_single_display_spec (it, spec, object, overlay, position, - bufpos, 0, frame_window_p); + bufpos, 0, frame_window_p, + enable_eval); return replacing; } @@ -4847,6 +4858,8 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) don't set up IT. In that case, FRAME_WINDOW_P means SPEC is intended to be displayed in a window on a GUI frame. + Enable evaluation of Lisp forms only if ENABLE_EVAL_P is true. + Value is non-zero if something was found which replaces the display of buffer or string text. */ @@ -4854,7 +4867,7 @@ static int handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object overlay, struct text_pos *position, ptrdiff_t bufpos, int display_replaced, - bool frame_window_p) + bool frame_window_p, bool enable_eval_p) { Lisp_Object form; Lisp_Object location, value; @@ -4872,6 +4885,8 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, spec = XCDR (spec); } + if (!NILP (form) && !EQ (form, Qt) && !enable_eval_p) + form = Qnil; if (!NILP (form) && !EQ (form, Qt)) { ptrdiff_t count = SPECPDL_INDEX (); @@ -4920,7 +4935,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, steps = - steps; it->face_id = smaller_face (it->f, it->face_id, steps); } - else if (FUNCTIONP (it->font_height)) + else if (FUNCTIONP (it->font_height) && enable_eval_p) { /* Call function with current height as argument. Value is the new height. */ @@ -4941,7 +4956,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, new_height = (XFLOATINT (it->font_height) * XINT (f->lface[LFACE_HEIGHT_INDEX])); } - else + else if (enable_eval_p) { /* Evaluate IT->font_height with `height' bound to the current specified height to get the new height. */ @@ -32204,6 +32219,10 @@ They are still logged to the *Messages* buffer. */); DEFSYM (Qfontified, "fontified"); DEFSYM (Qfontification_functions, "fontification-functions"); + /* Name of the symbol which disables Lisp evaluation in 'display' + properties. This is used by enriched.el. */ + DEFSYM (Qdisable_eval, "disable-eval"); + /* Name of the face used to highlight trailing whitespace. */ DEFSYM (Qtrailing_whitespace, "trailing-whitespace"); commit 6d6dc246f93486fc8370399b6e1af8a17f371e4f Author: Eli Zaretskii Date: Sat Sep 16 11:51:24 2017 +0300 Avoid MinGW64 compilation warning in w32.c * src/w32.c (sys_strerror): Provide a prototype for MinGW64. diff --git a/src/w32.c b/src/w32.c index f583d5e76c..eb531aa60c 100644 --- a/src/w32.c +++ b/src/w32.c @@ -82,6 +82,10 @@ int sys_dup2 (int, int); int sys_read (int, char *, unsigned int); int sys_write (int, const void *, unsigned int); struct tm *sys_localtime (const time_t *); +/* MinGW64 system headers include string.h too early, causing the + compiler to emit a warning about sys_strerror having no + prototype. */ +char *sys_strerror (int); #ifdef HAVE_MODULES extern void dynlib_reset_last_error (void); commit d25d2a9b2de1a9316e982fc383d8cff06cfb41b6 Author: Eli Zaretskii Date: Sat Sep 16 11:01:19 2017 +0300 ; * src/data.c (minmax_driver): Fix last change. diff --git a/src/data.c b/src/data.c index 9ccfa6475a..95bf06e510 100644 --- a/src/data.c +++ b/src/data.c @@ -3011,7 +3011,7 @@ minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { eassume (0 < nargs); - Lisp_Object accum UNINIT; + Lisp_Object accum = args[0]; /* pacify GCC */ for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; commit 1170c2f37158282d3f4a322586b2aa67001a287e Author: Eli Zaretskii Date: Sat Sep 16 10:41:52 2017 +0300 Fix MS-Windows build broken by recent changes in lcms.c * src/lcms.c [WINDOWSNT]: Define types for cmsWhitePointFromTemp and cmsxyY2XYZ function pointers. (init_lcms_functions) [WINDOWSNT]: Load cmsWhitePointFromTemp and cmsxyY2XYZ from liblcms2. (cmsWhitePointFromTemp, cmsxyY2XYZ) [WINDOWSNT]: Redirect to the corresponding function pointers. (Flcms_temp_to_white_point): Minor stylistic changes. Doc fix. (syms_of_lcms2): Defsubr Slcms_temp_to_white_point. diff --git a/src/lcms.c b/src/lcms.c index 974fcd4930..1f3ace3baa 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -37,6 +37,9 @@ DEF_DLL_FN (cmsHANDLE, cmsCIECAM02Init, DEF_DLL_FN (void, cmsCIECAM02Forward, (cmsHANDLE hModel, const cmsCIEXYZ* pIn, cmsJCh* pOut)); DEF_DLL_FN (void, cmsCIECAM02Done, (cmsHANDLE hModel)); +DEF_DLL_FN (cmsBool, cmsWhitePointFromTemp, + (cmsCIExyY* WhitePoint, cmsFloat64Number TempK)); +DEF_DLL_FN (void, cmsxyY2XYZ, (cmsCIEXYZ* Dest, const cmsCIExyY* Source)); static bool lcms_initialized; @@ -52,6 +55,8 @@ init_lcms_functions (void) LOAD_DLL_FN (library, cmsCIECAM02Init); LOAD_DLL_FN (library, cmsCIECAM02Forward); LOAD_DLL_FN (library, cmsCIECAM02Done); + LOAD_DLL_FN (library, cmsWhitePointFromTemp); + LOAD_DLL_FN (library, cmsxyY2XYZ); return true; } @@ -59,11 +64,15 @@ init_lcms_functions (void) # undef cmsCIECAM02Init # undef cmsCIECAM02Forward # undef cmsCIECAM02Done +# undef cmsWhitePointFromTemp +# undef cmsxyY2XYZ -# define cmsCIE2000DeltaE fn_cmsCIE2000DeltaE -# define cmsCIECAM02Init fn_cmsCIECAM02Init -# define cmsCIECAM02Forward fn_cmsCIECAM02Forward -# define cmsCIECAM02Done fn_cmsCIECAM02Done +# define cmsCIE2000DeltaE fn_cmsCIE2000DeltaE +# define cmsCIECAM02Init fn_cmsCIECAM02Init +# define cmsCIECAM02Forward fn_cmsCIECAM02Forward +# define cmsCIECAM02Done fn_cmsCIECAM02Done +# define cmsWhitePointFromTemp fn_cmsWhitePointFromTemp +# define cmsxyY2XYZ fn_cmsxyY2XYZ #endif /* WINDOWSNT */ @@ -184,7 +193,7 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) xyzw.Y = 100.0; xyzw.Z = 108.883; } - else if (!(CONSP (whitepoint) && parse_xyz_list(whitepoint, &xyzw))) + else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) signal_error("Invalid white point", whitepoint); vc.whitePoint.X = xyzw.X; @@ -234,7 +243,7 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K. -Valid range is 4000K to 25000K. */) +Valid range of TEMPERATURE is from 4000K to 25000K. */) (Lisp_Object temperature) { cmsFloat64Number tempK; @@ -251,12 +260,12 @@ Valid range is 4000K to 25000K. */) } #endif - CHECK_NUMBER_OR_FLOAT(temperature); + CHECK_NUMBER_OR_FLOAT (temperature); - tempK = XFLOATINT(temperature); - if (!(cmsWhitePointFromTemp(&whitepoint, tempK))) + tempK = XFLOATINT (temperature); + if (!(cmsWhitePointFromTemp (&whitepoint, tempK))) signal_error("Invalid temperature", temperature); - cmsxyY2XYZ(&wp, &whitepoint); + cmsxyY2XYZ (&wp, &whitepoint); return list3 (make_float (wp.X), make_float (wp.Y), make_float (wp.Z)); } @@ -289,6 +298,7 @@ syms_of_lcms2 (void) defsubr (&Slcms_cie_de2000); defsubr (&Slcms_cam02_ucs); defsubr (&Slcms2_available_p); + defsubr (&Slcms_temp_to_white_point); Fprovide (intern_c_string ("lcms2"), Qnil); } commit cb27a13413d859788d995b45b6d0414b1ba9a060 Author: Eli Zaretskii Date: Sat Sep 16 10:31:32 2017 +0300 Avoid GCC 7 compilation warning in data.c * src/data.c (minmax_driver): Use UNINIT to avoid compilation warnings. Reported by Fabrice Popineau . diff --git a/src/data.c b/src/data.c index feca0a6f37..9ccfa6475a 100644 --- a/src/data.c +++ b/src/data.c @@ -3011,7 +3011,7 @@ minmax_driver (ptrdiff_t nargs, Lisp_Object *args, enum Arith_Comparison comparison) { eassume (0 < nargs); - Lisp_Object accum; + Lisp_Object accum UNINIT; for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) { Lisp_Object val = args[argnum]; commit f5f261c6901e51b28deaa05dab157a38adf08912 Author: Mark Oteiza Date: Fri Sep 15 23:49:42 2017 -0400 Add lcms-temp->white-point and initial tests * src/lcms.c (lcms-temp->white-point): New function. * test/src/lcms-tests.el: New file. diff --git a/src/lcms.c b/src/lcms.c index 49af402327..974fcd4930 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -232,6 +232,34 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) (bp2 - bp1) * (bp2 - bp1))); } +DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, + doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K. +Valid range is 4000K to 25000K. */) + (Lisp_Object temperature) +{ + cmsFloat64Number tempK; + cmsCIExyY whitepoint; + cmsCIEXYZ wp; + +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + + CHECK_NUMBER_OR_FLOAT(temperature); + + tempK = XFLOATINT(temperature); + if (!(cmsWhitePointFromTemp(&whitepoint, tempK))) + signal_error("Invalid temperature", temperature); + cmsxyY2XYZ(&wp, &whitepoint); + return list3 (make_float (wp.X), make_float (wp.Y), make_float (wp.Z)); +} + DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0, doc: /* Return t if lcms2 color calculations are available in this instance of Emacs. */) (void) diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el new file mode 100644 index 0000000000..0d6b8db3d4 --- /dev/null +++ b/test/src/lcms-tests.el @@ -0,0 +1,69 @@ +;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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: + +;; Some "exact" values computed using the colorspacious python library +;; written by Nathaniel J. Smith. See +;; https://colorspacious.readthedocs.io/en/v1.1.0/ + +;; Other references: +;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf + +;;; Code: + +(require 'ert) +(require 'color) + +(defun lcms-approx-p (a b &optional delta) + "Check if A and B are within relative error DELTA of one another. +B is considered the exact value." + (> (or delta 0.001) (abs (1- (/ a b))))) + +(defun lcms-triple-approx-p (a b &optional delta) + "Like `lcms-approx-p' except for color triples." + (pcase-let ((`(,a1 ,a2 ,a3) a) + (`(,b1 ,b2 ,b3) b)) + (and (lcms-approx-p a1 b1 delta) + (lcms-approx-p a2 b2 delta) + (lcms-approx-p a3 b3 delta)))) + +(ert-deftest lcms-whitepoint () + "Test use of `lcms-temp->white-point'." + (should-error (lcms-temp->white-point 3999)) + (should-error (lcms-temp->white-point 25001)) + ;; D55 + (should + (lcms-triple-approx-p + (apply #'color-xyz-to-xyy (lcms-temp->white-point 5503)) + '(0.33242 0.34743 1.0))) + ;; D65 + (should + (lcms-triple-approx-p + (apply #'color-xyz-to-xyy (lcms-temp->white-point 6504)) + '(0.31271 0.32902 1.0))) + ;; D75 + (should + (lcms-triple-approx-p + (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504)) + '(0.29902 0.31485 1.0)))) + +;;; lcms-tests.el ends here commit 30c955b1725258546c6152a6dda8f634867a6319 Author: Mark Oteiza Date: Fri Sep 15 22:59:57 2017 -0400 Use cl-print in timer list * lisp/emacs-lisp/timer-list.el (timer-list): Use cl-print for handling functions. (timer-list-mode): Capitalize major mode name. Set bidi direction as in tabulated-list-mode. diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 5d00fb290f..44a315f980 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -35,9 +35,7 @@ (dolist (timer (append timer-list timer-idle-list)) (insert (format "%4s %10s %8s %s" ;; Idle. - (if (aref timer 7) - "*" - " ") + (if (aref timer 7) "*" " ") ;; Next time. (let ((time (float-time (list (aref timer 1) (aref timer 2) @@ -59,16 +57,9 @@ (t (format "%s" repeat)))) ;; Function. - (let ((function (aref timer 5))) - (replace-regexp-in-string - "\n" " " - (cond - ((byte-code-function-p function) - (replace-regexp-in-string - "[^-A-Za-z0-9 ]" "" - (format "%s" function))) - (t - (format "%s" function))))))) + (let ((cl-print-compiled 'static) + (cl-print-compiled-button nil)) + (cl-prin1-to-string (aref timer 5))))) (put-text-property (line-beginning-position) (1+ (line-beginning-position)) 'timer timer) @@ -88,8 +79,9 @@ ["Cancel" timer-list-cancel t])) map)) -(define-derived-mode timer-list-mode special-mode "timer-list" +(define-derived-mode timer-list-mode special-mode "Timer-List" "Mode for listing and controlling timers." + (setq bidi-paragraph-direction 'left-to-right) (setq truncate-lines t) (buffer-disable-undo) (setq-local revert-buffer-function 'timer-list) commit 767b3a7429d94d1565256565fda2060c95ca4f73 Merge: d1458d0f40 9785d35137 Author: Vincent Belaïche Date: Fri Sep 15 23:52:24 2017 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit d1458d0f40f481e0ac55a55e7567d6e51438b583 Author: Vincent Belaïche Date: Fri Sep 15 23:51:05 2017 +0200 Make landscape layout with geometry package rather than a PostScript special. * lisp/calendar/cal-tex.el (cal-tex-preamble): Make 12pt the default class option. (cal-tex-year, cal-tex-cursor-month-landscape): Pass landscape request to `cal-tex-insert-preamble' function call within the class option string. (cal-tex-cursor-month): Don't pass any longer "12pt" argument to `cal-tex-insert-preamble' function, as it is default. (cal-tex-insert-preamble): Suppress landscape and size argument, and replace them by a class-options string argument. Do not insert any longer "\special{landscape}" in case of landscape layout, as the job is made by the geometry package. diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 1ea10bf9d7..689ba0f33a 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -259,12 +259,33 @@ This definition is the heart of the calendar!") (defun cal-tex-preamble (&optional args) "Insert the LaTeX calendar preamble into `cal-tex-buffer'. Preamble includes initial definitions for various LaTeX commands. -Optional string ARGS are included as options for the article document class." +Optional string ARGS are included as options for the article +document class with inclusion of default values \"12pt\" for +size, and \"a4paper\" for paper unless size or paper are already +specified in ARGS. When ARGS is omitted, by default the option +\"12pt,a4paper\" is passed. When ARGS has any other value, then +no option is passed to the class. + +Insert the \"\\usepacakge{geometry}\" directive when ARGS +contains the \"landscape\" string." (set-buffer (generate-new-buffer cal-tex-buffer)) - (insert (format "\\documentclass%s{article}\n" - (if (stringp args) - (format "[%s]" args) - ""))) + (save-match-data + (insert (format "\\documentclass%s{article}\n" + (cond + ((stringp args) + ;; set default size + (unless (string-match "\\(^\\|,\\) *[0-9]+pt *\\(,\\|$\\)" args) + (setq args (concat args ",12pt"))) + ;; set default paper + (unless (string-match "\\(^\\|,\\) *\\([ab][4-5]\\|le\\(tter\\|gal\\)\\|executive\\)paper *\\(,\\|$\\)" args) + (setq args (concat args ",a4paper"))) + (when (string= (substring args 0 1) ",") + (setq args (substring args 1))) + (if (string= args "") "" (format "[%s]" args))) + ((null args) "[12pt]") + (t "")))) + (if (and (stringp args) (string-match "\\" args)) + (insert "\\usepackage{geometry}\n"))) (if (stringp cal-tex-preamble-extra) (insert cal-tex-preamble-extra "\n")) ;; FIXME boxwidth and boxheight unused? @@ -320,7 +341,7 @@ Optional EVENT indicates a buffer position to use instead of point." There are four rows of three months each, unless optional LANDSCAPE is non-nil, in which case the calendar is printed in landscape mode with three rows of four months each." - (cal-tex-insert-preamble 1 landscape "12pt") + (cal-tex-insert-preamble 1 (and landscape "landscape")) (if landscape (cal-tex-vspace "-.6cm") (cal-tex-vspace "-3.1cm")) @@ -476,7 +497,7 @@ Optional EVENT indicates a buffer position to use instead of point." (diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2))) (holidays (if cal-tex-holidays (holiday-in-range d1 d2))) other-month other-year small-months-at-start) - (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt") + (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) "landscape") (cal-tex-cmd cal-tex-cal-one-month) (dotimes (i n) (setq other-month month @@ -515,7 +536,7 @@ Optional EVENT indicates a buffer position to use instead of point." (calendar-increment-month month year 1) (cal-tex-vspace "-2cm") (cal-tex-insert-preamble - (cal-tex-number-weeks month year 1) t "12pt" t)))) + (cal-tex-number-weeks month year 1) "landscape" t)))) (cal-tex-end-document) (run-hooks 'cal-tex-hook)) @@ -545,7 +566,7 @@ indicates a buffer position to use instead of point." end-year)))) (diary-list (if cal-tex-diary (cal-tex-list-diary-entries d1 d2))) (holidays (if cal-tex-holidays (holiday-in-range d1 d2)))) - (cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil "12pt") + (cal-tex-insert-preamble (cal-tex-number-weeks month year n)) (if (> n 1) (cal-tex-cmd cal-tex-cal-multi-month) (cal-tex-cmd cal-tex-cal-one-month)) @@ -1615,24 +1636,27 @@ informative header, and run HOOK." \t\tM-x tex-buffer RET \t\tM-x tex-print RET"))) -(defun cal-tex-insert-preamble (weeks landscape size &optional append) +(defun cal-tex-insert-preamble (weeks &optional class-options append) "Initialize the output LaTeX calendar buffer, `cal-tex-buffer'. Select the output buffer, and insert the preamble for a calendar -of WEEKS weeks. Insert code for landscape mode if LANDSCAPE is -non-nil. Use point-size SIZE. Optional argument APPEND, if -non-nil, means add to end of buffer without erasing current contents." - (let ((width "18cm") +of WEEKS weeks. Pass string CLASS-OPTIONS as options for the +article document class. If it contains \"landscape\", use the +geometry package to produce landscape format. Optional argument +APPEND, if non-nil, means add to end of buffer without erasing +current contents." + (let ((landscape (and class-options + (string-match "\\" class-options))) + (width "18cm") (height "24cm")) (when landscape - (setq width "24cm" - height "18cm")) + (let ((swap width)) + (setq width height height swap))) (unless append - (cal-tex-preamble size) + (cal-tex-preamble class-options) (if (not landscape) (progn (cal-tex-cmd "\\oddsidemargin -1.75cm") (cal-tex-cmd "\\def\\holidaymult" ".06")) - (cal-tex-cmd "\\special" "landscape") (cal-tex-cmd "\\textwidth 9.5in") (cal-tex-cmd "\\textheight 7in") (cal-tex-comment) commit 9785d3513741c598ae53aecafacbb9bca3e53e48 Author: Mark Oteiza Date: Fri Sep 15 15:37:25 2017 -0400 * lisp/json.el (json-read-keyword): Revert previous change to catch EOL. diff --git a/lisp/json.el b/lisp/json.el index b13ec781b4..d5f05fed95 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -305,7 +305,7 @@ KEYWORD is the keyword expected." (json-advance)) keyword) (json-skip-whitespace) - (unless (memq (following-char) '(?\] ?, ?})) + (unless (looking-at "\\([],}]\\|$\\)") (signal 'json-unknown-keyword (list (save-excursion (backward-word-strictly 1) commit 541b596bf155ceb17958e1d122920f6bb1a1ab58 Author: Eli Zaretskii Date: Fri Sep 15 21:59:08 2017 +0300 One more attempt to avoid GCC 7 warnings in dispnew.c * src/dispnew.c (adjust_glyph_matrix): Use eassume instead of eassert, to avoid compilation warnings about NULL pointer dereferences. diff --git a/src/dispnew.c b/src/dispnew.c index ec9c77ded5..4a319ccc11 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -386,7 +386,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y Do nothing if MATRIX' size, position, vscroll, and marginal areas haven't changed. This optimization is important because preserving the matrix means preventing redisplay. */ - eassert (w != NULL || matrix->pool != NULL); + eassume (w != NULL || matrix->pool != NULL); if (matrix->pool == NULL) { left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols); commit 6e38b9253e3d67def0e16f90da574b4622d962a3 Author: Mark Oteiza Date: Fri Sep 15 13:27:39 2017 -0400 Fix color-distance docstring Also feed the translated color to the metric argument. * src/xfaces.c (color-distance): Reword docstring to be more helpful. Avoid duplicating effort in lcms2 by passing the translated 16 bit RGB instead of the function's color arguments. diff --git a/src/xfaces.c b/src/xfaces.c index 012de4e7af..b309c16127 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4093,7 +4093,8 @@ DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 4, 0, COLOR1 and COLOR2 may be either strings containing the color name, or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive. If FRAME is unspecified or nil, the current frame is used. -If METRIC is unspecified or nil, a modified L*u*v* metric is used. */) +If METRIC is specified, it should be a function that accepts +two lists of the form (RED GREEN BLUE) aforementioned. */) (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame, Lisp_Object metric) { @@ -4112,7 +4113,13 @@ If METRIC is unspecified or nil, a modified L*u*v* metric is used. */) if (NILP (metric)) return make_number (color_distance (&cdef1, &cdef2)); else - return call2 (metric, color1, color2); + return call2 (metric, + list3 (make_number (cdef1.red), + make_number (cdef1.green), + make_number (cdef1.blue)), + list3 (make_number (cdef2.red), + make_number (cdef2.green), + make_number (cdef2.blue))); } commit 7911ebc6101679fed116218e8b5c08f11c712f51 Author: Michael Albinus Date: Fri Sep 15 18:29:00 2017 +0200 Improve Tramp behaviour according to bug#27986 * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file): * lisp/net/tramp-sh.el (tramp-sh-handle-copy-directory): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-copy-file): Check, that NEWNAME is a directory name when existing. Use `file-name-as-directory' where appropriate. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 30e0c17acf..c22869d2cc 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -739,7 +739,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal (car err) (cdr err)))) ;; Remote newname. - (when (file-directory-p newname) + (when (and (file-directory-p newname) + (directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 016a9205c9..7df5aa3b7b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1984,24 +1984,26 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (tramp-dissect-file-name newname))))) ;; scp or rsync DTRT. (progn + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) (setq dirname (directory-file-name (expand-file-name dirname)) newname (directory-file-name (expand-file-name newname))) - (if (and (file-directory-p newname) - (not (string-equal (file-name-nondirectory dirname) - (file-name-nondirectory newname)))) - (setq newname - (expand-file-name - (file-name-nondirectory dirname) newname))) - (if (not (file-directory-p (file-name-directory newname))) + (when (and (file-directory-p newname) + (not (string-equal (file-name-nondirectory dirname) + (file-name-nondirectory newname)))) + (setq newname + (expand-file-name + (file-name-nondirectory dirname) newname))) + (when (not (file-directory-p (file-name-directory newname))) (make-directory (file-name-directory newname) parents)) (tramp-do-copy-or-rename-file-out-of-band 'copy dirname newname keep-date)) + ;; We must do it file-wise. (tramp-run-real-handler 'copy-directory - (if copy-contents - (list dirname newname keep-date parents copy-contents) - (list dirname newname keep-date parents)))) + (list dirname newname keep-date parents copy-contents))) ;; When newname did exist, we have wrong cached values. (when t2 diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index e7646e68c2..4969566670 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -414,6 +414,9 @@ pass to the OPERATION." (with-parsed-tramp-file-name (if t1 dirname newname) nil (with-tramp-progress-reporter v 0 (format "Copying %s to %s" dirname newname) + (when (and (file-directory-p newname) + (not (directory-name-p newname))) + (tramp-error v 'file-already-exists newname)) (cond ;; We must use a local temporary directory. ((and t1 t2) @@ -425,7 +428,8 @@ pass to the OPERATION." (unwind-protect (progn (make-directory tmpdir) - (copy-directory dirname tmpdir keep-date 'parents) + (copy-directory + dirname (file-name-as-directory tmpdir) keep-date 'parents) (copy-directory (expand-file-name (file-name-nondirectory dirname) tmpdir) newname keep-date parents)) @@ -569,8 +573,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." 0 (format "Copying %s to %s" filename newname) (if (file-directory-p filename) - (copy-directory - filename newname keep-date 'parents 'copy-contents) + (copy-directory filename newname keep-date 'parents 'copy-contents) (let ((tmpfile (file-local-copy filename))) (if tmpfile @@ -582,7 +585,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (signal (car err) (cdr err)))) ;; Remote newname. - (when (file-directory-p newname) + (when (and (file-directory-p newname) + (directory-name-p newname)) (setq newname (expand-file-name (file-name-nondirectory filename) newname))) commit 1c700547505dd7f2bf3800830e6b113f7248f528 Author: Mark Oteiza Date: Fri Sep 15 10:06:56 2017 -0400 ; Partially revert previous commit The reduction in was because I broke it. * lisp/json.el (json-pop): Do not bind at compile time something needed at run time. diff --git a/lisp/json.el b/lisp/json.el index 1e724b42e7..b13ec781b4 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -197,12 +197,12 @@ Unlike `reverse', this keeps the property-value pairs intact." (define-inline json-pop () "Advance past the character at point, returning it." - (inline-letevals ((char (json-peek))) - (inline-quote - (if (zerop ,char) + (inline-quote + (let ((char (json-peek))) + (if (zerop char) (signal 'json-end-of-file nil) (json-advance) - ,char)))) + char)))) (define-inline json-skip-whitespace () "Skip past the whitespace at point." commit 3b783a75ad6b609d4e0f60c2d31d4fe91dd08c62 Author: Mark Oteiza Date: Fri Sep 15 09:49:27 2017 -0400 More JSON optimization Last I checked, inlining json-skip-whitespace didn't make much difference. However, changing defsubsts to define-inline results in roughly 15% reduction in read time on a 200K file. * lisp/json.el (json-advance, json-peek, json-pop): (json-skip-whitespace): Inline with define-inline. (json-read-keyword): Don't use whitespace syntax. (json-add-to-object): Simpler condition. diff --git a/lisp/json.el b/lisp/json.el index 7e924b6777..1e724b42e7 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -187,29 +187,30 @@ Unlike `reverse', this keeps the property-value pairs intact." ;; Reader utilities -(defsubst json-advance (&optional n) +(define-inline json-advance (&optional n) "Advance N characters forward." - (forward-char n)) + (inline-quote (forward-char ,n))) -(defsubst json-peek () +(define-inline json-peek () "Return the character at point." - (following-char)) + (inline-quote (following-char))) -(defsubst json-pop () +(define-inline json-pop () "Advance past the character at point, returning it." - (let ((char (json-peek))) - (if (zerop char) - (signal 'json-end-of-file nil) - (json-advance) - char))) - -(defun json-skip-whitespace () + (inline-letevals ((char (json-peek))) + (inline-quote + (if (zerop ,char) + (signal 'json-end-of-file nil) + (json-advance) + ,char)))) + +(define-inline json-skip-whitespace () "Skip past the whitespace at point." ;; See ;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf ;; or https://tools.ietf.org/html/rfc7159#section-2 for the ;; definition of whitespace in JSON. - (skip-chars-forward "\t\r\n ")) + (inline-quote (skip-chars-forward "\t\r\n "))) @@ -303,7 +304,8 @@ KEYWORD is the keyword expected." (thing-at-point 'word))))) (json-advance)) keyword) - (unless (looking-at "\\(\\s-\\|[],}]\\|$\\)") + (json-skip-whitespace) + (unless (memq (following-char) '(?\] ?, ?})) (signal 'json-unknown-keyword (list (save-excursion (backward-word-strictly 1) @@ -470,11 +472,10 @@ Returns the updated object, which you should save, e.g.: (setq obj (json-add-to-object obj \"foo\" \"bar\")) Please see the documentation of `json-object-type' and `json-key-type'." (let ((json-key-type - (if (eq json-key-type nil) + (or json-key-type (cdr (assq json-object-type '((hash-table . string) (alist . symbol) - (plist . keyword)))) - json-key-type))) + (plist . keyword))))))) (setq key (cond ((eq json-key-type 'string) key) commit 817e92b2bddbdbe18d3b8cd34533b4bec04d313d Author: Eli Zaretskii Date: Fri Sep 15 16:15:05 2017 +0300 Avoid crashes due to invalid error forms from sentinels/filters * src/process.c (exec_sentinel_error_handler): Make sure the error form passed to cmd_error_internal is a cons cell. (Bug#28430) diff --git a/src/process.c b/src/process.c index b941b5c1f9..2733fa3911 100644 --- a/src/process.c +++ b/src/process.c @@ -7102,6 +7102,10 @@ deliver_child_signal (int sig) static Lisp_Object exec_sentinel_error_handler (Lisp_Object error_val) { + /* Make sure error_val is a cons cell, as all the rest of error + handling expects that, and will barf otherwise. */ + if (!CONSP (error_val)) + error_val = Fcons (Qerror, error_val); cmd_error_internal (error_val, "error in process sentinel: "); Vinhibit_quit = Qt; update_echo_area (); commit 015172d1ba36de9ab2ca2cae020b6ab6793dbb8c Author: Eli Zaretskii Date: Fri Sep 15 11:46:37 2017 +0300 Avoid compilation warnings with GCC 7 on MS-Windows * src/w32term.c (w32_setup_relief_color, construct_mouse_click) (w32_read_socket): Initialize variables to shut up bogus compilation warnings from GCC 7. * src/unexw32.c (COPY_CHUNK, COPY_PROC_CHUNK): Cast to DWORD_PTR to avoid compiler warnings about printing signed values using %x format spec. * src/dispnew.c (adjust_glyph_matrix): Add eassert to avoid compiler warning about possible NULL pointer dereference. * src/lisp.h (pI): Tweak the definition some more for MinGW64. diff --git a/src/dispnew.c b/src/dispnew.c index 2d1df54698..ec9c77ded5 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -386,6 +386,7 @@ adjust_glyph_matrix (struct window *w, struct glyph_matrix *matrix, int x, int y Do nothing if MATRIX' size, position, vscroll, and marginal areas haven't changed. This optimization is important because preserving the matrix means preventing redisplay. */ + eassert (w != NULL || matrix->pool != NULL); if (matrix->pool == NULL) { left = margin_glyphs_to_reserve (w, dim.width, w->left_margin_cols); diff --git a/src/lisp.h b/src/lisp.h index c5aea9c34c..c503082442 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -101,7 +101,8 @@ enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH }; which will cause a warning for %lld etc. */ # if defined __MINGW32__ \ && (!defined __USE_MINGW_ANSI_STDIO \ - || !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)) + || (!defined MINGW_W64 \ + && !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5))) # define pI "I64" # else /* ! MinGW */ # define pI "ll" diff --git a/src/unexw32.c b/src/unexw32.c index d3d6a90f68..0c6b48342e 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -500,8 +500,8 @@ copy_executable_and_dump_data (file_data *p_infile, if (verbose) \ { \ printf ("%s\n", (message)); \ - printf ("\t0x%"pDWP" Offset in input file.\n", s - p_infile->file_base); \ - printf ("\t0x%"pDWP" Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%"pDWP" Offset in input file.\n", (DWORD_PTR)(s - p_infile->file_base)); \ + printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ printf ("\t0x%"pDWP" Size in bytes.\n", count); \ } \ memcpy (dst, s, count); \ @@ -517,7 +517,7 @@ copy_executable_and_dump_data (file_data *p_infile, printf ("%s\n", (message)); \ printf ("\t0x%p Address in process.\n", s); \ printf ("\t0x%p Base output file.\n", p_outfile->file_base); \ - printf ("\t0x%"pDWP" Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%"pDWP" Offset in output file.\n", (DWORD_PTR)(dst - p_outfile->file_base)); \ printf ("\t0x%p Address in output file.\n", dst); \ printf ("\t0x%"pDWP" Size in bytes.\n", count); \ } \ diff --git a/src/w32term.c b/src/w32term.c index e62ae7e842..a7a510b9ec 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -1645,6 +1645,7 @@ w32_setup_relief_color (struct frame *f, struct relief *relief, double factor, if (w32_alloc_lighter_color (f, &pixel, factor, delta)) xgcv.foreground = relief->pixel = pixel; + xgcv.font = NULL; /* avoid compiler warnings */ if (relief->gc == 0) { #if 0 /* TODO: stipple */ @@ -3087,8 +3088,8 @@ parse_button (int message, int xbutton, int * pbutton, int * pup) static Lisp_Object construct_mouse_click (struct input_event *result, W32Msg *msg, struct frame *f) { - int button; - int up; + int button = 0; + int up = 0; parse_button (msg->msg.message, HIWORD (msg->msg.wParam), &button, &up); @@ -4976,8 +4977,8 @@ w32_read_socket (struct terminal *terminal, /* If we decide we want to generate an event to be seen by the rest of Emacs, we put it here. */ bool tool_bar_p = 0; - int button; - int up; + int button = 0; + int up = 0; f = (x_mouse_grabbed (dpyinfo) ? dpyinfo->last_mouse_frame : x_window_to_frame (dpyinfo, msg.msg.hwnd)); commit 025e216566312b562bc1b3379e00e97ae539ea5f Author: Martin Rudalics Date: Fri Sep 15 09:48:54 2017 +0200 Define gnutls_rnd for WINDOWSNT and HAVE_GNUTLS3 case only * src/fns.c (gnutls_rnd): Define for WINDOWSNT and HAVE_GNUTLS3 case only to avoid unused macros warning otherwise. diff --git a/src/fns.c b/src/fns.c index 13d235965e..4524ff9b26 100644 --- a/src/fns.c +++ b/src/fns.c @@ -37,7 +37,7 @@ along with GNU Emacs. If not, see . */ #include "puresize.h" #include "gnutls.h" -#ifdef WINDOWSNT +#if defined WINDOWSNT && defined HAVE_GNUTLS3 # define gnutls_rnd w32_gnutls_rnd #endif commit 0ce6b4310d3bcb0f9c97c1c4bd0838d1628eae15 Author: Martin Rudalics Date: Fri Sep 15 09:39:17 2017 +0200 In w32heap.c bump up DUMPED_HEAP_SIZE * src/w32heap.c (DUMPED_HEAP_SIZE): Bump up DUMPED_HEAP_SIZE to 13*1024*1024 for 32-bit non-wide-integer builds. diff --git a/src/w32heap.c b/src/w32heap.c index cd1324cc86..510f6762bb 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -118,7 +118,7 @@ typedef struct _RTL_HEAP_PARAMETERS { #if defined _WIN64 || defined WIDE_EMACS_INT # define DUMPED_HEAP_SIZE (21*1024*1024) #else -# define DUMPED_HEAP_SIZE (12*1024*1024) +# define DUMPED_HEAP_SIZE (13*1024*1024) #endif static unsigned char dumped_data[DUMPED_HEAP_SIZE]; commit 117f28430ab3e17f811e80025ee6a9165c87057e Author: Mark Oteiza Date: Thu Sep 14 19:52:09 2017 -0400 Bind n,p in timer-list * lisp/emacs-lisp/timer-list.el (timer-list-mode-map): Bind n and p to next- and previous-line, respectively. diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index fb0e98c5b8..5d00fb290f 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -81,6 +81,8 @@ (defvar timer-list-mode-map (let ((map (make-sparse-keymap))) (define-key map "c" 'timer-list-cancel) + (define-key map "n" 'next-line) + (define-key map "p" 'previous-line) (easy-menu-define nil map "" '("Timers" ["Cancel" timer-list-cancel t])) commit ce0aa058641cd7641db6dea6f3d79a30c1fd21f7 Author: Glenn Morris Date: Thu Sep 14 16:35:43 2017 -0400 * lisp/net/tls.el (tls-program): Fix :version. ; Ref: http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00401.html diff --git a/lisp/net/tls.el b/lisp/net/tls.el index e89584994d..76c39b0bec 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -106,7 +106,7 @@ successful negotiation." (repeat :inline t :tag "Other" (string))) (list :tag "List of commands" (repeat :tag "Command" (string)))) - :version "25.3" ; remove s_client + :version "26.1" ; remove s_client :group 'tls) (defcustom tls-process-connection-type nil commit d44c8542af6388ebad67751d4a5cdf8db598746b Author: Eli Zaretskii Date: Thu Sep 14 22:22:29 2017 +0300 * configure.ac (--with-lcms2, --without-lcms2): New options. diff --git a/configure.ac b/configure.ac index 39f7cfb897..c88471657f 100644 --- a/configure.ac +++ b/configure.ac @@ -343,6 +343,7 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support]) OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([lcms2],[don't compile with Little CMS support]) OPTION_DEFAULT_ON([libsystemd],[don't compile with libsystemd support]) OPTION_DEFAULT_OFF([cairo],[compile with Cairo drawing (experimental)]) OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) @@ -3463,7 +3464,7 @@ if test "${with_lcms2}" != "no"; then fi if test "${HAVE_LCMS2}" = "yes"; then AC_DEFINE([HAVE_LCMS2], 1, [Define to 1 if you have the lcms2 library (-llcms2).]) - ### ??? + ### mingw32 doesn't use -llcms2, since it loads the library dynamically. if test "${opsys}" = "mingw32"; then LIBLCMS2= fi commit 0d5f0a8d56bb7e15607c77a7d5d6e36776eff94d Author: Eli Zaretskii Date: Thu Sep 14 21:35:31 2017 +0300 ; * etc/NEWS: Reword the lcms2 entry. diff --git a/etc/NEWS b/etc/NEWS index 315af5addc..016868d5a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -69,10 +69,14 @@ Deterministic builds omit the build date from the output of the following variables nil: 'emacs-build-system', 'emacs-build-time', 'erc-emacs-build-time'. -** New configure option '--with-lcms2' attempts to build an Emacs -linked to Little CMS, exposing color management functions in Lisp. -Implemented functions include the color metrics 'lcms-cie-de2000' and -'lcms-cam02-ucs'. +--- +** Emacs can now be built with support for Little CMS. + +If the lcms2 library is installed, Emacs will enable features built on +top of that library. The new configure option '--without-lcms2' can +be used to build without lcms2 support even if it is installed. Emacs +linked to Little CMS exposes color management functions in Lisp: the +color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs'. ** The configure option '--with-gameuser' now defaults to 'no', as this appears to be the most common configuration in practice. commit 7d33ebc1f0d68b0b2a5bb089e5b62e7e1f6fc3f6 Author: Eli Zaretskii Date: Thu Sep 14 20:46:59 2017 +0300 Avoid 64-bit compilation warnings in unexw32.c * src/unexw32.c (pDWP): New macro. (COPY_CHUNK, COPY_PROC_CHUNK): Declare 'count' as DWORD_PTR. Use pDWP for printing values that can be either 32-bit or 64-bit wide. diff --git a/src/unexw32.c b/src/unexw32.c index 73d2305626..d3d6a90f68 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -470,6 +470,12 @@ get_section_info (file_data *p_infile) } } +/* Format to print a DWORD_PTR value. */ +#ifdef MINGW_W64 +# define pDWP "16llx" +#else +# define pDWP "08lx" +#endif /* The dump routines. */ @@ -490,13 +496,13 @@ copy_executable_and_dump_data (file_data *p_infile, #define COPY_CHUNK(message, src, size, verbose) \ do { \ unsigned char *s = (void *)(src); \ - unsigned long count = (size); \ + DWORD_PTR count = (size); \ if (verbose) \ { \ printf ("%s\n", (message)); \ - printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ - printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08lx Size in bytes.\n", count); \ + printf ("\t0x%"pDWP" Offset in input file.\n", s - p_infile->file_base); \ + printf ("\t0x%"pDWP" Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%"pDWP" Size in bytes.\n", count); \ } \ memcpy (dst, s, count); \ dst += count; \ @@ -505,15 +511,15 @@ copy_executable_and_dump_data (file_data *p_infile, #define COPY_PROC_CHUNK(message, src, size, verbose) \ do { \ unsigned char *s = (void *)(src); \ - unsigned long count = (size); \ + DWORD_PTR count = (size); \ if (verbose) \ { \ printf ("%s\n", (message)); \ printf ("\t0x%p Address in process.\n", s); \ printf ("\t0x%p Base output file.\n", p_outfile->file_base); \ - printf ("\t0x%p Offset in output file.\n", dst - p_outfile->file_base); \ + printf ("\t0x%"pDWP" Offset in output file.\n", dst - p_outfile->file_base); \ printf ("\t0x%p Address in output file.\n", dst); \ - printf ("\t0x%p Size in bytes.\n", count); \ + printf ("\t0x%"pDWP" Size in bytes.\n", count); \ } \ memcpy (dst, s, count); \ dst += count; \ commit 2c29280e7a360f55a8110bb1e3985cc09eb94577 Author: Eli Zaretskii Date: Thu Sep 14 20:38:42 2017 +0300 Fix warnings about formats in printf-like functions on MS-Windows * src/lisp.h (pI) [__MINGW32__]: Provide definition that will hopefully DTRT with both MinGW64 and mingw.org's MinGW. See http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00171.html for the details. * src/conf_post.h (PRINTF_ARCHETYPE) [MINGW_W64]: Separate definition specific to MinGW64. (PRINTF_ARCHETYPE) [__MINGW32__]: For mingw.org's MinGW, use __mingw_printf__ in ANSI-compatible mode. diff --git a/src/conf_post.h b/src/conf_post.h index 096a677997..febdb8b8bf 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -255,7 +255,27 @@ extern int emacs_setenv_TZ (char const *); #if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__ # define PRINTF_ARCHETYPE __gnu_printf__ #elif GNUC_PREREQ (4, 4, 0) && defined __MINGW32__ -# define PRINTF_ARCHETYPE __ms_printf__ +# ifdef MINGW_W64 +/* When __USE_MINGW_ANSI_STDIO is non-zero (as set by config.h), + MinGW64 replaces printf* with its own versions that are + __gnu_printf__ compatible, and emits warnings for MS native %I64d + format spec. */ +# if __USE_MINGW_ANSI_STDIO +# define PRINTF_ARCHETYPE __gnu_printf__ +# else +# define PRINTF_ARCHETYPE __ms_printf__ +# endif +# else /* mingw.org's MinGW */ +/* Starting from runtime v5.0.0, mingw.org's MinGW with GCC 6 and + later turns on __USE_MINGW_ANSI_STDIO by default, replaces printf* + with its own __mingw_printf__ version, which still recognizes + %I64d. */ +# if GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5 +# define PRINTF_ARCHETYPE __mingw_printf__ +# else /* __MINGW32_MAJOR_VERSION < 5 */ +# define PRINTF_ARCHETYPE __ms_printf__ +# endif /* __MINGW32_MAJOR_VERSION < 5 */ +# endif /* MinGW */ #else # define PRINTF_ARCHETYPE __printf__ #endif diff --git a/src/lisp.h b/src/lisp.h index 40e84ec7ec..c5aea9c34c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -94,9 +94,16 @@ typedef long long int EMACS_INT; typedef unsigned long long int EMACS_UINT; enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH }; # define EMACS_INT_MAX LLONG_MAX -# ifdef __MINGW32__ +/* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero, + which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or + later and the runtime version is 5.0.0 or later. Otherwise, + printf-like functions are declared with __ms_printf__ attribute, + which will cause a warning for %lld etc. */ +# if defined __MINGW32__ \ + && (!defined __USE_MINGW_ANSI_STDIO \ + || !(GNUC_PREREQ (6, 0, 0) && __MINGW32_MAJOR_VERSION >= 5)) # define pI "I64" -# else +# else /* ! MinGW */ # define pI "ll" # endif # else commit 56ab0c4a4c99766c041a12f737353c9b889d1750 Author: Eli Zaretskii Date: Thu Sep 14 19:37:35 2017 +0300 Support lcms2 in MS-Windows builds * lisp/term/w32-win.el (dynamic-library-alist): Include association for the lcms2 library. * src/lcms.c [WINDOWSNT]: Include windows.h and w32.h. Use DEF_DLL_FN to define pointers to dynamically loaded lcms2 functions. (cmsCIE2000DeltaE, cmsCIECAM02Init, cmsCIECAM02Forward) (cmsCIECAM02Done): New macros. (init_lcms_functions, Flcms2_available_p): New functions. (Flcms_cie_de2000, Flcms_cam02_ucs) [WINDOWSNT]: Call init_lcms_functions. (syms_of_lcms2): Defsubr lcms2-available-p. * src/w32fns.c (syms_of_w32fns): DEFSYM Qlcms2. * configure.ac: Include lcms2 in the final report and in emacs_config_features. * nt/INSTALL: * nt/INSTALL.W64: Update with the information about lcms2 library. diff --git a/configure.ac b/configure.ac index 1cce2107dc..39f7cfb897 100644 --- a/configure.ac +++ b/configure.ac @@ -5367,7 +5367,7 @@ emacs_config_features= for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ - XWIDGETS LIBSYSTEMD CANNOT_DUMP; do + XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do case $opt in CANNOT_DUMP) eval val=\${$opt} ;; @@ -5400,6 +5400,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} Does Emacs use cairo? ${HAVE_CAIRO} + Does Emacs use -llcms2? ${HAVE_LCMS2} Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK} Does Emacs support sound? ${HAVE_SOUND} Does Emacs use -lgpm? ${HAVE_GPM} diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index bd16145756..4e0e54ae17 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -275,7 +275,8 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") '(gnutls "libgnutls-30.dll") '(gnutls "libgnutls-28.dll" "libgnutls-26.dll")) '(libxml2 "libxml2-2.dll" "libxml2.dll") - '(zlib "zlib1.dll" "libz-1.dll"))) + '(zlib "zlib1.dll" "libz-1.dll") + '(lcms2 "liblcms2-2.dll"))) ;;; multi-tty support (defvar w32-initialized nil diff --git a/nt/INSTALL b/nt/INSTALL index b7f47a5d7c..c6182c22ce 100644 --- a/nt/INSTALL +++ b/nt/INSTALL @@ -486,6 +486,8 @@ build will run on Windows 9X and newer systems). Does Emacs use a gif library? yes Does Emacs use a png library? yes Does Emacs use -lrsvg-2? yes + Does Emacs use cairo? no + Does Emacs use -llcms2? yes Does Emacs use imagemagick? no Does Emacs support sound? no Does Emacs use -lgpm? no @@ -797,6 +799,13 @@ build will run on Windows 9X and newer systems). (This library is also a prerequisite for several image libraries, so you may already have it; look for zlib1.dll or libz-1.dll.) +* Optional support for lcms2 library + + Emacs can expose some capabilities of the Little CMS color + management engine to Lisp programs using the lcms2 library. + Prebuilt binaries of lcms2 DLL (for 32-bit builds of Emacs) are + available from the ezwinports site and from the MSYS2 project. + This file is part of GNU Emacs. diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64 index b40f2238b5..cb13473573 100644 --- a/nt/INSTALL.W64 +++ b/nt/INSTALL.W64 @@ -63,6 +63,7 @@ packages (you can copy and paste it into the shell with Shift + Insert): mingw-w64-x86_64-libpng \ mingw-w64-x86_64-libjpeg-turbo \ mingw-w64-x86_64-librsvg \ + mingw-w64-x86_64-liblcms2 \ mingw-w64-x86_64-libxml2 \ mingw-w64-x86_64-gnutls \ mingw-w64-x86_64-zlib diff --git a/src/lcms.c b/src/lcms.c index 10c79ae24a..49af402327 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -25,6 +25,48 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +#ifdef WINDOWSNT +# include +# include "w32.h" + +DEF_DLL_FN (cmsFloat64Number, cmsCIE2000DeltaE, + (const cmsCIELab* Lab1, const cmsCIELab* Lab2, cmsFloat64Number Kl, + cmsFloat64Number Kc, cmsFloat64Number Kh)); +DEF_DLL_FN (cmsHANDLE, cmsCIECAM02Init, + (cmsContext ContextID, const cmsViewingConditions* pVC)); +DEF_DLL_FN (void, cmsCIECAM02Forward, + (cmsHANDLE hModel, const cmsCIEXYZ* pIn, cmsJCh* pOut)); +DEF_DLL_FN (void, cmsCIECAM02Done, (cmsHANDLE hModel)); + +static bool lcms_initialized; + +static bool +init_lcms_functions (void) +{ + HMODULE library = w32_delayed_load (Qlcms2); + + if (!library) + return false; + + LOAD_DLL_FN (library, cmsCIE2000DeltaE); + LOAD_DLL_FN (library, cmsCIECAM02Init); + LOAD_DLL_FN (library, cmsCIECAM02Forward); + LOAD_DLL_FN (library, cmsCIECAM02Done); + return true; +} + +# undef cmsCIE2000DeltaE +# undef cmsCIECAM02Init +# undef cmsCIECAM02Forward +# undef cmsCIECAM02Done + +# define cmsCIE2000DeltaE fn_cmsCIE2000DeltaE +# define cmsCIECAM02Init fn_cmsCIECAM02Init +# define cmsCIECAM02Forward fn_cmsCIECAM02Forward +# define cmsCIECAM02Done fn_cmsCIECAM02Done + +#endif /* WINDOWSNT */ + static bool parse_lab_list (Lisp_Object lab_list, cmsCIELab *color) { @@ -58,6 +100,16 @@ chroma, and hue, respectively. The parameters each default to 1. */) cmsCIELab Lab1, Lab2; cmsFloat64Number Kl, Kc, Kh; +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + if (!(CONSP (color1) && parse_lab_list (color1, &Lab1))) signal_error ("Invalid color", color1); if (!(CONSP (color2) && parse_lab_list (color2, &Lab2))) @@ -112,6 +164,16 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) double Jp1, ap1, bp1, Jp2, ap2, bp2; double Mp1, Mp2, FL, k, k4; +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1))) signal_error ("Invalid color", color1); if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) @@ -170,6 +232,27 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */) (bp2 - bp1) * (bp2 - bp1))); } +DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0, + doc: /* Return t if lcms2 color calculations are available in this instance of Emacs. */) + (void) +{ +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qlcms2, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); + else + { + Lisp_Object status; + lcms_initialized = init_lcms_functions (); + status = lcms_initialized ? Qt : Qnil; + Vlibrary_cache = Fcons (Fcons (Qlcms2, status), Vlibrary_cache); + return status; + } +#else /* !WINDOWSNT */ + return Qt; +#endif +} + /* Initialization */ void @@ -177,6 +260,7 @@ syms_of_lcms2 (void) { defsubr (&Slcms_cie_de2000); defsubr (&Slcms_cam02_ucs); + defsubr (&Slcms2_available_p); Fprovide (intern_c_string ("lcms2"), Qnil); } diff --git a/src/w32fns.c b/src/w32fns.c index 6b93afa8b8..a77464465e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10405,6 +10405,7 @@ syms_of_w32fns (void) DEFSYM (Qlibxml2, "libxml2"); DEFSYM (Qserif, "serif"); DEFSYM (Qzlib, "zlib"); + DEFSYM (Qlcms2, "lcms2"); Fput (Qundefined_color, Qerror_conditions, listn (CONSTYPE_PURE, 2, Qundefined_color, Qerror)); commit bc5485edeff0ccb3fbcc7fe6b6f13c666699e959 Author: Paul Eggert Date: Thu Sep 14 07:23:13 2017 -0700 Port renameat_noreplace to openSUSE 12.3 Problem reported by M. Nomiya in: http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00363.html * src/sysdep.c (renameat_noreplace): Call renameat2 only if CYGWIN. diff --git a/src/sysdep.c b/src/sysdep.c index 318d4eb380..1e6e0d011b 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2689,7 +2689,7 @@ renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { #if defined SYS_renameat2 && defined RENAME_NOREPLACE return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); -#elif defined RENAME_NOREPLACE /* Cygwin >= 2.9.0. */ +#elif defined CYGWIN && defined RENAME_NOREPLACE return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE); #elif defined RENAME_EXCL return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL); commit bc511a64f6da9ab51acc7c8865e80c4a4cb655c2 Author: Paul Eggert Date: Wed Sep 13 15:52:52 2017 -0700 Prefer HTTPS to FTP and HTTP in documentation Most of this change is to boilerplate commentary such as license URLs. This change was prompted by ftp://ftp.gnu.org's going-away party, planned for November. Change these FTP URLs to https://ftp.gnu.org instead. Make similar changes for URLs to other organizations moving away from FTP. Also, change HTTP to HTTPS for URLs to gnu.org and fsf.org when this works, as this will further help defend against man-in-the-middle attacks (for this part I omitted the MS-DOS and MS-Windows sources and the test tarballs to keep the workload down). HTTPS is not fully working to lists.gnu.org so I left those URLs alone for now. diff --git a/.gitattributes b/.gitattributes index d523e13f3c..df75c9a1ad 100644 --- a/.gitattributes +++ b/.gitattributes @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . # A few files use CRLF endings, even on non-Microsoft platforms. # Do not warn about trailing whitespace with these files. diff --git a/.gitignore b/.gitignore index 9229297833..7426082906 100644 --- a/.gitignore +++ b/.gitignore @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Currently we assume only Git 1.7.1 (April 2010) or later, so this diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 91ed6f974f..08dd74ed08 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -13,7 +13,7 @@ # 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 . +# along with GNU Emacs. If not, see . # GNU Emacs support for the GitLab protocol for CI diff --git a/BUGS b/BUGS index 30bf10ed94..ee473213c8 100644 --- a/BUGS +++ b/BUGS @@ -7,7 +7,7 @@ Bugs section of the Emacs manual for advice on You can read the Bugs section of the manual from inside Emacs. Start Emacs, and press C-h r (to view the Emacs manual) - m Bugs RET (to go to the section on Bugs) + m Bugs RET (to go to the section on Bugs) Or you can use the standalone Info program: info emacs m Bugs RET @@ -15,7 +15,7 @@ Or you can use the standalone Info program: Emacs distribution.) Printed copies of the Emacs manual can be purchased from the Free -Software Foundation's online store at . +Software Foundation's online store at . If necessary, you can read the manual without an info program: diff --git a/CONTRIBUTE b/CONTRIBUTE index 9b5fb090e7..90c6a86b12 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -1,7 +1,7 @@ * How developers contribute to GNU Emacs Here is how software developers can contribute to Emacs. (Non-developers: see -http://www.gnu.org/software/emacs/manual/html_node/emacs/Contributing.html +https://www.gnu.org/software/emacs/manual/html_node/emacs/Contributing.html or run the shell command 'info "(emacs)Contributing"'.) ** The Emacs repository @@ -38,12 +38,12 @@ there. Bug reports and fixes, feature requests and patches/implementations should be sent to bug-gnu-emacs@gnu.org, the bug/feature list. This -is coupled to the http://debbugs.gnu.org tracker. It is best to use +is coupled to the https://debbugs.gnu.org tracker. It is best to use the command 'M-x report-emacs-bug RET' to report issues to the tracker (described below). Be prepared to receive comments and requests for changes in your patches, following your submission. -The Savannah info page http://savannah.gnu.org/mail/?group=emacs +The Savannah info page https://savannah.gnu.org/mail/?group=emacs describes how to subscribe to the mailing lists, or see the list archives. @@ -55,7 +55,7 @@ such patch without additional remarks, you can use a command like ** Issue tracker (a.k.a. "bug tracker") -The Emacs issue tracker at http://debbugs.gnu.org lets you view bug +The Emacs issue tracker at https://debbugs.gnu.org lets you view bug reports and search the database for bugs matching several criteria. Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned above, are recorded by the tracker with the corresponding bugs/issues. @@ -89,11 +89,11 @@ If your change requires updating the manuals to document new functions/commands/variables/faces, then use the proper Texinfo command to index them; for instance, use @vindex for variables and @findex for functions/commands. For the full list of predefine indices, see -http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html +https://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html or run the shell command 'info "(texinfo)Predefined Indices"'. For more specific tips on Emacs's doc style, see -http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html +https://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html Use 'checkdoc' to check for documentation errors before submitting a patch. ** Testing your changes @@ -104,7 +104,7 @@ functionality you commit (of course, some changes cannot be easily tested). Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See -http://www.gnu.org/software/emacs/manual/html_node/ert/ +https://www.gnu.org/software/emacs/manual/html_node/ert/ or run 'info "(ert)"' for for more information on writing and running tests. @@ -184,7 +184,7 @@ them right the first time, so here are guidelines for formatting them: between the summary line and the file entries. - Emacs generally follows the GNU coding standards for ChangeLogs: see - http://www.gnu.org/prep/standards/html_node/Change-Logs.html + https://www.gnu.org/prep/standards/html_node/Change-Logs.html or run 'info "(standards)Change Logs"'. One exception is that commits still sometimes quote `like-this' (as the standards used to recommend) rather than 'like-this' or ‘like this’ (as they do now), @@ -194,7 +194,7 @@ them right the first time, so here are guidelines for formatting them: to ChangeLog entries: they must be in English, and be complete sentences starting with a capital and ending with a period (except the summary line should not end in a period). See - http://www.gnu.org/prep/standards/html_node/Comments.html + https://www.gnu.org/prep/standards/html_node/Comments.html or run 'info "(standards)Comments"'. They are preserved indefinitely, and have a reasonable chance of @@ -234,7 +234,7 @@ them right the first time, so here are guidelines for formatting them: ** Generating ChangeLog entries - You can use Emacs functions to write ChangeLog entries; see - http://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html + https://www.gnu.org/software/emacs/manual/html_node/emacs/Change-Log-Commands.html or run 'info "(emacs)Change Log Commands"'. - If you use Emacs VC, one way to format ChangeLog entries is to create @@ -305,8 +305,8 @@ The best way to understand Emacs internals is to read the code. Some source files, such as xdisp.c, have extensive comments describing the design and implementation. The following resources may also help: -http://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html -http://www.gnu.org/software/emacs/manual/html_node/elisp/GNU-Emacs-Internals.html +https://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html +https://www.gnu.org/software/emacs/manual/html_node/elisp/GNU-Emacs-Internals.html or run 'info "(elisp)Tips"' or 'info "(elisp)GNU Emacs Internals"'. @@ -365,7 +365,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: mode: outline diff --git a/GNUmakefile b/GNUmakefile index 304a7b34f3..3627d220d0 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . # # written by Paul Eggert diff --git a/INSTALL b/INSTALL index b018055f02..e76e843ce2 100644 --- a/INSTALL +++ b/INSTALL @@ -24,7 +24,7 @@ find some things, or what options to use. 'src/config.h' file containing system-dependent definitions. Running the 'make' utility then builds the package for your system. -Building Emacs requires GNU make, . +Building Emacs requires GNU make, . On most systems that Emacs supports, this is the default 'make' program. Here's the procedure to build Emacs using 'configure' on systems which @@ -162,7 +162,7 @@ can be found (in the unlikely event that your distribution does not provide them). By default, libraries marked with an X are required if X11 is being used. - libXaw3d http://directory.fsf.org/project/xaw3d/ + libXaw3d https://directory.fsf.org/project/xaw3d/ X libxpm for XPM: http://www.x.org/releases/current/src/lib/ X libpng for PNG: http://www.libpng.org/ libz (for PNG): http://www.zlib.net/ @@ -187,7 +187,7 @@ them. On the GNU system, Emacs supports both X fonts and local fonts (i.e. fonts managed by the fontconfig library). If you need more fonts than your distribution normally provides, you must install them -yourself. See for a large +yourself. See for a large number of free Unicode fonts. * GNU/Linux development packages @@ -678,4 +678,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/INSTALL.REPO b/INSTALL.REPO index e7bb3bba03..ac991f7ee2 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -91,4 +91,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/Makefile.in b/Makefile.in index d286c597af..14244eabc7 100644 --- a/Makefile.in +++ b/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . ### Commentary: diff --git a/README b/README index 527e406a63..c3cf78f04c 100644 --- a/README +++ b/README @@ -28,7 +28,7 @@ See the "Bugs" section of the Emacs manual for more information on how to report bugs. (The file 'BUGS' in this directory explains how you can find and read that section using the Info files that come with Emacs.) For a list of mailing lists related to Emacs, see -. For the complete +. For the complete list of GNU mailing lists, see . The 'etc' subdirectory contains several other files, named in capital @@ -116,4 +116,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/README b/admin/README index cb6ba85992..7906844309 100644 --- a/admin/README +++ b/admin/README @@ -78,7 +78,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: mode: outline diff --git a/admin/admin.el b/admin/admin.el index e81e7f1e7e..44d091d142 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/alloc-colors.c b/admin/alloc-colors.c index fa6a639d88..a4701dd77b 100644 --- a/admin/alloc-colors.c +++ b/admin/alloc-colors.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/admin/authors.el b/admin/authors.el index 86d42be8dc..c69ca9405c 100644 --- a/admin/authors.el +++ b/admin/authors.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/build-configs b/admin/build-configs index aa62dadc91..ac3147fe63 100755 --- a/admin/build-configs +++ b/admin/build-configs @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . require 5; @@ -97,4 +97,3 @@ # Local Variables: # mode: cperl # End: - diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 46a5e42aa7..d867c053e5 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/charsets/Makefile.in b/admin/charsets/Makefile.in index b154bc13d4..0c252ae919 100644 --- a/admin/charsets/Makefile.in +++ b/admin/charsets/Makefile.in @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . ### Commentary: diff --git a/admin/charsets/big5.awk b/admin/charsets/big5.awk index 7482d11a2d..2393f9144b 100644 --- a/admin/charsets/big5.awk +++ b/admin/charsets/big5.awk @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . BEGIN { tohex["A"] = 10; @@ -68,5 +68,3 @@ function decode_big5(big5) { code = decode_big5(big5); printf "0x%04X %s\n", code, $2; } - - diff --git a/admin/charsets/compact.awk b/admin/charsets/compact.awk index 21e03ee415..b912a0fd20 100644 --- a/admin/charsets/compact.awk +++ b/admin/charsets/compact.awk @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: # Make a charset map compact by changing this kind of line sequence: diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk index df1f8cd7b2..6aac98815b 100644 --- a/admin/charsets/cp51932.awk +++ b/admin/charsets/cp51932.awk @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: diff --git a/admin/charsets/cp932.awk b/admin/charsets/cp932.awk index acba033337..7fd3e9111f 100644 --- a/admin/charsets/cp932.awk +++ b/admin/charsets/cp932.awk @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: @@ -113,4 +113,3 @@ END { printf "0x%02X%02X 0x%04X # 4\n", i, j, code++; } } - diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk index 24152b44ef..94e27d0065 100644 --- a/admin/charsets/eucjp-ms.awk +++ b/admin/charsets/eucjp-ms.awk @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: diff --git a/admin/charsets/gb180302.awk b/admin/charsets/gb180302.awk index 4947f96637..1a6995a1cb 100644 --- a/admin/charsets/gb180302.awk +++ b/admin/charsets/gb180302.awk @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . BEGIN { tohex["A"] = 10; diff --git a/admin/charsets/gb180304.awk b/admin/charsets/gb180304.awk index 81d7e7301b..9c6522b572 100644 --- a/admin/charsets/gb180304.awk +++ b/admin/charsets/gb180304.awk @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . BEGIN { tohex["A"] = 10; diff --git a/admin/charsets/mapconv b/admin/charsets/mapconv index 5f62ff90d3..8ee3d142e7 100755 --- a/admin/charsets/mapconv +++ b/admin/charsets/mapconv @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: diff --git a/admin/charsets/mapfiles/README b/admin/charsets/mapfiles/README index f9dc2ba99f..f4fea85e8b 100644 --- a/admin/charsets/mapfiles/README +++ b/admin/charsets/mapfiles/README @@ -80,4 +80,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/charsets/mule-charsets.el b/admin/charsets/mule-charsets.el index 4ccf4bfb5b..8355af4488 100644 --- a/admin/charsets/mule-charsets.el +++ b/admin/charsets/mule-charsets.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; For the record: the old, pre-v23 code was this: @@ -67,4 +67,3 @@ (sort-lines nil (point-min) (point-max)) (let ((coding-system-for-write 'unix)) (write-file (car elt))))) - diff --git a/admin/cus-test.el b/admin/cus-test.el index 3808a44eff..a8582ac59c 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/diff-tar-files b/admin/diff-tar-files index 23df9ff192..f45d72f1a6 100755 --- a/admin/diff-tar-files +++ b/admin/diff-tar-files @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . if [ $# != 2 ]; then diff --git a/admin/find-gc.el b/admin/find-gc.el index 53ac922040..91acbb5149 100644 --- a/admin/find-gc.el +++ b/admin/find-gc.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/gitmerge.el b/admin/gitmerge.el index a0efce5ea6..0dfd190d75 100644 --- a/admin/gitmerge.el +++ b/admin/gitmerge.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index fd1d8954e5..740168fc73 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -15,7 +15,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/admin/grammars/c.by b/admin/grammars/c.by index c312fd636d..da9f967a16 100644 --- a/admin/grammars/c.by +++ b/admin/grammars/c.by @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; TODO: From Nate Schley ;; > * Can't parse signature element: "const char* const rmc_ClrTxt" diff --git a/admin/grammars/grammar.wy b/admin/grammars/grammar.wy index ffbe7cc4a9..d64dcdcbfd 100644 --- a/admin/grammars/grammar.wy +++ b/admin/grammars/grammar.wy @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . %package semantic-grammar-wy %provide semantic/grammar-wy diff --git a/admin/grammars/java-tags.wy b/admin/grammars/java-tags.wy index bbad38d23f..f1a4c147cd 100644 --- a/admin/grammars/java-tags.wy +++ b/admin/grammars/java-tags.wy @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . %package wisent-java-tags-wy %provide semantic/wisent/javat-wy diff --git a/admin/grammars/js.wy b/admin/grammars/js.wy index 72b662e179..ded8023b7f 100644 --- a/admin/grammars/js.wy +++ b/admin/grammars/js.wy @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/grammars/make.by b/admin/grammars/make.by index 0bfde31979..d3a03ead47 100644 --- a/admin/grammars/make.by +++ b/admin/grammars/make.by @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . %package semantic-make-by %provide semantic/bovine/make-by @@ -134,7 +134,7 @@ elements: element some-whitespace elements ( ,@$1 ) | ;;EMPTY ; - + element: sub-element element ( (concat (car ,$1) (car ,$2)) ) | ;;EMPTY diff --git a/admin/grammars/python.wy b/admin/grammars/python.wy index 23aa65cd7f..c8426e2581 100644 --- a/admin/grammars/python.wy +++ b/admin/grammars/python.wy @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/admin/grammars/scheme.by b/admin/grammars/scheme.by index c4d6a392f7..86fe81d185 100644 --- a/admin/grammars/scheme.by +++ b/admin/grammars/scheme.by @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . %package semantic-scm-by %provide semantic/bovine/scm-by @@ -98,4 +98,3 @@ expression : symbol ; ;;; scheme.by ends here - diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy index 811a324060..aefa4c8124 100644 --- a/admin/grammars/srecode-template.wy +++ b/admin/grammars/srecode-template.wy @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/admin/last-chance.el b/admin/last-chance.el index cab2d4718d..76b8bcf6db 100644 --- a/admin/last-chance.el +++ b/admin/last-chance.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/make-emacs b/admin/make-emacs index 4c735065e5..0938336407 100755 --- a/admin/make-emacs +++ b/admin/make-emacs @@ -17,7 +17,7 @@ # 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 . +# along with GNU Emacs. If not, see . require 5; diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index e5c77172c9..5822f666db 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -18,7 +18,7 @@ Steps to take before starting on the first pretest in any release sequence: when preparing the first pretest for a major Emacs release.) Commit cus-edit.el if changed. -3. Remove any old pretests from ftp://alpha.gnu.org/gnu/emacs/pretest. +3. Remove any old pretests from https://alpha.gnu.org/gnu/emacs/pretest. You can use 'gnupload --delete' (see below for more gnupload details). General steps (for each step, check for possible errors): @@ -101,8 +101,8 @@ General steps (for each step, check for possible errors): Check the contents of the new tar with admin/diff-tar-files against the previous release (if this is the first pretest) or the previous pretest. If you did not make the previous pretest - yourself, find it at . - Releases are of course at . + yourself, find it at . + Releases are of course at . If this is the first pretest of a major release, just comparing with the previous release may overlook many new files. You can try @@ -130,9 +130,9 @@ General steps (for each step, check for possible errors): Now you should upload the files to the GNU ftp server. In order to do that, you must be registered as an Emacs maintainer and have your GPG key acknowledged by the ftp people. For instructions, see - http://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html + https://www.gnu.org/prep/maintain/html_node/Automated-Upload-Registration.html The simplest method to upload is to use the gnulib - script "build-aux/gnupload": + script "build-aux/gnupload": For a pretest: gnupload [--user your@gpg.key.email] --to alpha.gnu.org:emacs/pretest \ @@ -161,11 +161,11 @@ General steps (for each step, check for possible errors): FILE.sig, FILE.directive.asc. For a release, place the files in the /incoming/ftp directory. For a pretest, place the files in /incoming/alpha instead, so that - they appear on ftp://alpha.gnu.org/. + they appear on https://alpha.gnu.org/. 10. After five minutes, verify that the files are visible at - ftp://alpha.gnu.org/gnu/emacs/pretest/ for a pretest, or - ftp://ftp.gnu.org/gnu/emacs/ for a release. + https://alpha.gnu.org/gnu/emacs/pretest/ for a pretest, or + https://ftp.gnu.org/gnu/emacs/ for a release. Download them and check the signatures. Check they build. @@ -185,7 +185,7 @@ UPDATING THE EMACS WEB PAGES AFTER A RELEASE As soon as possible after a release, the Emacs web pages should be updated. Anyone with write access to the Emacs code repository can do this. -For instructions, see . +For instructions, see . Changes go live more or less as soon as they are committed. The pages to update are: @@ -215,5 +215,5 @@ Add compressed copies of the main info pages from the tarfile to manual/info/. Update the refcards/pdf/ and ps/ directories, and also refcards/emacs-refcards.tar.gz (use make -C etc/refcards pdf ps dist). -Browsing is one +Browsing is one way to check for any files that still need updating. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index e7b304a264..60104e86c6 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . # written by Paul Eggert diff --git a/admin/merge-pkg-config b/admin/merge-pkg-config index 363d22dfa5..dbacb4bc30 100755 --- a/admin/merge-pkg-config +++ b/admin/merge-pkg-config @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . # written by Paul Eggert diff --git a/admin/notes/bugtracker b/admin/notes/bugtracker index 3d6df03d5e..6d0fe50ae5 100644 --- a/admin/notes/bugtracker +++ b/admin/notes/bugtracker @@ -1,6 +1,6 @@ NOTES ON THE EMACS BUG TRACKER -*- outline -*- -The Emacs Bug Tracker can be found at http://debbugs.gnu.org/ +The Emacs Bug Tracker can be found at https://debbugs.gnu.org/ * Quick-start guide @@ -33,14 +33,14 @@ tags 123 moreinfo|unreproducible|wontfix|patch * More detailed information -For a list of all bugs, see http://debbugs.gnu.org/db/pa/lemacs.html +For a list of all bugs, see https://debbugs.gnu.org/db/pa/lemacs.html This is a static page, updated once a day. There is also a dynamic list, generated on request. This accepts various options, eg to see the most recent bugs: -http://debbugs.gnu.org/cgi/pkgreport.cgi?newest=100 +https://debbugs.gnu.org/cgi/pkgreport.cgi?newest=100 -Or follow the links on the front page http://debbugs.gnu.org . +Or follow the links on the front page https://debbugs.gnu.org . ** How do I report a bug in Emacs now? The same way as you always did. Send mail to bug-gnu-emacs@gnu.org, @@ -73,7 +73,7 @@ cc everyone on replies.) (Many people think the submitter SHOULD be automatically subscribed to subsequent discussion, but this does not seem to be implemented. See http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=37078 -See also http://debbugs.gnu.org/5439 ) +See also https://debbugs.gnu.org/5439 ) Do NOT send a separate copy to the bug list address, since this may generate a new report. The only time to send mail to the bug list @@ -246,7 +246,7 @@ reopen 123 *** Bugs can be tagged in various ways (eg wontfix, patch, etc). The available tags are: patch wontfix moreinfo unreproducible fixed notabug -See http://debbugs.gnu.org/Developer#tags +See https://debbugs.gnu.org/Developer#tags The list of tags can be prefixed with +, - or =, meaning to add (the default), remove, or reset the tags. E.g.: @@ -254,7 +254,7 @@ tags 123 + wontfix ** URL shortcuts -http://debbugs.gnu.org/... +https://debbugs.gnu.org/... 123 # given bug number 123;mbox=yes # mbox version of given bug @@ -314,11 +314,11 @@ search box. The only piece you really need to add is the "users" portion, the rest has the same syntax as normal. **** To browse bugs by usertag: -http://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users +https://debbugs.gnu.org/cgi/pkgindex.cgi?indexon=users **** To find all bugs usertagged by a given email address: -http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs +https://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs (Supposedly, the "users" field can be a comma-separated list of more than one email address, but it does not seem to work for me.) @@ -328,7 +328,7 @@ than one email address, but it does not seem to work for me.) This works just like a normal tags search, but with the addition of a "users" field. Eg: -http://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs;tag=calendar +https://debbugs.gnu.org/cgi/pkgreport.cgi?users=emacs;tag=calendar *** To merge bugs: Eg when bad replies create a bunch of new bugs for the same report. @@ -377,7 +377,7 @@ You must unmerge, clone, then re-merge. *** To set severity: severity 123 critical|grave|serious|important|normal|minor|wishlist -See http://debbugs.gnu.org/Developer#severities for the meanings. +See https://debbugs.gnu.org/Developer#severities for the meanings. *** To set the owner of a bug: owner 123 A Hacker @@ -435,10 +435,10 @@ The bug will be re-archived after the next 28 day period of no activity. It's a function of the number of displayed bugs. You can speed things up by only looking at the newest 100 bugs: -http://debbugs.gnu.org/cgi-bin/pkgreport.cgi?newest=100;package=emacs +https://debbugs.gnu.org/cgi-bin/pkgreport.cgi?newest=100;package=emacs Or use the static index: -http://debbugs.gnu.org/db/ix/full.html +https://debbugs.gnu.org/db/ix/full.html ** What are those "mbox folder" links on the bug report pages? @@ -484,7 +484,7 @@ the bug web-pages. *** Debian stuff -http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html +https://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html ** Gnus-specific voodoo @@ -493,7 +493,7 @@ http://lists.gnu.org/archive/html/emacs-devel/2009-11/msg00440.html *** If the above is not available: (add-hook 'gnus-article-mode-hook (lambda () - (setq bug-reference-url-format "http://debbugs.gnu.org/%s") + (setq bug-reference-url-format "https://debbugs.gnu.org/%s") (bug-reference-mode 1))) and you can click on the bug number in the subject header. @@ -507,8 +507,8 @@ reference, you don't need to read these as a user of the system. Getting mail from the Emacs bug list into the tracker requires the assistance of sysadmin at gnu.org. The test tracker set-up was, I think, [gnu.org #359140]: -http://lists.gnu.org/archive/html/savannah-hackers/2008-03/msg00074.html -http://lists.gnu.org/archive/html/savannah-hackers/2008-04/msg00034.html +https://lists.gnu.org/archive/html/savannah-hackers/2008-03/msg00074.html +https://lists.gnu.org/archive/html/savannah-hackers/2008-04/msg00034.html ** The debbugs.gnu.org setup was handled in [gnu.org #510605]. There are two pieces (replace AT with @ in the following): @@ -548,7 +548,7 @@ It does basic spam processing on the moderator requests and automatically rejects the obviously bogus ones. Someone still has to accept the good ones though. The advantage of this would not be having to run and tune our own spam filter. See -http://savannah.nongnu.org/projects/listhelper +https://savannah.nongnu.org/projects/listhelper An "X-Debbugs-Envelope-To" header is used to keep track of where the mail was actually bound for: diff --git a/admin/notes/copyright b/admin/notes/copyright index 9b614221ca..8345646b97 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright @@ -511,7 +511,7 @@ etc/TUTORIAL* (translations) rms: "We can leave the TUTORIAL translations alone until their maintainers update them." Can adapt short license text from end of GPL translations at: - http://www.gnu.org/licenses/translations.html + https://www.gnu.org/licenses/translations.html Only a few sentences around the license notice need changing from previous version. Done: TUTORIAL.eo @@ -594,4 +594,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/notes/elpa b/admin/notes/elpa index 4c0f1980de..ea6c132fe1 100644 --- a/admin/notes/elpa +++ b/admin/notes/elpa @@ -10,7 +10,7 @@ repository named "elpa", hosted on Savannah. To check it out: Changes to this branch propagate to elpa.gnu.org via a "deployment" script run daily. This script (which is kept in elpa/admin/update-archive.sh) generates -the content visible at http://elpa.gnu.org/packages. +the content visible at https://elpa.gnu.org/packages. A new package is released as soon as the "version number" of that package is changed. So you can use 'elpa' to work on a package without fear of releasing diff --git a/admin/notes/font-backend b/admin/notes/font-backend index 2418966c93..65c37a483b 100644 --- a/admin/notes/font-backend +++ b/admin/notes/font-backend @@ -66,4 +66,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/notes/hydra b/admin/notes/hydra index 4c1944a57d..a0c46df08e 100644 --- a/admin/notes/hydra +++ b/admin/notes/hydra @@ -68,4 +68,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/notes/multi-tty b/admin/notes/multi-tty index d0096adc6d..0969daf9d0 100644 --- a/admin/notes/multi-tty +++ b/admin/notes/multi-tty @@ -1296,4 +1296,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/notes/unicode b/admin/notes/unicode index 8284e1b44c..bc7279150a 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -306,4 +306,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/notes/www b/admin/notes/www index 8e911a44d5..8e5bfb68d7 100644 --- a/admin/notes/www +++ b/admin/notes/www @@ -79,4 +79,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/admin/nt/README-UNDUMP.W32 b/admin/nt/README-UNDUMP.W32 index f421416123..aa91633dd4 100644 --- a/admin/nt/README-UNDUMP.W32 +++ b/admin/nt/README-UNDUMP.W32 @@ -7,7 +7,7 @@ This README file describes how to dump a bare precompiled version of GNU Emacs for Windows. This barebin distribution supplements the standard distribution of Emacs, which you can download from: - ftp://ftp.gnu.org/gnu/emacs/ + https://ftp.gnu.org/gnu/emacs/ If you do not have the "bin" or "src" distribution, then you will need to download one of those before you can use this barebin version. diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index 76b3c64650..8f84edee47 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -18,7 +18,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/admin/release-process b/admin/release-process index 6aa004014b..3bb72b9735 100644 --- a/admin/release-process +++ b/admin/release-process @@ -115,12 +115,12 @@ Redirect /software/emacs/manual/html_mono/automake.html /software/automake/manua Redirect /software/emacs/manual/html_node/automake/ /software/automake/manual/html_node/ Another tool you can use to check links is gnu.org's linc.py: -http://www.gnu.org/server/source/ +https://www.gnu.org/server/source/ You run this with something like: cd /path/to/cvs/emacs-www -linc.py -o /path/to/output-dir --url http://www.gnu.org/software/emacs/ . +linc.py -o /path/to/output-dir --url https://www.gnu.org/software/emacs/ . Be warned that it is really, really slow (as in, can take ~ a full day to check the manual/ directory). It is probably best to run it on a diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 5cc43bc371..c389cb3f53 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ @@ -119,4 +119,3 @@ maintainer-clean: distclean extraclean: rm -f ${top_srcdir}/src/macuvs.h ${unidir}/charscript.el* rm -f ${unifiles} ${unidir}/charprop.el - diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk index 7845d02cdc..8eafedb82c 100755 --- a/admin/unidata/blocks.awk +++ b/admin/unidata/blocks.awk @@ -17,7 +17,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: @@ -32,7 +32,7 @@ ## The Unicode blocks actually extend past some of these ranges with ## undefined codepoints. -## For additional details, see . +## For additional details, see . ## Things to do after installing a new version of Blocks.txt: ## Check the output against the old output. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 478099c831..e6e8aaa095 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/unidata/uvs.el b/admin/unidata/uvs.el index 0b7edc73c8..f254f4a366 100644 --- a/admin/unidata/uvs.el +++ b/admin/unidata/uvs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/admin/update-copyright b/admin/update-copyright index 4da327bd9c..a068816e30 100755 --- a/admin/update-copyright +++ b/admin/update-copyright @@ -22,7 +22,7 @@ # 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 . +# along with GNU Emacs. If not, see . # written by Paul Eggert diff --git a/admin/update_autogen b/admin/update_autogen index ba4ed00fa3..cfbb7c77a7 100755 --- a/admin/update_autogen +++ b/admin/update_autogen @@ -18,7 +18,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/autogen.sh b/autogen.sh index b3c5f486e9..00bdfb91d4 100755 --- a/autogen.sh +++ b/autogen.sh @@ -19,7 +19,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: @@ -210,7 +210,7 @@ If you do not have permission to do this, or if the version provided by your system is too old, it is normally straightforward to build these packages from source. You can find the sources at: -ftp://ftp.gnu.org/gnu/PACKAGE/ +https://ftp.gnu.org/gnu/PACKAGE/ Download the package (make sure you get at least the minimum version listed above), extract it using tar, then run configure, make, diff --git a/build-aux/git-hooks/commit-msg b/build-aux/git-hooks/commit-msg index 475956e551..39450865cb 100755 --- a/build-aux/git-hooks/commit-msg +++ b/build-aux/git-hooks/commit-msg @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Written by Paul Eggert. diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 0fa5837f60..68a0c33d4a 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . LC_ALL=C export LC_ALL diff --git a/build-aux/gitlog-to-emacslog b/build-aux/gitlog-to-emacslog index bced7e4986..6a58f2d4b2 100755 --- a/build-aux/gitlog-to-emacslog +++ b/build-aux/gitlog-to-emacslog @@ -17,7 +17,7 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . LC_ALL=C export LC_ALL diff --git a/build-aux/make-info-dir b/build-aux/make-info-dir index e8c66943e0..8a1d580363 100755 --- a/build-aux/make-info-dir +++ b/build-aux/make-info-dir @@ -20,7 +20,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/build-aux/msys-to-w32 b/build-aux/msys-to-w32 index 3f57478a9d..38daf56b0a 100755 --- a/build-aux/msys-to-w32 +++ b/build-aux/msys-to-w32 @@ -15,7 +15,7 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . # Take only the basename from the full pathname me=${0//*\//} diff --git a/build-aux/update-subdirs b/build-aux/update-subdirs index 90f1b3c0c6..6419758925 100755 --- a/build-aux/update-subdirs +++ b/build-aux/update-subdirs @@ -17,7 +17,7 @@ # 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 . +# along with GNU Emacs. If not, see . cd "$1" || exit 1 diff --git a/configure.ac b/configure.ac index df3931f938..1cce2107dc 100644 --- a/configure.ac +++ b/configure.ac @@ -19,7 +19,7 @@ dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the dnl GNU General Public License for more details. dnl dnl You should have received a copy of the GNU General Public License -dnl along with GNU Emacs. If not, see . +dnl along with GNU Emacs. If not, see . AC_PREREQ(2.65) dnl Note this is parsed by (at least) make-dist and lisp/cedet/ede/emacs.el. @@ -4030,7 +4030,7 @@ AC_CACHE_CHECK([for library containing tputs], [emacs_cv_tputs_lib], emacs_cv_tputs_lib='none required' else # Maybe curses should be tried earlier? - # See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35 + # See https://debbugs.gnu.org/9736#35 for tputs_library in '' tinfo ncurses terminfo termcap curses; do OLIBS=$LIBS if test -z "$tputs_library"; then @@ -5313,7 +5313,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* No code in Emacs #includes config.h twice, but some bits of code diff --git a/doc/emacs/Makefile.in b/doc/emacs/Makefile.in index ffcc4baafd..5d2503ff49 100644 --- a/doc/emacs/Makefile.in +++ b/doc/emacs/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 1f60354061..1b9a8b39a4 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -118,11 +118,11 @@ some of the ways to customize it; it corresponds to GNU Emacs version @ifset WWW_GNU_ORG @html The homepage for GNU Emacs is at -http://www.gnu.org/software/emacs/.
    +https://www.gnu.org/software/emacs/.
    To view this manual in other formats, click here.
    You can also purchase a printed copy from the -FSF store. +FSF store. @end html @end ifset @@ -1314,7 +1314,7 @@ Emacs editors, all sharing common principles of organization. For information on the underlying philosophy of Emacs and the lessons learned from its development, see @cite{Emacs, the Extensible, Customizable Self-Documenting Display Editor}, available from -@url{ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-519A.pdf}. +@url{http://hdl.handle.net/1721.1/5736}. This version of the manual is mainly intended for use with GNU Emacs installed on GNU and Unix systems. GNU Emacs can also be used on @@ -1348,7 +1348,7 @@ One way to get a copy of GNU Emacs is from someone else who has it. You need not ask for our permission to do so, or tell any one else; just copy it. If you have access to the Internet, you can get the latest distribution version of GNU Emacs by anonymous FTP; see -@url{http://www.gnu.org/software/emacs} on our website for more +@url{https://www.gnu.org/software/emacs} on our website for more information. You may also receive GNU Emacs when you buy a computer. Computer @@ -1365,19 +1365,19 @@ Software Foundation are tax deductible in the US@. If you use GNU Emacs at your workplace, please suggest that the company make a donation. To donate, see @url{https://my.fsf.org/donate/}. For other ways in which you can help, see -@url{http://www.gnu.org/help/help.html}. +@url{https://www.gnu.org/help/help.html}. @c The command view-order-manuals uses this anchor. @anchor{Printed Books} We also sell hardcopy versions of this manual and @cite{An Introduction to Programming in Emacs Lisp}, by Robert J. Chassell. -You can visit our online store at @url{http://shop.fsf.org/}. +You can visit our online store at @url{https://shop.fsf.org/}. The income from sales goes to support the foundation's purpose: the development of new free software, and improvements to our existing programs including GNU Emacs. If you need to contact the Free Software Foundation, see -@url{http://www.fsf.org/about/contact/}, or write to +@url{https://www.fsf.org/about/contact/}, or write to @display Free Software Foundation diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index ca4f223953..18f1c28571 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1817,10 +1817,9 @@ syntax: @noindent To carry out this request, Emacs uses a remote-login program such as -@command{ftp}, @command{ssh}, @command{rlogin}, or @command{telnet}. +@command{ssh}. You must always specify in the file name which method to use---for -example, @file{/ftp:@var{user}@@@var{host}:@var{filename}} uses FTP, -whereas @file{/ssh:@var{user}@@@var{host}:@var{filename}} uses +example, @file{/ssh:@var{user}@@@var{host}:@var{filename}} uses @command{ssh}. When you specify the pseudo method @var{-} in the file name, Emacs chooses the method as follows: diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi index 82e7394501..124c1fd880 100644 --- a/doc/emacs/glossary.texi +++ b/doc/emacs/glossary.texi @@ -594,7 +594,7 @@ GNU General Public License. @xref{Copying}. @item Free Software Foundation The Free Software Foundation (FSF) is a charitable foundation dedicated to promoting the development of free software (q.v.). -For more information, see @uref{http://fsf.org/, the FSF website}. +For more information, see @uref{https://fsf.org/, the FSF website}. @item Fringe On a graphical display (q.v.), there's a narrow portion of the frame @@ -650,7 +650,7 @@ GNU is a recursive acronym for GNU's Not Unix, and it refers to a Unix-compatible operating system which is free software (q.v.). @xref{Manifesto}. GNU is normally used with Linux as the kernel since Linux works better than the GNU kernel. For more information, see -@uref{http://www.gnu.org/, the GNU website}. +@uref{https://www.gnu.org/, the GNU website}. @item Graphic Character Graphic characters are those assigned pictorial images rather than diff --git a/doc/emacs/gnu.texi b/doc/emacs/gnu.texi index 78f5354437..b88fd74ca3 100644 --- a/doc/emacs/gnu.texi +++ b/doc/emacs/gnu.texi @@ -30,8 +30,8 @@ that different wording could help avoid. Footnotes added in 1993 help clarify these points. For up-to-date information about available GNU software, please see -our web site, @uref{http://www.gnu.org}. For software tasks and other -ways to contribute, see @uref{http://www.gnu.org/help}. +our web site, @uref{https://www.gnu.org}. For software tasks and other +ways to contribute, see @uref{https://www.gnu.org/help}. @end quotation @unnumberedsec What's GNU@? Gnu's Not Unix! @@ -379,7 +379,7 @@ urge people to reject the term ``intellectual property'' entirely, lest it lead others to suppose that those laws form one coherent issue. The way to be clear is to discuss patents, copyrights, and trademarks separately. See -@uref{http://www.gnu.org/philosophy/not-ipr.xhtml} for more +@uref{https://www.gnu.org/philosophy/not-ipr.xhtml} for more explanation of how this term spreads confusion and bias.} carefully (such as lawyers) say that there is no intrinsic right to intellectual property. The kinds of supposed intellectual property rights that the @@ -495,7 +495,7 @@ distinguish between ``free software'' and ``freeware''. The term ``freeware'' means software you are free to redistribute, but usually you are not free to study and change the source code, so most of it is not free software. See -@uref{http://www.gnu.org/philosophy/words-to-avoid.html} for more +@uref{https://www.gnu.org/philosophy/words-to-avoid.html} for more explanation.}, asking for donations from satisfied users, or selling hand-holding services. I have met people who are already working this way successfully. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 460ced0d21..9ef33dd4cf 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -642,7 +642,7 @@ Display information about where to get external packages @item C-h C-f Display the Emacs frequently-answered-questions list (@code{view-emacs-FAQ}). @item C-h g -Visit a @uref{http://www.gnu.org} page with information about the GNU +Visit a @uref{https://www.gnu.org} page with information about the GNU Project (@code{describe-gnu-project}). @item C-h C-m Display information about ordering printed copies of Emacs manuals diff --git a/doc/emacs/trouble.texi b/doc/emacs/trouble.texi index ee3fc49130..a029aaa2d4 100644 --- a/doc/emacs/trouble.texi +++ b/doc/emacs/trouble.texi @@ -491,7 +491,7 @@ are suggestions for workarounds and solutions. @cindex bug tracker @item -The GNU Bug Tracker at @url{http://debbugs.gnu.org}. Emacs bugs are +The GNU Bug Tracker at @url{https://debbugs.gnu.org}. Emacs bugs are filed in the tracker under the @samp{emacs} package. The tracker records information about the status of each bug, the initial bug report, and the follow-up messages by the bug reporter and Emacs @@ -690,7 +690,7 @@ and send it to that address. Or you can simply send an email to that address describing the problem. Your report will be sent to the @samp{bug-gnu-emacs} mailing list, and -stored in the GNU Bug Tracker at @url{http://debbugs.gnu.org}. Please +stored in the GNU Bug Tracker at @url{https://debbugs.gnu.org}. Please include a valid reply email address, in case we need to ask you for more information about your report. Submissions are moderated, so there may be a delay before your report appears. @@ -1084,7 +1084,7 @@ improvement they bring about. For a fix for an existing bug, it is best to reply to the relevant discussion on the @samp{bug-gnu-emacs} list, or the bug entry in the GNU Bug Tracker at -@url{http://debbugs.gnu.org}. Explain why your change fixes the bug. +@url{https://debbugs.gnu.org}. Explain why your change fixes the bug. @item For a new feature, include a description of the feature and your @@ -1176,7 +1176,7 @@ documentation, i.e., Texinfo files. @xref{Change Log}, @ifset WWW_GNU_ORG see -@url{http://www.gnu.org/prep/standards/html_node/Change-Log-Concepts.html}, +@url{https://www.gnu.org/prep/standards/html_node/Change-Log-Concepts.html}, @end ifset @xref{Change Log Concepts, Change Log Concepts, Change Log Concepts, standards, GNU Coding Standards}. @@ -1223,11 +1223,11 @@ repository (@pxref{Sending Patches}). @item check if existing bug reports are fixed in newer versions of Emacs -@url{http://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}. +@url{https://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}. @item fix existing bug reports -@url{http://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}. +@url{https://debbugs.gnu.org/cgi/pkgreport.cgi?which=pkg&data=emacs}. @item @c etc/TODO not in WWW_GNU_ORG @@ -1274,7 +1274,7 @@ require a copyright assignment to the FSF; @xref{Copyright Assignment}. The development version of Emacs can be downloaded from the repository where it is actively maintained by a group of developers. See the Emacs project page -@url{http://savannah.gnu.org/projects/emacs/} for access details. +@url{https://savannah.gnu.org/projects/emacs/} for access details. It is important to write your patch based on the current working version. If you start from an older version, your patch may be @@ -1296,7 +1296,7 @@ desired change), refer to: @ifset WWW_GNU_ORG @ifhtml the Emacs Manual -@url{http://www.gnu.org/software/emacs/manual/emacs.html}. +@url{https://www.gnu.org/software/emacs/manual/emacs.html}. @end ifhtml @ifnothtml @xref{Top, Emacs Manual,,emacs}. @@ -1310,7 +1310,7 @@ the Emacs Manual @ifset WWW_GNU_ORG @ifhtml the Emacs Lisp Reference Manual -@url{http://www.gnu.org/software/emacs/manual/elisp.html}. +@url{https://www.gnu.org/software/emacs/manual/elisp.html}. @end ifhtml @ifnothtml @xref{Top, Emacs Lisp Reference Manual,,elisp}. @@ -1321,7 +1321,7 @@ the Emacs Lisp Reference Manual @end ifclear @item -@url{http://www.gnu.org/software/emacs} +@url{https://www.gnu.org/software/emacs} @item @url{http://www.emacswiki.org/} @@ -1337,7 +1337,7 @@ the Emacs Lisp Reference Manual @cindex coding standards Contributed code should follow the GNU Coding Standards -@url{http://www.gnu.org/prep/standards/}. This may also be available +@url{https://www.gnu.org/prep/standards/}. This may also be available in info on your system. If it doesn't, we'll need to find someone to fix the code before we @@ -1350,7 +1350,7 @@ Emacs has additional style and coding conventions: @ifset WWW_GNU_ORG @ifhtml the ``Tips and Conventions'' Appendix in the Emacs Lisp Reference -@url{http://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html}. +@url{https://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html}. @end ifhtml @ifnothtml @xref{Tips, ``Tips and Conventions'' Appendix in the Emacs Lisp Reference, Tips @@ -1385,11 +1385,11 @@ Use @code{?\s} instead of @code{? } in Lisp code for a space character. The FSF (Free Software Foundation) is the copyright holder for GNU Emacs. The FSF is a nonprofit with a worldwide mission to promote computer user freedom and to defend the rights of all free software users. -For general information, see the website @url{http://www.fsf.org/}. +For general information, see the website @url{https://www.fsf.org/}. Generally speaking, for non-trivial contributions to GNU Emacs we require that the copyright be assigned to the FSF@. For the reasons -behind this, see @url{http://www.gnu.org/licenses/why-assign.html}. +behind this, see @url{https://www.gnu.org/licenses/why-assign.html}. Copyright assignment is a simple process. Residents of some countries can do it entirely electronically. We can help you get started, and @@ -1434,7 +1434,7 @@ mailing list and newsgroup interconnect, so it does not matter which one you use.) @item -Look in the @uref{http://www.fsf.org/resources/service/, service +Look in the @uref{https://www.fsf.org/resources/service/, service directory} for someone who might help you for a fee. @end itemize diff --git a/doc/lispintro/Makefile.in b/doc/lispintro/Makefile.in index d8e203fd06..065a718f70 100644 --- a/doc/lispintro/Makefile.in +++ b/doc/lispintro/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/doc/lispintro/README b/doc/lispintro/README index f8134fce80..18a39703dc 100644 --- a/doc/lispintro/README +++ b/doc/lispintro/README @@ -42,4 +42,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/doc/lispintro/cons-1.eps b/doc/lispintro/cons-1.eps index 1d4e78cb73..fe3e6d2ad5 100644 --- a/doc/lispintro/cons-1.eps +++ b/doc/lispintro/cons-1.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/cons-2.eps b/doc/lispintro/cons-2.eps index af59a0fd7d..a9838b4b49 100644 --- a/doc/lispintro/cons-2.eps +++ b/doc/lispintro/cons-2.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/cons-2a.eps b/doc/lispintro/cons-2a.eps index 2edcc21beb..f5a048f307 100644 --- a/doc/lispintro/cons-2a.eps +++ b/doc/lispintro/cons-2a.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/cons-3.eps b/doc/lispintro/cons-3.eps index f7e37f16f9..5557367625 100644 --- a/doc/lispintro/cons-3.eps +++ b/doc/lispintro/cons-3.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/cons-4.eps b/doc/lispintro/cons-4.eps index f9549b9511..86c3cfc2d1 100644 --- a/doc/lispintro/cons-4.eps +++ b/doc/lispintro/cons-4.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/cons-5.eps b/doc/lispintro/cons-5.eps index 83f14df6d2..e66cff4df1 100644 --- a/doc/lispintro/cons-5.eps +++ b/doc/lispintro/cons-5.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/drawers.eps b/doc/lispintro/drawers.eps index b9efdceb55..97a581bb39 100644 --- a/doc/lispintro/drawers.eps +++ b/doc/lispintro/drawers.eps @@ -24,7 +24,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 53 dict def tgifdict begin @@ -223,7 +223,7 @@ NP GS 0 /Courier FF [17 0 0 -17 0 0] MS - (symbol name) TGSW + (symbol name) TGSW AD GR 2 DI NE 0 RM @@ -243,7 +243,7 @@ NP GS 0 /Courier FF [17 0 0 -17 0 0] MS - (Chest of Drawers) TGSW + (Chest of Drawers) TGSW AD GR 2 DI NE 0 RM @@ -342,7 +342,7 @@ NP GS 0 /NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS - (directions to) TGSW + (directions to) TGSW AD GR 2 DI NE 0 RM @@ -388,7 +388,7 @@ NP GS 0 /Courier FF [17 0 0 -17 0 0] MS - (symbol definition) TGSW + (symbol definition) TGSW AD GR 2 DI NE 0 RM @@ -408,7 +408,7 @@ NP GS 0 /NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS - (directions to) TGSW + (directions to) TGSW AD GR 2 DI NE 0 RM @@ -428,7 +428,7 @@ NP GS 0 /Courier FF [17 0 0 -17 0 0] MS - (variable name) TGSW + (variable name) TGSW AD GR 2 DI NE 0 RM @@ -448,7 +448,7 @@ NP GS 0 /NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS - (directions to) TGSW + (directions to) TGSW AD GR 2 DI NE 0 RM @@ -468,7 +468,7 @@ NP GS 0 /Courier FF [17 0 0 -17 0 0] MS - (property list) TGSW + (property list) TGSW AD GR 2 DI NE 0 RM @@ -488,7 +488,7 @@ NP GS 0 /NewCenturySchlbk-Roman FF [17 0 0 -17 0 0] MS - (directions to) TGSW + (directions to) TGSW AD GR 2 DI NE 0 RM diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 36d767737d..d9493879b1 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -120,7 +120,7 @@ Foundation, Inc. @iftex Published by the:@* -GNU Press, @hfill @uref{http://www.fsf.org/licensing/gnu-press/}@* +GNU Press, @hfill @uref{https://www.fsf.org/licensing/gnu-press/}@* a division of the @hfill email: @email{sales@@fsf.org}@* Free Software Foundation, Inc. @hfill Tel: +1 (617) 542-5942@* 51 Franklin Street, Fifth Floor @hfill Fax: +1 (617) 542-2652@* @@ -128,10 +128,10 @@ Boston, MA 02110-1301 USA @end iftex @ifnottex -Printed copies available from @uref{http://shop.fsf.org/}. Published by: +Printed copies available from @uref{https://shop.fsf.org/}. Published by: @example -GNU Press, http://www.fsf.org/licensing/gnu-press/ +GNU Press, https://www.fsf.org/licensing/gnu-press/ a division of the email: sales@@fsf.org Free Software Foundation, Inc. Tel: +1 (617) 542-5942 51 Franklin Street, Fifth Floor Fax: +1 (617) 542-2652 @@ -208,7 +208,7 @@ supports it in developing GNU and promoting software freedom.'' @ifset WWW_GNU_ORG @html

    The homepage for GNU Emacs is at -http://www.gnu.org/software/emacs/.
    +https://www.gnu.org/software/emacs/.
    To view this manual in other formats, click here. @end html @@ -12059,7 +12059,7 @@ For more information, see @ref{Indicating, , Indicating, texinfo, Texinfo Manual}, which goes to a Texinfo manual in the current directory. Or, if you are on the Internet, see -@uref{http://www.gnu.org/software/texinfo/manual/texinfo/} +@uref{https://www.gnu.org/software/texinfo/manual/texinfo/} @end ifhtml @iftex ``Indicating Definitions, Commands, etc.''@: in @cite{Texinfo, The GNU @@ -21658,8 +21658,8 @@ can ill afford to lose manuals this way. Free documentation, like free software, is a matter of freedom, not price. The problem with these manuals was not that O'Reilly Associates charged a price for printed copies---that in itself is fine. The Free -Software Foundation @uref{http://shop.fsf.org, sells printed copies} of -free @uref{http://www.gnu.org/doc/doc.html, GNU manuals}, too. +Software Foundation @uref{https://shop.fsf.org, sells printed copies} of +free @uref{https://www.gnu.org/doc/doc.html, GNU manuals}, too. But GNU manuals are available in source code form, while these manuals are available only on paper. GNU manuals come with permission to copy and modify; the Perl manuals do not. These restrictions are the @@ -21738,7 +21738,7 @@ copylefted manuals to non-copylefted ones. @noindent Note: The Free Software Foundation maintains a page on its Web site that lists free books available from other publishers:@* -@uref{http://www.gnu.org/doc/other-free-books.html} +@uref{https://www.gnu.org/doc/other-free-books.html} @node GNU Free Documentation License @appendix GNU Free Documentation License diff --git a/doc/lispintro/lambda-1.eps b/doc/lispintro/lambda-1.eps index 47370b24b9..e349b20d36 100644 --- a/doc/lispintro/lambda-1.eps +++ b/doc/lispintro/lambda-1.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/lambda-2.eps b/doc/lispintro/lambda-2.eps index 804dbfbd6f..7be38da95e 100644 --- a/doc/lispintro/lambda-2.eps +++ b/doc/lispintro/lambda-2.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispintro/lambda-3.eps b/doc/lispintro/lambda-3.eps index 95610f692f..a3b419a9e8 100644 --- a/doc/lispintro/lambda-3.eps +++ b/doc/lispintro/lambda-3.eps @@ -19,7 +19,7 @@ % 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 . +% along with GNU Emacs. If not, see . /tgifdict 132 dict def tgifdict begin diff --git a/doc/lispref/Makefile.in b/doc/lispref/Makefile.in index 89eb81093d..9fa5901a1a 100644 --- a/doc/lispref/Makefile.in +++ b/doc/lispref/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/doc/lispref/README b/doc/lispref/README index fbc3169cee..b3f450a129 100644 --- a/doc/lispref/README +++ b/doc/lispref/README @@ -18,7 +18,7 @@ or for HTML. * You can buy nicely printed copies from the Free Software Foundation. Buying a manual from the Free Software Foundation helps support our GNU -development work. See . +development work. See . (At time of writing, this manual is out of print.) * The master file for formatting this manual for Tex is called 'elisp.texi'. @@ -45,4 +45,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 38f4f92e65..1dbc0bbb5b 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5338,7 +5338,7 @@ hint to ImageMagick to help it detect the image type. Specifies a rotation angle in degrees. @item :index @var{frame} -@c Doesn't work: http://debbugs.gnu.org/7978 +@c Doesn't work: https://debbugs.gnu.org/7978 @xref{Multi-Frame Images}. @end table diff --git a/doc/lispref/doclicense.texi b/doc/lispref/doclicense.texi index 9c3bbe56e9..542edaad25 100644 --- a/doc/lispref/doclicense.texi +++ b/doc/lispref/doclicense.texi @@ -6,7 +6,7 @@ @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. -@uref{http://fsf.org/} +@uref{https://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -414,7 +414,7 @@ The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See -@uref{http://www.gnu.org/copyleft/}. +@uref{https://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered version of this diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index da72c9b700..cebf0a3af3 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -244,7 +244,7 @@ least for a certain distance. @item S Stop: don't execute any more of the program, but wait for more Edebug commands (@code{edebug-stop}). -@c FIXME Does not work. http://debbugs.gnu.org/9764 +@c FIXME Does not work. https://debbugs.gnu.org/9764 @item @key{SPC} Step: stop at the next stop point encountered (@code{edebug-step-mode}). @@ -1139,7 +1139,7 @@ definition, but specifications are much more general than macro arguments. @xref{Defining Macros}, for more explanation of the @code{declare} form. -@c See, e.g., http://debbugs.gnu.org/10577 +@c See, e.g., https://debbugs.gnu.org/10577 @c FIXME Maybe there should be an Edebug option to get it to @c automatically load the entire source file containing the function @c being instrumented. That would avoid this. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index b1399cdbd1..4cbcdf855d 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -159,7 +159,7 @@ Cover art by Etienne Suvasa. @ifset WWW_GNU_ORG @html

    The homepage for GNU Emacs is at -http://www.gnu.org/software/emacs/.
    +https://www.gnu.org/software/emacs/.
    For information on using Emacs, refer to the Emacs Manual.
    To view this manual in other formats, click diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 89dee84784..afd44b7dfe 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -57,7 +57,7 @@ including @code{beginning-of-line}, @code{forward-word}, @code{forward-sentence}, and @code{forward-paragraph}, stop at the boundary between the prompt and the actual text. -@c See http://debbugs.gnu.org/11276 +@c See https://debbugs.gnu.org/11276 The minibuffer's window is normally a single line; it grows automatically if the contents require more space. Whilst it is active, you can explicitly resize it temporarily with the window diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 039201feca..41d2d84ecd 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -212,7 +212,7 @@ emacs, GNU Emacs Manual}. Unlike @code{find-file-literally}, finding a file as @samp{raw-text} doesn't disable format conversion, uncompression, or auto mode selection. -@c See http://debbugs.gnu.org/11226 for lack of unibyte tooltip. +@c See https://debbugs.gnu.org/11226 for lack of unibyte tooltip. @vindex enable-multibyte-characters The buffer-local variable @code{enable-multibyte-characters} is non-@code{nil} in multibyte buffers, and @code{nil} in unibyte ones. diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi index af05d1ef58..153ee48741 100644 --- a/doc/lispref/package.texi +++ b/doc/lispref/package.texi @@ -275,7 +275,7 @@ variable @code{load-file-name} (@pxref{Loading}). Here is an example: Via the Package Menu, users may download packages from @dfn{package archives}. Such archives are specified by the variable @code{package-archives}, whose default value contains a single entry: -the archive hosted by the GNU project at @url{http://elpa.gnu.org}. This +the archive hosted by the GNU project at @url{https://elpa.gnu.org}. This section describes how to set up and maintain a package archive. @cindex base location, package archive diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 45e04a5ab8..a1e8730f71 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2331,7 +2331,7 @@ server is stopped; a non-@code{nil} value means yes. Emacs can create encrypted network connections, using either built-in or external support. The built-in support uses the GnuTLS Transport Layer Security Library; see -@uref{http://www.gnu.org/software/gnutls/, the GnuTLS project page}. +@uref{https://www.gnu.org/software/gnutls/, the GnuTLS project page}. If your Emacs was compiled with GnuTLS support, the function @code{gnutls-available-p} is defined and returns non-@code{nil}. For more details, @pxref{Top,, Overview, emacs-gnutls, The Emacs-GnuTLS manual}. diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi index 67d4c22464..23879aad0a 100644 --- a/doc/lispref/searching.texi +++ b/doc/lispref/searching.texi @@ -950,7 +950,7 @@ for Font Lock mode@footnote{Note that @code{regexp-opt} does not guarantee that its result is absolutely the most efficient form possible. A hand-tuned regular expression can sometimes be slightly more efficient, but is almost never worth the effort.}. -@c E.g., see http://debbugs.gnu.org/2816 +@c E.g., see https://debbugs.gnu.org/2816 The optional argument @var{paren} can be any of the following: @@ -1220,7 +1220,7 @@ previous character cannot be part of a match for @var{regexp}. When the match is extended, its starting position is allowed to occur before @var{limit}. -@c http://debbugs.gnu.org/5689 +@c https://debbugs.gnu.org/5689 As a general recommendation, try to avoid using @code{looking-back} wherever possible, since it is slow. For this reason, there are no plans to add a @code{looking-back-p} function. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index b825b1d790..a7d10797cd 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4803,7 +4803,7 @@ would be: @lisp (dom-attr img 'href) -=> "http://fsf.org/logo.png" +=> "https://fsf.org/logo.png" @end lisp @item dom-children @var{node} diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index 35abd8e79d..bed3bed95b 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -741,7 +741,7 @@ preceded by @samp{URL}. For example, @smallexample The home page for the GNU project has more information (see URL -`http://www.gnu.org/'). +`https://www.gnu.org/'). @end smallexample @item @@ -944,7 +944,7 @@ explains these conventions, starting with an example: ;; This file is free software@dots{} @dots{} -;; along with this file. If not, see . +;; along with this file. If not, see . @end group @end smallexample @@ -966,7 +966,7 @@ might need to list them instead. Do not say that the copyright holder is the Free Software Foundation (or that the file is part of GNU Emacs) unless your file has been accepted into the Emacs distribution. For more information on the form of copyright and license notices, see -@uref{http://www.gnu.org/licenses/gpl-howto.html, the guide on the GNU +@uref{https://www.gnu.org/licenses/gpl-howto.html, the guide on the GNU website}. After the copyright notice come several @dfn{header comment} lines, diff --git a/doc/lispref/two-volume-cross-refs.txt b/doc/lispref/two-volume-cross-refs.txt index 78133e945f..6b129668ea 100644 --- a/doc/lispref/two-volume-cross-refs.txt +++ b/doc/lispref/two-volume-cross-refs.txt @@ -316,4 +316,4 @@ 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 this file. If not, see . +along with this file. If not, see . diff --git a/doc/lispref/two-volume.make b/doc/lispref/two-volume.make index a797750c0f..15f9649725 100644 --- a/doc/lispref/two-volume.make +++ b/doc/lispref/two-volume.make @@ -232,4 +232,4 @@ elisp2-init: elisp.texi # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see . +# along with this file. If not, see . diff --git a/doc/man/emacs.1.in b/doc/man/emacs.1.in index 5d0948f51b..0e905b7d83 100644 --- a/doc/man/emacs.1.in +++ b/doc/man/emacs.1.in @@ -546,7 +546,7 @@ is the number of color planes. .SH MANUALS You can order printed copies of the GNU Emacs Manual from the Free Software Foundation, which develops GNU software. -See the online store at . +See the online store at . .br Your local administrator might also have copies available. As with all software and publications from FSF, everyone is permitted @@ -597,10 +597,10 @@ Do not expect a personal answer to a bug report. The purpose of reporting bugs is to get them fixed for everyone in the next release, if possible. For personal assistance, consult the service directory at - for a list of people who offer it. + for a list of people who offer it. Please do not send anything but bug reports to this mailing list. -For other Emacs lists, see . +For other Emacs lists, see . . . .SH UNRESTRICTIONS diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 8ff823200a..a60fb0b0a7 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index 507a048da5..1f1f13afee 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -581,7 +581,7 @@ specify that @kbd{M-x quickurl} should insert @var{URL} if the word @var{key} is at point, for example: @example -(("FSF" "http://www.fsf.org/" "The Free Software Foundation") +(("FSF" "https://www.fsf.org/" "The Free Software Foundation") ("emacs" . "http://www.emacs.org/") ("hagbard" "http://www.hagbard.demon.co.uk" "Hagbard's World")) @end example diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index 7bd060189c..e4e7330ba0 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -35751,7 +35751,7 @@ to work on these, please send a message (using @kbd{M-x report-calc-bug}) so any efforts can be coordinated. The latest version of Calc is available from Savannah, in the Emacs -repository. See @uref{http://savannah.gnu.org/projects/emacs}. +repository. See @uref{https://savannah.gnu.org/projects/emacs}. @c [summary] @node Summary, Key Index, Reporting Bugs, Top diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index f9ba5cc392..c90f6d06bf 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -198,7 +198,7 @@ modify this GNU manual.'' @insertcopying This manual was generated from cc-mode.texi, which is distributed with Emacs, -or can be downloaded from @url{http://savannah.gnu.org/projects/emacs/}. +or can be downloaded from @url{https://savannah.gnu.org/projects/emacs/}. @end titlepage @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -7396,7 +7396,7 @@ Emacs Lisp code that triggers the bug and include it in your report. @cindex bug report mailing list Reporting a bug using @code{c-submit-bug-report} files it in -the GNU Bug Tracker at @url{http://debbugs.gnu.org}, then sends it on +the GNU Bug Tracker at @url{https://debbugs.gnu.org}, then sends it on to @email{bug-cc-mode@@gnu.org}. You can also send reports, other questions, and suggestions (kudos?@: @t{;-)} to that address. It's a mailing list which you can join or browse an archive of; see the web site at diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 33b4858a45..b7ae7fec2d 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1207,7 +1207,7 @@ must have a well-defined value outside the @code{cl-letf} body. There is essentially only one exception to this, which is @var{place} a plain variable with a specified @var{value} (such as @code{(a 17)} in the above example). -@c See http://debbugs.gnu.org/12758 +@c See https://debbugs.gnu.org/12758 @c Some or all of this was true for cl.el, but not for cl-lib.el. @ignore The only exceptions are plain variables and calls to @@ -1389,7 +1389,7 @@ treated like a @code{cl-letf} or @code{cl-letf*}. This differs from true Common Lisp, where the rules of lexical scoping cause a @code{let} binding to shadow a @code{symbol-macrolet} binding. In this package, such shadowing does not occur, even when @code{lexical-binding} is -@c See http://debbugs.gnu.org/12119 +@c See https://debbugs.gnu.org/12119 @code{t}. (This behavior predates the addition of lexical binding to Emacs Lisp, and may change in future to respect @code{lexical-binding}.) At present in this package, only @code{lexical-let} and @@ -3326,7 +3326,7 @@ the first sequence. This function is more general than the Emacs primitive @code{mapc}. (Note that this function is called @code{cl-mapc} even in @file{cl.el}, rather than @code{mapc*} as you might expect.) -@c http://debbugs.gnu.org/6575 +@c https://debbugs.gnu.org/6575 @end defun @defun cl-mapl function list &rest more-lists diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi index bb548c991c..4ebcbea6a0 100644 --- a/doc/misc/efaq-w32.texi +++ b/doc/misc/efaq-w32.texi @@ -164,7 +164,7 @@ instructions (requires DJGPP). @cindex Emacs source code @cindex source for Emacs You can download Emacs releases from -@uref{http://ftpmirror.gnu.org/emacs/, ftp.gnu.org mirrors}. They +@uref{https://ftpmirror.gnu.org/emacs/, ftp.gnu.org mirrors}. They are distributed as compressed tar files, digitally signed by the maintainer who made the release. @@ -181,7 +181,7 @@ to give it a try. @xref{Compiling}. @cindex latest development version of Emacs @cindex Emacs Development The development version of Emacs is available from -@uref{http://savannah.gnu.org/projects/emacs, Savannah}, the GNU +@uref{https://savannah.gnu.org/projects/emacs, Savannah}, the GNU development site. @node Compiling @@ -581,7 +581,7 @@ update your registry (you may need to reboot). Shane Holder gives some background on how "Scancode Map" is used by the system: @ignore -http://ftp.gnu.org/old-gnu/emacs/windows/docs/ntemacs/contrib/caps-ctrl-registry.txt +https://ftp.gnu.org/old-gnu/emacs/windows/docs/ntemacs/contrib/caps-ctrl-registry.txt From: Shane Holder To: ntemacs-users@@cs.washington.edu Date: 04 Dec 1996 14:36:21 -0600 @@ -913,7 +913,7 @@ Fonts in Emacs 22 and earlier are named using the X Logical Font Description (XLFD) format. Emacs on Windows ignores many of the fields, and populates them with * when listing fonts. Former maintainer Andrew Innes wrote -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/x-font-details, +@uref{https://www.gnu.org/software/emacs/windows/ntemacs/discuss/x-font-details, this explanation} of what each field in the font string means and how Emacs treated them back in 19.34. Since then, multilingual support and a redisplay overhaul to support variable width fonts have changed things @@ -1060,7 +1060,7 @@ support packages of various components of Windows itself, GNU/Linux distributions these days come with a number of Free truetype fonts that cover a wide range of languages. The GNU Unifont project contains glyphs for most of the Unicode codespace, and can be -downloaded from @uref{http://ftpmirror.gnu.org/unifont, ftp.gnu.org +downloaded from @uref{https://ftpmirror.gnu.org/unifont, ftp.gnu.org mirrors}. @node Third-party multibyte @@ -1136,7 +1136,7 @@ There are a number of methods by which you can control automatic CR/LF translation in Emacs, a situation that reflects the fact that the default support was not very robust in the past. For a discussion of this issue, take a look at -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/translate, +@uref{https://www.gnu.org/software/emacs/windows/ntemacs/todo/translate, this collection of email messages} on the topic. @menu @@ -1339,7 +1339,7 @@ When an EOF is sent to a subprocess running in an interactive shell with @code{process-send-eof}, the shell terminates unexpectedly as if its input was closed. This affects the use of @kbd{C-c C-d} in shell buffers. See -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/todo/shell-ctrl-d, +@uref{https://www.gnu.org/software/emacs/windows/ntemacs/todo/shell-ctrl-d, this discussion} for more details. @node Using shell @@ -1752,7 +1752,7 @@ AUCTeX is an Emacs package for writing LaTeX files, which also includes preview-latex, an Emacs mode for previewing the formatted contents of LaTeX documents. Pre-compiled versions for Windows are available from -@uref{http://www.gnu.org/software/auctex/download-for-windows.html, the +@uref{https://www.gnu.org/software/auctex/download-for-windows.html, the AUCTeX site}. @node Spell check @@ -2096,7 +2096,7 @@ code in lib/perl5db.pl @end example Doug Campbell also has some -@uref{http://www.gnu.org/software/emacs/windows/ntemacs/discuss/perldb, +@uref{https://www.gnu.org/software/emacs/windows/ntemacs/discuss/perldb, suggestions} for improving the interaction of perldb and Emacs. @c ------------------------------------------------------------ @@ -2272,8 +2272,8 @@ In Emacs, you can browse the manual using Info by typing @kbd{C-h r}, and you can view the FAQ by typing @kbd{C-h C-f}. Other resources include: @itemize -@item @uref{http://www.gnu.org/software/emacs/, The Emacs homepage} -@item @uref{http://www.gnu.org/software/emacs/manual/, Other Emacs manuals} +@item @uref{https://www.gnu.org/software/emacs/, The Emacs homepage} +@item @uref{https://www.gnu.org/software/emacs/manual/, Other Emacs manuals} @item @uref{http://www.emacswiki.org/, Emacs Wiki} @end itemize diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 8d107e05e4..a8ece771fc 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -393,7 +393,7 @@ recipients the same freedom that you enjoyed. @cindex GNU mailing lists The Emacs mailing lists are described at -@uref{http://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah +@uref{https://savannah.gnu.org/mail/?group=emacs, the Emacs Savannah page}. Some of them are gatewayed to newsgroups. The newsgroup @uref{news:comp.emacs} is for discussion of Emacs programs @@ -421,8 +421,7 @@ posting bug reports to this newsgroup directly (@pxref{Reporting bugs}). The FSF has maintained archives of all of the GNU mailing lists for many years, although there may be some unintentional gaps in coverage. The archive can be browsed over the web at -@uref{http://lists.gnu.org/archive/html/, the GNU mail archive}. Raw -files can be downloaded from @uref{ftp://lists.gnu.org/}. +@uref{http://lists.gnu.org/archive/html/, the GNU mail archive}. Web-based Usenet search services, such as @uref{http://groups.google.com/groups/dir?q=gnu&, Google}, also @@ -506,12 +505,12 @@ unsubscribe. @cindex Free Software Foundation, contacting For up-to-date information, see -@uref{http://www.fsf.org/about/contact.html, the FSF contact web-page}. +@uref{https://www.fsf.org/about/contact.html, the FSF contact web-page}. You can send general correspondence to @email{info@@fsf.org}. @cindex Ordering GNU software For details on how to order items directly from the FSF, see the -@uref{http://shop.fsf.org/, FSF on-line store}. +@uref{https://shop.fsf.org/, FSF on-line store}. @c ------------------------------------------------------------ @node Getting help @@ -645,7 +644,7 @@ information. To get a list of these commands, type @samp{?} after @cindex Emacs manual, obtaining a printed or HTML copy of You can order a printed copy of the Emacs manual from the FSF@. For -details see the @uref{http://shop.fsf.org/, FSF on-line store}. +details see the @uref{https://shop.fsf.org/, FSF on-line store}. The full Texinfo source for the manual also comes in the @file{doc/emacs} directory of the Emacs distribution, if you're daring enough to try to @@ -655,7 +654,7 @@ file}). If you absolutely have to print your own copy, and you don't have @TeX{}, you can get a PostScript or PDF (or HTML) version from -@uref{http://www.gnu.org/software/emacs/manual/} +@uref{https://www.gnu.org/software/emacs/manual/} @xref{Learning how to do something}, for how to view the manual from Emacs. @@ -675,12 +674,12 @@ in Info format (@pxref{Top, Emacs Lisp,, elisp, The Emacs Lisp Reference Manual}). You can also order a hardcopy of the manual from the FSF, for details -see the @uref{http://shop.fsf.org/, FSF on-line store}. (This manual is +see the @uref{https://shop.fsf.org/, FSF on-line store}. (This manual is not always in print.) An HTML version of the Emacs Lisp Reference Manual is available at -@uref{http://www.gnu.org/software/emacs/elisp-manual/elisp.html} +@uref{https://www.gnu.org/software/emacs/elisp-manual/elisp.html} @node Installing Texinfo documentation @section How do I install a piece of Texinfo documentation? @@ -699,7 +698,7 @@ First, you must turn the Texinfo source files into Info files. You may do this using the stand-alone @file{makeinfo} program, available as part of the Texinfo package at -@uref{http://www.gnu.org/software/texinfo/} +@uref{https://www.gnu.org/software/texinfo/} For information about the Texinfo format, read the Texinfo manual which comes with the Texinfo package. This manual also comes installed in @@ -893,7 +892,7 @@ Emacs news, a history of recent user-visible changes More GNU information, including back issues of the @cite{GNU's Bulletin}, are at -@uref{http://www.gnu.org/bulletins/bulletins.html} and +@uref{https://www.gnu.org/bulletins/bulletins.html} and @uref{http://www.cs.pdx.edu/~trent/gnu/gnu.html} @@ -905,7 +904,7 @@ Bulletin}, are at @xref{Installing Emacs}, for some basic installation hints, and see @ref{Problems building Emacs}, if you have problems with the installation. -@uref{http://www.fsf.org/resources/service/, The GNU Service directory} +@uref{https://www.fsf.org/resources/service/, The GNU Service directory} lists companies and individuals willing to sell you help in installing or using Emacs and other GNU software. @@ -983,7 +982,7 @@ version; three components indicate a development version (e.g., @samp{26.0.50} is what will eventually become @samp{26.1}). Emacs is under active development, hosted at -@uref{http://savannah.gnu.org/projects/emacs/, Savannah}. +@uref{https://savannah.gnu.org/projects/emacs/, Savannah}. Follow the instructions given there to clone the project repository. Because Emacs undergoes many changes before a release, the version @@ -2490,7 +2489,7 @@ following in your @file{.emacs}: If you're tired of seeing backup files whenever you do an @samp{ls} at the Unix shell, try GNU @code{ls} with the @samp{-B} option. GNU @code{ls} is part of the GNU Fileutils package, available from -@samp{ftp.gnu.org} and its mirrors (@pxref{Current GNU distributions}). +@url{https://ftp.gnu.org} and its mirrors (@pxref{Current GNU distributions}). To disable or change the way backups are made, @pxref{Backup Names,,, emacs, The GNU Emacs Manual}. @@ -3293,11 +3292,11 @@ the source distribution. In brief: @item First download the Emacs sources. @xref{Current GNU distributions}, for -a list of ftp sites that make them available. On @file{ftp.gnu.org}, +a list of sites that make them available. On @url{https://ftp.gnu.org}, the main GNU distribution site, sources are available as @c Don't include VER in the file name, because pretests are not there. -@uref{ftp://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz} +@uref{https://ftp.gnu.org/pub/gnu/emacs/emacs-VERSION.tar.gz} (Replace @samp{VERSION} with the relevant version number, e.g., @samp{23.1}.) @@ -3305,7 +3304,7 @@ the main GNU distribution site, sources are available as Next uncompress and extract the source files. This requires the @code{gzip} and @code{tar} programs, which are standard utilities. If your system does not have them, these can also be downloaded from -@file{ftp.gnu.org}. +@url{https://ftp.gnu.org}. GNU @code{tar} can uncompress and extract in a single-step: @@ -3383,7 +3382,7 @@ problem (@pxref{Reporting bugs}). @cindex Downloading Emacs Information on downloading Emacs is available at -@uref{http://www.gnu.org/software/emacs/, the Emacs home-page}. +@uref{https://www.gnu.org/software/emacs/, the Emacs home-page}. @xref{Installing Emacs}, for information on how to obtain and build the latest version of Emacs, and see @ref{Current GNU distributions}, for a list of @@ -3426,7 +3425,7 @@ see @ref{Packages that do not come with Emacs}. The easiest way to add more features to your Emacs is to use the command @kbd{M-x list-packages}. This contacts the -@uref{http:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'') +@uref{https:///elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'') server and fetches the list of additional packages that it offers. These are GNU packages that are available for use with Emacs, but are distributed separately from Emacs itself, for reasons of space, etc. @@ -3498,11 +3497,11 @@ Various spell-checkers are compatible with Emacs, including: The most up-to-date official GNU software is normally kept at -@uref{ftp://ftp.gnu.org/pub/gnu} +@uref{https://ftp.gnu.org/pub/gnu} A list of sites mirroring @samp{ftp.gnu.org} can be found at -@uref{http://www.gnu.org/order/ftp.html} +@uref{httpss://www.gnu.org/prep/ftp} @node Difference between Emacs and XEmacs @section What is the difference between Emacs and XEmacs (formerly Lucid Emacs)? @@ -3548,7 +3547,7 @@ binary typically has a size of about 130 kbytes, so this can be useful if you are in an extremely space-restricted environment. More information is available from -@uref{http://www.gnu.org/software/zile/} +@uref{https://www.gnu.org/software/zile/} @node Emacs for MS-DOS @@ -3566,10 +3565,10 @@ onwards, including Windows XP and Vista. The file @file{etc/PROBLEMS} contains some additional information regarding Emacs under MS-DOS. -A pre-built binary distribution of the old Emacs 20 is available, as +A pre-built binary distribution of the old Emacs 24 is available, as described at -@uref{ftp://ftp.delorie.com/pub/djgpp/current/v2gnu/emacs.README} +@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README} For a list of other MS-DOS implementations of Emacs (and Emacs look-alikes), consult the list of ``Emacs implementations and literature,'' @@ -4203,7 +4202,7 @@ Arabic, Farsi, and Hebrew, since version 24.1. First, download and install the BDF font files and any auxiliary packages they need. The GNU Intlfonts distribution can be found on -@uref{http://directory.fsf.org/localization/intlfonts.html, the GNU +@uref{https://directory.fsf.org/localization/intlfonts.html, the GNU Software Directory Web site}. Next, if you are on X Window system, issue the following two commands diff --git a/doc/misc/emacs-gnutls.texi b/doc/misc/emacs-gnutls.texi index 87165631bf..0ad48b0b9e 100644 --- a/doc/misc/emacs-gnutls.texi +++ b/doc/misc/emacs-gnutls.texi @@ -113,7 +113,7 @@ The @code{gnutls-algorithm-priority} variable sets the GnuTLS priority string. This is global, not per host name (although @code{gnutls-negotiate} supports a priority string per connection so it could be done if needed). The priority string syntax is in the -@uref{http://www.gnu.org/software/gnutls/documentation.html, GnuTLS +@uref{https://www.gnu.org/software/gnutls/documentation.html, GnuTLS documentation}. @end defvar diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index e38ead079a..b391a88c32 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -875,7 +875,7 @@ decided to include ERC in Emacs. ERC 5.1 was released. It was subsequently included in Emacs 22. ERC became an official GNU project, and development moved to -@uref{http://sv.gnu.org/projects/erc}. We switched to using GNU Arch as +@uref{https://sv.gnu.org/projects/erc}. We switched to using GNU Arch as our revision control system. Our mailing list address changed as well. @item 2007 diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 45797ce359..b75ca0a7b0 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -167,8 +167,8 @@ package system might not be up to date (e.g., Gnus 5.9 bundled with Emacs 21 is outdated). You can get the latest released version of Gnus from @uref{http://www.gnus.org/dist/gnus.tar.gz} -or via anonymous FTP from -@uref{ftp://ftp.gnus.org/pub/gnus/gnus.tar.gz}. +or from +@uref{https://ftp.gnus.org/pub/gnus/gnus.tar.gz}. @node FAQ 1-4 @subsubheading Question 1.4 @@ -1522,7 +1522,7 @@ Gimp), open the image you want to include, cut out the relevant part, reduce color depth to 1 bit, resize to 48*48 and save as bitmap. Now you should get the compface package from -@uref{ftp://ftp.cs.indiana.edu:/pub/faces/, this site}. +@uref{ftp://ftp.cs.indiana.edu/pub/faces/, this site}. and create the actual X-face by saying @example diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el index c7d41c8555..b6e8862f96 100644 --- a/doc/misc/gnus-news.el +++ b/doc/misc/gnus-news.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -51,7 +51,7 @@ 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 . +along with GNU Emacs. If not, see . \nLocal variables:\nmode: outline paragraph-separate: \"[ ]*$\"\nend:\n") diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index be7e7ac71a..94c2a79a2d 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -143,7 +143,7 @@ with a WWW browser with @kbd{K H}. @xref{MIME Commands}. @item International host names (@acronym{IDNA}) can now be decoded inside article bodies using @kbd{W i} (@code{gnus-summary-idna-message}). This requires that GNU Libidn -(@url{http://www.gnu.org/software/libidn/}) has been installed. +(@url{https://www.gnu.org/software/libidn/}) has been installed. @c FIXME: Also mention @code{message-use-idna}? @item The non-@acronym{ASCII} group names handling has been much diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index b002f5dea7..88e121a07b 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -8970,7 +8970,7 @@ Decode IDNA encoded domain names in the current articles. IDNA encoded domain names looks like @samp{xn--bar}. If a string remain unencoded after running invoking this, it is likely an invalid IDNA string (@samp{xn--bar} is invalid). You must have GNU Libidn -(@url{http://www.gnu.org/software/libidn/}) installed for this command +(@url{https://www.gnu.org/software/libidn/}) installed for this command to work. @item W t @@ -9186,7 +9186,7 @@ Verify a signed control message hierarchy maintainer. You need to add the @acronym{PGP} public key of the maintainer to your keyring to verify the message.@footnote{@acronym{PGP} keys for many hierarchies are -available at @uref{ftp://ftp.isc.org/pub/pgpcontrol/README.html}} +available at @uref{https://ftp.isc.org/pub/pgpcontrol/README.html}} @item W s @kindex W s (Summary) @@ -12320,7 +12320,7 @@ This variable controls whether Gnus performs IDNA decoding of internationalized domain names inside @samp{From}, @samp{To} and @samp{Cc} headers. @xref{IDNA, ,IDNA,message, The Message Manual}, for how to compose such messages. This requires -@uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this +@uref{https://www.gnu.org/software/libidn/, GNU Libidn}, and this variable is only enabled if you have installed it. @vindex gnus-inhibit-images @@ -13860,7 +13860,7 @@ The same as the above, but don't do automatic @acronym{STARTTLS} upgrades. @findex nntp-open-tls-stream @item nntp-open-tls-stream Opens a connection to a server over a @dfn{secure} channel. To use -this you must have @uref{http://www.gnu.org/software/gnutls/, GnuTLS} +this you must have @uref{https://www.gnu.org/software/gnutls/, GnuTLS} installed. You then define a server as follows: @lisp diff --git a/doc/misc/message.texi b/doc/misc/message.texi index bbdef4a862..829986e220 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -925,7 +925,7 @@ invoke @kbd{M-x message-idna-to-ascii-rhs RET} in the message buffer to have the non-@acronym{ASCII} domain names encoded while you edit the message. -Note that you must have @uref{http://www.gnu.org/software/libidn/, GNU +Note that you must have @uref{https://www.gnu.org/software/libidn/, GNU Libidn} installed in order to use this functionality. @node Security diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 3aa04caf86..0fb6e6ce5d 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -237,7 +237,7 @@ read a built-in tutorial by starting GNU Emacs and typing @kbd{C-h t} @ref{Top, , GNU Emacs Manual, emacs, GNU Emacs Manual}, @end ifinfo @ifhtml -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/, @cite{GNU Emacs Manual}}, @end ifhtml from the Free Software Foundation. @@ -386,7 +386,7 @@ GNU Emacs Manual}. @end ifnothtml @ifhtml See section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Easy-Customization.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Easy-Customization.html, Easy Customization} in @cite{The GNU Emacs Manual}. @end ifhtml @xref{Options}. @@ -406,7 +406,7 @@ GNU Emacs Manual}. @end ifnothtml @ifhtml See section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Face-Customization.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Face-Customization.html, Face Customization} in @cite{The GNU Emacs Manual}. @end ifhtml @@ -424,7 +424,7 @@ Emacs Manual} @end ifnothtml @ifhtml See section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Hooks.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Hooks.html, Hooks} in @cite{The GNU Emacs Manual} @end ifhtml for a description about @dfn{normal hooks} and @dfn{abnormal hooks}. @@ -475,7 +475,7 @@ point. @end ifnothtml @ifhtml See the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html, Completion} in @cite{The GNU Emacs Manual}. @end ifhtml Note that @key{SPC} cannot be used for completing filenames and @@ -1123,17 +1123,17 @@ exist, @footnote{The @cite{GNU Emacs Lisp Reference Manual} should be available via the Info system by typing @kbd{C-h i m Emacs Lisp @key{RET}}. It is also available online at @* -@uref{http://www.gnu.org/software/emacs/manual/elisp.html}.} +@uref{https://www.gnu.org/software/emacs/manual/elisp.html}.} @end iftex @ifinfo @footnote{@xref{Top, The GNU Emacs Lisp Reference Manual, , elisp, GNU Emacs Lisp Reference Manual}, which should be available via the Info system. It is also available online at -@uref{http://www.gnu.org/software/emacs/manual/elisp.html}.} +@uref{https://www.gnu.org/software/emacs/manual/elisp.html}.} @end ifinfo @ifhtml @footnote{The -@uref{http://www.gnu.org/software/emacs/manual/elisp.html, +@uref{https://www.gnu.org/software/emacs/manual/elisp.html, The GNU Emacs Lisp Reference Manual} should be available via the Info system by typing @kbd{C-h i m Emacs Lisp @key{RET}}.} @end ifhtml @@ -1298,7 +1298,7 @@ When you choose a folder in MH-E via a command such as @kbd{o} @end ifnothtml @ifhtml (see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Completion.html, Completion} in @cite{The GNU Emacs Manual}). @end ifhtml In addition, MH-E has several ways of choosing a suitable default so @@ -2112,7 +2112,7 @@ display of this field requires the @command{uncompface} program}. Recent versions of XEmacs have internal support for @samp{X-Face:} images. If your version of XEmacs does not, then you'll need both @command{uncompface} and the -@uref{ftp://ftp.jpl.org/pub/elisp/, @samp{x-face} package}.}. MH-E +@uref{http://www.jpl.org/ftp/pub/elisp/, @samp{x-face} package}.}. MH-E renders the foreground and background of the image using the associated attributes of the face @code{mh-show-xface}. @@ -2126,7 +2126,7 @@ associated attributes of the face @code{mh-show-xface}. Finally, MH-E will display images referenced by the @samp{X-Image-URL:} header field if neither the @samp{Face:} nor the @samp{X-Face:} fields are present@footnote{The display of the images -requires the @uref{http://www.gnu.org/software/wget/wget.html, +requires the @uref{https://www.gnu.org/software/wget/wget.html, @command{wget} program} to fetch the image and the @command{convert} program from the @uref{http://www.imagemagick.org/script/index.php, ImageMagick suite}.}. Of the three header fields this is the most @@ -2856,7 +2856,7 @@ See @cite{The PGG Manual}. @end ifinfo @ifhtml See -@uref{http://www.gnu.org/software/emacs/manual/pgg.html, +@uref{https://www.gnu.org/software/emacs/manual/pgg.html, @cite{The PGG Manual}}. @end ifhtml @@ -5623,7 +5623,7 @@ See @cite{The PGG Manual}. @end ifinfo @ifhtml See -@uref{http://www.gnu.org/software/emacs/manual/pgg.html, +@uref{https://www.gnu.org/software/emacs/manual/pgg.html, @cite{The PGG Manual}}. @end ifhtml @@ -6032,7 +6032,7 @@ GNU Emacs Manual}). @end ifnothtml @ifhtml (see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, Syntax of Regular Expressions} in @cite{The GNU Emacs Manual}). @end ifhtml @@ -6182,7 +6182,7 @@ GNU Emacs Manual}). @end ifnothtml @ifhtml (see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, Syntax of Regular Expressions} in @cite{The GNU Emacs Manual}). @end ifhtml @@ -6290,7 +6290,7 @@ You can also use the speedbar @end ifnothtml @ifhtml (see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Speedbar.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Speedbar.html, Speedbar Frames} in @cite{The GNU Emacs Manual}) @end ifhtml to view your folders. To bring up the speedbar, run @kbd{M-x speedbar @@ -6422,7 +6422,7 @@ For a description of the menu bar, please @end ifnothtml @ifhtml see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Menu-Bar.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Menu-Bar.html, The Menu Bar} in @cite{The GNU Emacs Manual}. @end ifhtml @@ -6444,7 +6444,7 @@ tool bar, please @end ifnothtml @ifhtml see the section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Tool-Bars.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Tool-Bars.html, Tool Bars} in @cite{The GNU Emacs Manual}. @end ifhtml @@ -8226,7 +8226,7 @@ GNU Emacs Manual}. @end ifnothtml @ifhtml section -@uref{http://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, +@uref{https://www.gnu.org/software/emacs/manual/html_node/emacs/Regexps.html, Syntax of Regular Expressions} in @cite{The GNU Emacs Manual}. @end ifhtml diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 44fcb94f97..ca57501f3d 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -3601,7 +3601,7 @@ A link should be enclosed in double brackets and may contain a descriptive text to be displayed instead of the URL (@pxref{Link format}), for example: @example -[[http://www.gnu.org/software/emacs/][GNU Emacs]] +[[https://www.gnu.org/software/emacs/][GNU Emacs]] @end example @noindent @@ -3713,7 +3713,7 @@ current session are part of the history for this prompt, so you can access them with @key{up} and @key{down} (or @kbd{M-p/n}). @b{Completion support}@* Completion with @key{TAB} will help you to insert -valid link prefixes like @samp{http:} or @samp{ftp:}, including the prefixes +valid link prefixes like @samp{https:}, including the prefixes defined through link abbreviations (@pxref{Link abbreviations}). If you press @key{RET} after inserting only the @var{prefix}, Org will offer specific completion support for some link types@footnote{This works if diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index dfe0ecceba..e7eef9eba2 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -31,8 +31,8 @@ Con@TeX{}t @include emacsver.texi @set VERSION @value{EMACSVER} -@set AUCTEXSITE @uref{http://www.gnu.org/software/auctex/,@AUCTeX{} web site} -@set MAINTAINERSITE @uref{http://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page} +@set AUCTEXSITE @uref{https://www.gnu.org/software/auctex/,@AUCTeX{} web site} +@set MAINTAINERSITE @uref{https://www.gnu.org/software/auctex/reftex.html,@RefTeX{} web page} @set MAINTAINERCONTACT @uref{mailto:auctex-devel@@gnu.org,contact the maintainers} @set MAINTAINER the @AUCTeX{} project @set SUPPORTADDRESS @AUCTeX{} user mailing list (@email{auctex@@gnu.org}) diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index 824945856a..e45ec0616f 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -290,7 +290,7 @@ and @code{plain} for no encryption. Use of any form of TLS/SSL requires support in Emacs. You can either use the built-in support (in Emacs 24.1 and later), or the @file{starttls.el} Lisp library. The built-in support uses the GnuTLS -@footnote{@url{http://www.gnu.org/software/gnutls/}} library. +@footnote{@url{https://www.gnu.org/software/gnutls/}} library. If your Emacs has GnuTLS support built-in, the function @code{gnutls-available-p} is defined and returns non-@code{nil}. Otherwise, you must use the @file{starttls.el} library (see that file for @@ -300,7 +300,7 @@ requires one of the following external tools to be installed: @enumerate @item The GnuTLS command line tool @samp{gnutls-cli}, which you can get from -@url{http://www.gnu.org/software/gnutls/}. This is the recommended +@url{https://www.gnu.org/software/gnutls/}. This is the recommended tool, mainly because it can verify server certificates. @item diff --git a/doc/misc/url.texi b/doc/misc/url.texi index a3c625edce..e98fab4e01 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -112,11 +112,11 @@ technically obsolete despite its widespread vernacular usage.) meaning. For example, the URI @example -http://www.gnu.org/software/emacs/ +https://www.gnu.org/software/emacs/ @end example @noindent -specifies the scheme component @samp{http}, the hostname component +specifies the scheme component @samp{https}, the hostname component @samp{www.gnu.org}, and the path component @samp{/software/emacs/}. @cindex parsed URIs diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index 7b926e109a..fa12f9c35a 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -1290,7 +1290,7 @@ inelegantly, then please @enumerate @item try the latest version of @file{woman.el} from the Emacs repository -on @uref{http://savannah.gnu.org/projects/emacs/}. If it still fails, please +on @uref{https://savannah.gnu.org/projects/emacs/}. If it still fails, please @item use @kbd{M-x report-emacs-bug} to send a bug report. diff --git a/etc/CALC-NEWS b/etc/CALC-NEWS index 844b976734..95189398b0 100644 --- a/etc/CALC-NEWS +++ b/etc/CALC-NEWS @@ -1167,7 +1167,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/CENSORSHIP b/etc/CENSORSHIP index a276331c57..cd779e4915 100644 --- a/etc/CENSORSHIP +++ b/etc/CENSORSHIP @@ -5,4 +5,4 @@ Note added March 2014: This file is obsolete and will be removed in future. Please update any references to use - + diff --git a/etc/COPYING b/etc/COPYING index 94a9ed024d..e60008693e 100644 --- a/etc/COPYING +++ b/etc/COPYING @@ -1,7 +1,7 @@ GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 - Copyright (C) 2007 Free Software Foundation, Inc. + Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @@ -645,7 +645,7 @@ the "copyright" line and a pointer to where the full notice is found. GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. @@ -664,11 +664,11 @@ might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see -. +. The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read -. +. diff --git a/etc/DEBUG b/etc/DEBUG index d7d6a0d238..f5efbe0ff9 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -677,7 +677,7 @@ procedure: ** If Emacs causes errors or memory leaks in your X server You can trace the traffic between Emacs and your X server with a tool -like xmon, available at ftp://ftp.x.org/contrib/devel_tools/. +like xmon. Xmon can be used to see exactly what Emacs sends when X protocol errors happen. If Emacs causes the X server memory usage to increase you can @@ -951,7 +951,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/DISTRIB b/etc/DISTRIB index 7e3a3517f1..d7d01dbd1a 100644 --- a/etc/DISTRIB +++ b/etc/DISTRIB @@ -26,9 +26,9 @@ are designed to make sure that everyone who has a copy of GNU Emacs change it. For information on how to get GNU software, see -http://www.gnu.org/software/software.html. Printed copies of GNU +https://www.gnu.org/software/software.html. Printed copies of GNU manuals, including the Emacs manual, are available from the FSF's -online store at http://shop.fsf.org. +online store at https://shop.fsf.org. Emacs has been run on GNU/Linux, FreeBSD, NetBSD, OpenBSD, and on many Unix systems, on a variety of types of CPU, as well as on MS-DOS, @@ -41,7 +41,7 @@ License for full details, in the file 'COPYING' in this directory (see above)), and neither I nor the Free Software Foundation promises any kind of support or assistance to users. The foundation keeps a list of people who are willing to offer support and assistance for hire. -See http://www.gnu.org/help/gethelp.html. +See https://www.gnu.org/help/gethelp.html. However, we plan to continue to improve GNU Emacs and keep it reliable, so please send us any complaints and suggestions you have. @@ -93,4 +93,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index b140e44630..cee32816f6 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -313,8 +313,8 @@ This makes it easier to find modules by name. appear in the version of ERC that is bundled with Emacs 22. These extras files may be found at: - o http://ftp.gnu.org/gnu/erc/erc-5.2-extras.tar.gz, or - o http://ftp.gnu.org/gnu/erc/erc-5.2-extras.zip. + o https://ftp.gnu.org/gnu/erc/erc-5.2-extras.tar.gz, or + o https://ftp.gnu.org/gnu/erc/erc-5.2-extras.zip. ** Renamed files @@ -1343,4 +1343,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/ETAGS.EBNF b/etc/ETAGS.EBNF index fc20b9f858..5928cea3ba 100644 --- a/etc/ETAGS.EBNF +++ b/etc/ETAGS.EBNF @@ -109,4 +109,4 @@ COPYING PERMISSIONS: GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . diff --git a/etc/ETAGS.README b/etc/ETAGS.README index f14a102057..62965a4c51 100644 --- a/etc/ETAGS.README +++ b/etc/ETAGS.README @@ -44,4 +44,4 @@ 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 this program. If not, see . +along with this program. If not, see . diff --git a/etc/FTP b/etc/FTP index 2fcfa22c55..ebd2695da1 100644 --- a/etc/FTP +++ b/etc/FTP @@ -1,8 +1,8 @@ For information about how to download GNU Emacs, please see: - + For general GNU software downloading, please see - + Note added January 2014: This file is obsolete and will be removed in future. diff --git a/etc/GNUS-NEWS b/etc/GNUS-NEWS index 546686b8e6..0196e61d98 100644 --- a/etc/GNUS-NEWS +++ b/etc/GNUS-NEWS @@ -102,7 +102,7 @@ are not reused when you select another article. *Note Sticky Articles::. ** International host names (IDNA) can now be decoded inside article bodies using 'W i' ('gnus-summary-idna-message'). This requires that GNU Libidn -() has been installed. +() has been installed. ** The non-ASCII group names handling has been much improved. The back ends that fully support non-ASCII group names are now 'nntp', 'nnml', and @@ -307,7 +307,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/HELLO b/etc/HELLO index f5339f224d..ceaff7e3fc 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -90,7 +90,7 @@ 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 . +along with GNU Emacs. If not, see . ;;; Local Variables: ;;; tab-width: 32 diff --git a/etc/HISTORY b/etc/HISTORY index 301ba33b97..095e6cb914 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -3,7 +3,7 @@ For more details about release contents, see the NEWS* files. Most of the development history of GNU Emacs is available in its -source code repository . +source code repository . However, in the early days GNU Emacs was developed without using version control systems and was published via half-inch 9-track 1600-bpi magnetic tape reels. Although information about this early @@ -228,4 +228,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/LINUX-GNU b/etc/LINUX-GNU index 9e1c1a513a..0f45e15ac1 100644 --- a/etc/LINUX-GNU +++ b/etc/LINUX-GNU @@ -5,4 +5,4 @@ Note added March 2014: This file is obsolete and will be removed in future. Please update any references to use - + diff --git a/etc/MACHINES b/etc/MACHINES index 95073e0da5..49befca3fc 100644 --- a/etc/MACHINES +++ b/etc/MACHINES @@ -40,7 +40,7 @@ the list at the end of this file. these systems relate to the GNU project, because that will help spread the GNU idea that software should be free--and thus encourage people to write more free software. For more information, see - . + . *** 64-bit GNU/Linux @@ -127,4 +127,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/MH-E-NEWS b/etc/MH-E-NEWS index 6e1f4db1ed..6b1b66e80c 100644 --- a/etc/MH-E-NEWS +++ b/etc/MH-E-NEWS @@ -380,7 +380,7 @@ gatewayed at gmane.org (closes SF #979308). If you want to see the release notes for the alpha and beta releases leading up this release, please see: - http://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup + https://cvs.savannah.gnu.org/viewvc/emacs/emacs/etc/MH-E-NEWS?revision=1.25&view=markup @@ -2363,7 +2363,7 @@ new customization variables `mh-show-use-xface-flag' and `mh-x-face-file' (closes SF #480770). MH-E depends on the external x-face package found in -ftp://ftp.jpl.org/pub/elisp/ to do this. The `uncompface' binary is +http://www.jpl.org/pub/elisp/ to do this. The `uncompface' binary is also required to be in the execute PATH. It can be obtained from: http://freshmeat.net/redir/compface/1439/url_tgz/compface-1.4.tar.gz. @@ -3394,7 +3394,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS b/etc/NEWS index b49cf70e2a..315af5addc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1857,7 +1857,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.1-17 b/etc/NEWS.1-17 index 0a7ca052d7..b956442c39 100644 --- a/etc/NEWS.1-17 +++ b/etc/NEWS.1-17 @@ -2524,7 +2524,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.18 b/etc/NEWS.18 index 93e07df806..b26e132b0d 100644 --- a/etc/NEWS.18 +++ b/etc/NEWS.18 @@ -1614,7 +1614,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.19 b/etc/NEWS.19 index 70f8673534..955dcfbdd4 100644 --- a/etc/NEWS.19 +++ b/etc/NEWS.19 @@ -614,7 +614,7 @@ be different. It is generally recommended to use `system-configuration' rather than `system-type'. -See for more about this. +See for more about this. ** The functions shell-command and dired-call-process now run file name handlers for default-directory, if it has them. @@ -6533,7 +6533,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.20 b/etc/NEWS.20 index 3e829d1a16..572ae5b428 100644 --- a/etc/NEWS.20 +++ b/etc/NEWS.20 @@ -4506,7 +4506,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.21 b/etc/NEWS.21 index 9574a5d1df..eebacf857e 100644 --- a/etc/NEWS.21 +++ b/etc/NEWS.21 @@ -4893,7 +4893,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.22 b/etc/NEWS.22 index 689eff9c85..6426a9dbd8 100644 --- a/etc/NEWS.22 +++ b/etc/NEWS.22 @@ -5598,7 +5598,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.23 b/etc/NEWS.23 index 78802d288d..84b840912a 100644 --- a/etc/NEWS.23 +++ b/etc/NEWS.23 @@ -2558,7 +2558,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.24 b/etc/NEWS.24 index fc52ffffd6..4c26f47c15 100644 --- a/etc/NEWS.24 +++ b/etc/NEWS.24 @@ -2542,7 +2542,7 @@ automatically select it. ** An Emacs Lisp package manager is now included. This is a convenient way to download and install additional packages, -from a package repository at http://elpa.gnu.org. +from a package repository at https://elpa.gnu.org. *** M-x list-packages shows a list of packages, which can be selected for installation. @@ -3853,7 +3853,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEWS.25 b/etc/NEWS.25 index be04b5fcdc..5201a300e0 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -1097,7 +1097,7 @@ be added to the archive. Emacs is compiled with file notification support. *** 'auto-revert-use-notify' is set to nil in 'global-auto-revert-mode'. -See . +See . ** File Notifications @@ -1813,7 +1813,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index d3e4828f89..f657e04ae1 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -310,4 +310,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/NXML-NEWS b/etc/NXML-NEWS index edf7c13742..751ed374a7 100644 --- a/etc/NXML-NEWS +++ b/etc/NXML-NEWS @@ -220,4 +220,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index ff1000e78e..bb1a4008a7 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -640,7 +640,7 @@ where local file =emacs.html= is referenced. For most folks this file does not exist. Thus the new behavior is to generate this HTML link instead: -: emacs#List Buffers +: emacs#List Buffers All emacs related info links are similarly translated plus few other =gnu.org= manuals. @@ -1675,7 +1675,7 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p *** ~ox-texinfo.el~ by Jonathan Leech-Pepin - =ox-texinfo.el= allows you to export Org files to [[http://www.gnu.org/software/texinfo/][Texinfo]] files. + =ox-texinfo.el= allows you to export Org files to [[https://www.gnu.org/software/texinfo/][Texinfo]] files. ** New packages in contrib @@ -1728,7 +1728,7 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p *** ~ox-groff.el~ by Luis Anaya and Nicolas Goaziou - The [[http://www.gnu.org/software/groff/][groff]] (GNU troff) software is a typesetting package which reads + The [[https://www.gnu.org/software/groff/][groff]] (GNU troff) software is a typesetting package which reads plain text mixed with formatting commands and produces formatted output. @@ -2408,7 +2408,7 @@ You can now add the Org ELPA repository like this: #+END_SRC It contains both the =org-*.tar= package (the core Org distribution, also -available through http://elpa.gnu.org) and the =org-plus*.tar= package (the +available through https://elpa.gnu.org) and the =org-plus*.tar= package (the extended Org distribution, with non-GNU packages from the =contrib/= directory.) @@ -2436,7 +2436,7 @@ See http://orgmode.org/elpa/ *** =org-eshell.el= by Konrad Hinsen is now in Org - =org-eshell.el= allows you to create links from [[http://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]]. + =org-eshell.el= allows you to create links from [[https://www.gnu.org/software/emacs/manual/html_node/eshell/index.html][Eshell]]. *** Support for execution of Scala code blocks (see ob-scala.el) *** Support for execution of IO code blocks (see ob-io.el) @@ -3036,7 +3036,7 @@ that Calc formulas can operate on them. =org-export-html-scripts= is now a variable, so that you can adapt the code and the license to your needs. - See http://www.gnu.org/philosophy/javascript-trap.html for + See https://www.gnu.org/philosophy/javascript-trap.html for explanations on why these changes were necessary. * Version 7.8.11 @@ -3821,4 +3821,4 @@ that Calc formulas can operate on them. 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 . + along with GNU Emacs. If not, see . diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 713e44fcef..f8f1a362bf 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -120,8 +120,8 @@ load-path. This version of GCC is buggy: see - http://debbugs.gnu.org/6031 - http://gcc.gnu.org/bugzilla/show_bug.cgi?id=43904 + https://debbugs.gnu.org/6031 + https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43904 You can work around this error in gcc-4.5 by omitting sibling call optimization. To do this, configure Emacs with @@ -166,7 +166,7 @@ untar it :-). ** Emacs can crash when displaying PNG images with transparency. This is due to a bug introduced in ImageMagick 6.8.2-3. The bug should -be fixed in ImageMagick 6.8.3-10. See . +be fixed in ImageMagick 6.8.3-10. See . ** Crashes when displaying GIF images in Emacs built with version libungif-4.1.0 are resolved by using version libungif-4.1.0b1. @@ -634,7 +634,7 @@ can cause this error. Remove that file, execute 'ispell-kill-ispell' in Emacs, and then try spell-checking again. *** TLS problems, e.g., Gnus hangs when fetching via imaps -http://debbugs.gnu.org/24247 +https://debbugs.gnu.org/24247 gnutls-cli 3.5.3 (2016-08-09) does not generate a "- Handshake was completed" message that tls.el relies upon, causing affected Emacs @@ -671,9 +671,10 @@ problem by installing additional fonts. The intlfonts distribution includes a full spectrum of fonts that can display all the characters Emacs supports. The etl-unicode collection -of fonts (available from ) includes -fonts that can display many Unicode characters; they can also be used -by ps-print and ps-mule to print Unicode characters. +of fonts (available from +) includes fonts that +can display many Unicode characters; they can also be used by ps-print +and ps-mule to print Unicode characters. ** Under X, some characters appear improperly aligned in their lines. @@ -1063,9 +1064,9 @@ reported to refuse such attempts and snap back to the width needed to show the full menu bar (wmii) or at least cause the screen to flicker during such resizing attempts (i3, IceWM). -See also http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15700, -http://debbugs.gnu.org/cgi/bugreport.cgi?bug=22000, -http://debbugs.gnu.org/cgi/bugreport.cgi?bug=22898 and +See also https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15700, +https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22000, +https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22898 and http://lists.gnu.org/archive/html/emacs-devel/2016-07/msg00154.html. *** Metacity: Resizing Emacs or ALT-Tab causes X to be unresponsive. @@ -1743,7 +1744,7 @@ global-font-lock-mode RET" or by customizing the variable 'global-font-lock-mode'. ** Unexpected characters inserted into the buffer when you start Emacs. -See e.g. +See e.g. This can happen when you start Emacs in -nw mode in an Xterm. For example, in the *scratch* buffer, you might see something like: @@ -1782,7 +1783,7 @@ exec 2> >(exec cat >&2 2>/dev/null) exec ssh "$@" *** GNU/Linux: Truncated svn annotate output with SSH. -http://debbugs.gnu.org/7791 +https://debbugs.gnu.org/7791 The symptoms are: you are accessing a svn repository over SSH. You use vc-annotate on a large (several thousand line) file, and the @@ -2757,7 +2758,7 @@ Compiling the lisp files fails at random places, complaining: "No rule to make target '/path/to/some/lisp.elc'". The causes of this problem are not understood. Using GNU make 3.81 compiled from source, rather than the Ubuntu version, worked. -See , . +See , . ** Dumping @@ -2927,20 +2928,6 @@ release was reported to work without problems. It worked OK on another system with Solaris 8 using apparently the same 5.0 compiler and the default CFLAGS. -**** Solaris 2.x: Emacs dumps core when built with Motif. - -The Solaris Motif libraries are buggy, at least up through Solaris 2.5.1. -Install the current Motif runtime library patch appropriate for your host. -(Make sure the patch is current; some older patch versions still have the bug.) -You should install the other patches recommended by Sun for your host, too. -You can obtain Sun patches from ftp://sunsolve.sun.com/pub/patches/; -look for files with names ending in '.PatchReport' to see which patches -are currently recommended for your host. - -On Solaris 2.6, Emacs is said to work with Motif when Solaris patch -105284-12 is installed, but fail when 105284-15 is installed. -105284-18 might fix it again. - **** Solaris 2.6 and 7: the Compose key does not work. This is a bug in Motif in Solaris. Supposedly it has been fixed for @@ -3201,7 +3188,7 @@ 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 . +along with GNU Emacs. If not, see . Local variables: diff --git a/etc/TERMS b/etc/TERMS index 52379724c7..0b558a6a84 100644 --- a/etc/TERMS +++ b/etc/TERMS @@ -245,4 +245,4 @@ COPYING PERMISSIONS: GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . diff --git a/etc/THE-GNU-PROJECT b/etc/THE-GNU-PROJECT index ece9aa6d88..d2aa15565e 100644 --- a/etc/THE-GNU-PROJECT +++ b/etc/THE-GNU-PROJECT @@ -5,4 +5,4 @@ Note added March 2014: This file is obsolete and will be removed in future. Please update any references to use - + diff --git a/etc/TODO b/etc/TODO index af2f41bf96..278c0b5036 100644 --- a/etc/TODO +++ b/etc/TODO @@ -21,7 +21,7 @@ answers), at the emacs-devel@gnu.org mailing list. For more information about getting involved, see the CONTRIBUTE file. As well as the issues listed here, there are bug reports at -. Bugs tagged "easy" ought to be suitable for +. Bugs tagged "easy" ought to be suitable for beginners to work on, but unfortunately we are not very good at using this tag. Bugs tagged "help" are ones where assistance is required, but may be difficult to fix. Bugs with severity "important" or higher @@ -345,7 +345,7 @@ scroll bars are extensible. ** Program Enriched mode to read and save in RTF. [Is there actually a decent single definition of RTF? Maybe see info at http://latex2rtf.sourceforge.net/.] This task seems to be addressed - by http://savannah.nongnu.org/projects/emacs-rtf/, which is still in + by https://savannah.nongnu.org/projects/emacs-rtf/, which is still in very early stages. Another place to look is the Wikipedia article at @@ -824,7 +824,7 @@ of unique features. **** Existing packages Note that there is a generic UI test named frame-test.el, see -http://debbugs.gnu.org/21415#284 . +https://debbugs.gnu.org/21415#284 . The NS interface passes this, with the exception of two toolbar-related errors. **** Anders frame test @@ -872,9 +872,9 @@ of the two patches, Emacs responds that s-9 was pressed. More investigation is needed to fix this problem. Links: -- http://debbugs.gnu.org/19977 -- http://debbugs.gnu.org/21330 -- http://debbugs.gnu.org/21551 +- https://debbugs.gnu.org/19977 +- https://debbugs.gnu.org/21330 +- https://debbugs.gnu.org/21551 **** Toggling the toolbar in fullheight or maximized modes @@ -1550,7 +1550,7 @@ 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 . +along with GNU Emacs. If not, see . ;; Local Variables: ;; coding: utf-8 diff --git a/etc/WHY-FREE b/etc/WHY-FREE index a70232d84a..cd2c2fcf8d 100644 --- a/etc/WHY-FREE +++ b/etc/WHY-FREE @@ -5,4 +5,4 @@ Note added March 2014: This file is obsolete and will be removed in future. Please update any references to use - + diff --git a/etc/charsets/README b/etc/charsets/README index 315c364345..101e0567a2 100644 --- a/etc/charsets/README +++ b/etc/charsets/README @@ -18,7 +18,7 @@ # 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 . +# along with GNU Emacs. If not, see . (1) Format of mapping files diff --git a/etc/compilation.txt b/etc/compilation.txt index 85e3632b7c..970c04e972 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -640,4 +640,4 @@ COPYING PERMISSIONS: GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . diff --git a/etc/edt-user.el b/etc/edt-user.el index 80f3b7e578..6d729a7b67 100644 --- a/etc/edt-user.el +++ b/etc/edt-user.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/etc/emacs-buffer.gdb b/etc/emacs-buffer.gdb index 48e9a5dac1..7d9d6488ee 100644 --- a/etc/emacs-buffer.gdb +++ b/etc/emacs-buffer.gdb @@ -18,7 +18,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Commentary: diff --git a/etc/emacs.appdata.xml b/etc/emacs.appdata.xml index 0ba305c452..c3b1afb628 100644 --- a/etc/emacs.appdata.xml +++ b/etc/emacs.appdata.xml @@ -25,9 +25,9 @@ - http://www.gnu.org/software/emacs/images/appdata.png + https://www.gnu.org/software/emacs/images/appdata.png - http://www.gnu.org/software/emacs + https://www.gnu.org/software/emacs emacs-devel_at_gnu.org GNU diff --git a/etc/enriched.txt b/etc/enriched.txt index e1f2d6cc15..0a29116716 100644 --- a/etc/enriched.txt +++ b/etc/enriched.txt @@ -254,4 +254,4 @@ COPYING PERMISSIONS: GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see <. + along with this program. If not, see <. diff --git a/etc/forms/forms-d2.el b/etc/forms/forms-d2.el index edd1a2dd59..96a49dad10 100644 --- a/etc/forms/forms-d2.el +++ b/etc/forms/forms-d2.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/etc/gnus-tut.txt b/etc/gnus-tut.txt index 74b110f479..3d2d742382 100644 --- a/etc/gnus-tut.txt +++ b/etc/gnus-tut.txt @@ -42,7 +42,7 @@ heart's delight at . ;; 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 . +;; along with GNU Emacs. If not, see . From lars Thu Feb 23 23:20:38 1995 From: larsi@ifi.uio.no (ding) diff --git a/etc/grep.txt b/etc/grep.txt index 582bc5fd01..f01a96bf46 100644 --- a/etc/grep.txt +++ b/etc/grep.txt @@ -112,7 +112,7 @@ COPYING PERMISSIONS: GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . ;;; Local Variables: diff --git a/etc/images/checked.xpm b/etc/images/checked.xpm index 033da686d5..c41cb90df8 100644 --- a/etc/images/checked.xpm +++ b/etc/images/checked.xpm @@ -16,7 +16,7 @@ * 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 . + * along with GNU Emacs. If not, see . */ static char * checked_xpm[] = { "12 12 5 1", diff --git a/etc/images/gnus/gnus.svg b/etc/images/gnus/gnus.svg index 0d9d863b11..ba2186def6 100644 --- a/etc/images/gnus/gnus.svg +++ b/etc/images/gnus/gnus.svg @@ -18,7 +18,7 @@ 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 . + along with GNU Emacs. If not, see . --> @@ -49,7 +49,7 @@ + rdf:resource="https://www.gnu.org/copyleft/gpl.html" /> gnus 2008/06/28 @@ -64,7 +64,7 @@ gnus splash image + rdf:resource="https://www.gnu.org/copyleft/gpl.html" /> diff --git a/etc/images/icons/hicolor/scalable/apps/emacs.svg b/etc/images/icons/hicolor/scalable/apps/emacs.svg index 632d53ef2a..d329199df7 100644 --- a/etc/images/icons/hicolor/scalable/apps/emacs.svg +++ b/etc/images/icons/hicolor/scalable/apps/emacs.svg @@ -32,7 +32,7 @@ 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 . + along with GNU Emacs. If not, see . -->. + along with GNU Emacs. If not, see . --> diff --git a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg index e4f4dc6f2b..4451a97550 100644 --- a/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg +++ b/etc/images/icons/hicolor/scalable/mimetypes/emacs-document23.svg @@ -16,7 +16,7 @@ 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 . + along with GNU Emacs. If not, see . --> diff --git a/etc/images/mh-logo.xpm b/etc/images/mh-logo.xpm index b2017c6f63..fe7474184c 100644 --- a/etc/images/mh-logo.xpm +++ b/etc/images/mh-logo.xpm @@ -18,7 +18,7 @@ * 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 . + * along with GNU Emacs. If not, see . */ static char *mh-e[] = { /* width height num_colors chars_per_pixel */ diff --git a/etc/images/splash.svg b/etc/images/splash.svg index 4957d824fe..ea919bd90e 100644 --- a/etc/images/splash.svg +++ b/etc/images/splash.svg @@ -19,7 +19,7 @@ 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 . + along with GNU Emacs. If not, see . --> @@ -89,7 +89,7 @@ + rdf:resource="https://www.gnu.org/copyleft/gpl.html" /> diff --git a/etc/images/unchecked.xpm b/etc/images/unchecked.xpm index f7ca8609f2..04f7556406 100644 --- a/etc/images/unchecked.xpm +++ b/etc/images/unchecked.xpm @@ -16,7 +16,7 @@ * 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 . + * along with GNU Emacs. If not, see . */ static char * unchecked_xpm[] = { "12 12 5 1", diff --git a/etc/org/README b/etc/org/README index 68905add81..9d11c07b39 100644 --- a/etc/org/README +++ b/etc/org/README @@ -16,7 +16,7 @@ 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 . +along with GNU Emacs. If not, see . Author: Jambunathan K diff --git a/etc/ps-prin0.ps b/etc/ps-prin0.ps index 66e46eac50..b2d148fc69 100644 --- a/etc/ps-prin0.ps +++ b/etc/ps-prin0.ps @@ -16,7 +16,7 @@ % 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 . +% along with GNU Emacs. If not, see . % As a special exception, the copyright holders of this module give % you permission to include the module in a Postscript file generated diff --git a/etc/ps-prin1.ps b/etc/ps-prin1.ps index c45aa6a40e..b46f312fa3 100644 --- a/etc/ps-prin1.ps +++ b/etc/ps-prin1.ps @@ -16,7 +16,7 @@ % 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 . +% along with GNU Emacs. If not, see . % As a special exception, the copyright holders of this module give % you permission to include the module in a Postscript file generated diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index e998ab7abc..3a8ca60045 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -15,7 +15,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/etc/refcards/README b/etc/refcards/README index 178cb9290d..492833d2d8 100644 --- a/etc/refcards/README +++ b/etc/refcards/README @@ -20,8 +20,8 @@ To only generate the cards for a specific language, use e.g. to install extra TeX packages for some languages. PDF and PS copies of these cards are also available at -. The FSF online -store sometimes has printed copies for sale. +. The FSF online +store sometimes has printed copies for sale. @@ -50,4 +50,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/etc/refcards/calccard.tex b/etc/refcards/calccard.tex index 45072722ab..93aa007834 100644 --- a/etc/refcards/calccard.tex +++ b/etc/refcards/calccard.tex @@ -39,7 +39,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). % @@ -82,7 +82,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -670,4 +670,3 @@ \section{Programming} % Local variables: % compile-command: "pdftex calccard" % End: - diff --git a/etc/refcards/cs-dired-ref.tex b/etc/refcards/cs-dired-ref.tex index 8a05babfae..6c4c3d6c37 100644 --- a/etc/refcards/cs-dired-ref.tex +++ b/etc/refcards/cs-dired-ref.tex @@ -22,7 +22,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See dired-ref.tex. @@ -64,7 +64,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/cs-refcard.tex b/etc/refcards/cs-refcard.tex index 69128934a3..14434581ab 100644 --- a/etc/refcards/cs-refcard.tex +++ b/etc/refcards/cs-refcard.tex @@ -25,7 +25,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -81,7 +81,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/cs-survival.tex b/etc/refcards/cs-survival.tex index bb14091721..0770100bd9 100644 --- a/etc/refcards/cs-survival.tex +++ b/etc/refcards/cs-survival.tex @@ -22,7 +22,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See survival.tex. @@ -72,7 +72,7 @@ For more Emacs documentation, and the \TeX{} source for this card, see the Emacs distribution, or - {\tt http://www.gnu.org/software/emacs}\par}} + {\tt https://www.gnu.org/software/emacs}\par}} \hsize 3.2in \vsize 7.95in diff --git a/etc/refcards/de-refcard.tex b/etc/refcards/de-refcard.tex index b5ca862917..82e4f9863a 100644 --- a/etc/refcards/de-refcard.tex +++ b/etc/refcards/de-refcard.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -83,7 +83,7 @@ version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -679,4 +679,3 @@ \section{Eigene Befehle schreiben} % Local variables: % compile-command: "pdftex de-refcard" % End: - diff --git a/etc/refcards/dired-ref.tex b/etc/refcards/dired-ref.tex index 86c53d079e..26b2a2852f 100644 --- a/etc/refcards/dired-ref.tex +++ b/etc/refcards/dired-ref.tex @@ -21,7 +21,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -37,7 +37,7 @@ \newcount\columnsperpage % This file can be printed with 1, 2, or 3 columns per page. -% Specify how many you want here. +% Specify how many you want here. % The reference card looks OK with 2 columns per page, portrait mode. % I haven't tried it with 3 columns per page. \columnsperpage=2 @@ -65,7 +65,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -405,4 +405,3 @@ \section{Getting Help} \copyrightnotice \bye - diff --git a/etc/refcards/fr-dired-ref.tex b/etc/refcards/fr-dired-ref.tex index 68e492fbab..183b086c5d 100644 --- a/etc/refcards/fr-dired-ref.tex +++ b/etc/refcards/fr-dired-ref.tex @@ -22,7 +22,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See dired-ref.tex. @@ -59,7 +59,7 @@ version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/fr-refcard.tex b/etc/refcards/fr-refcard.tex index 294e3ad69c..dbeb2baffe 100644 --- a/etc/refcards/fr-refcard.tex +++ b/etc/refcards/fr-refcard.tex @@ -24,7 +24,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -79,7 +79,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/fr-survival.tex b/etc/refcards/fr-survival.tex index f0885e5923..047190c1ec 100644 --- a/etc/refcards/fr-survival.tex +++ b/etc/refcards/fr-survival.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See survival.tex. @@ -67,7 +67,7 @@ For more Emacs documentation, and the \TeX{} source for this card, see the Emacs distribution, - or {\tt http://www.gnu.org/software/emacs}\par}} + or {\tt https://www.gnu.org/software/emacs}\par}} \hsize 3.2in \vsize 7.95in diff --git a/etc/refcards/gnus-logo.eps b/etc/refcards/gnus-logo.eps index aff7a31cbc..34301e6e70 100644 --- a/etc/refcards/gnus-logo.eps +++ b/etc/refcards/gnus-logo.eps @@ -16,7 +16,7 @@ % 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 . +% along with GNU Emacs. If not, see . % %%Title: gnuslogo1.ps %%BoundingBox: 0 0 493 505 diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex index 676820835f..bc52733bfb 100644 --- a/etc/refcards/gnus-refcard.tex +++ b/etc/refcards/gnus-refcard.tex @@ -126,7 +126,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, - see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} + see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} Please send corrections, additions and suggestions to the current maintainer's email address. \Guide{} last edited on \date. diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index ecfd62f730..71d1ef5f90 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -37,7 +37,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). % @@ -81,7 +81,7 @@ \centerline{version 3 or later.} \centerline{For more Emacs documentation, and the \TeX{} source for this card, see} -\centerline{the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}} +\centerline{the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}} \endgroup} diff --git a/etc/refcards/pdflayout.sty b/etc/refcards/pdflayout.sty index affb47520f..90bf6bd002 100644 --- a/etc/refcards/pdflayout.sty +++ b/etc/refcards/pdflayout.sty @@ -13,7 +13,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file defines `\pdflayout': % - \pdflayout=(0) is A4 portrait, diff --git a/etc/refcards/pl-refcard.tex b/etc/refcards/pl-refcard.tex index 0bddea458c..ac0eca1b98 100644 --- a/etc/refcards/pl-refcard.tex +++ b/etc/refcards/pl-refcard.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -91,7 +91,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http:////www.gnu.org//software//emacs} +see the Emacs distribution, or {\tt https:////www.gnu.org//software//emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -992,4 +992,3 @@ \section{Tworzenie nowych polece/n} % Local variables: % compile-command: "pdftex pl-refcard" % End: - diff --git a/etc/refcards/pt-br-refcard.tex b/etc/refcards/pt-br-refcard.tex index 1ba50fa1c7..dc9f0ae355 100644 --- a/etc/refcards/pt-br-refcard.tex +++ b/etc/refcards/pt-br-refcard.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -84,7 +84,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/refcard.tex b/etc/refcards/refcard.tex index 0a57fcf9ce..3780897817 100644 --- a/etc/refcards/refcard.tex +++ b/etc/refcards/refcard.tex @@ -22,7 +22,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -82,7 +82,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -696,4 +696,3 @@ \section{Writing Commands} % Local variables: % compile-command: "pdftex refcard" % End: - diff --git a/etc/refcards/ru-refcard.tex b/etc/refcards/ru-refcard.tex index fad75ddda4..866dd7948f 100644 --- a/etc/refcards/ru-refcard.tex +++ b/etc/refcards/ru-refcard.tex @@ -20,7 +20,7 @@ % 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 . +% along with GNU Emacs. If not, see . \documentclass[10pt]{article} \usepackage{multicol,tabularx} @@ -58,7 +58,7 @@ version 3 or later.} \centerline{For more Emacs documentation, and the \TeX{} source for this card,} -\centerline{see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}} +\centerline{see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs}} \endgroup} \hyphenation{mini-buf-fer} diff --git a/etc/refcards/sk-dired-ref.tex b/etc/refcards/sk-dired-ref.tex index 9af5499b84..9818add524 100644 --- a/etc/refcards/sk-dired-ref.tex +++ b/etc/refcards/sk-dired-ref.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See dired-ref.tex. @@ -65,7 +65,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/sk-refcard.tex b/etc/refcards/sk-refcard.tex index dae3d8b6f0..eb5f91acfc 100644 --- a/etc/refcards/sk-refcard.tex +++ b/etc/refcards/sk-refcard.tex @@ -26,7 +26,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -82,7 +82,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below diff --git a/etc/refcards/sk-survival.tex b/etc/refcards/sk-survival.tex index 52e1eefd85..f07197704d 100644 --- a/etc/refcards/sk-survival.tex +++ b/etc/refcards/sk-survival.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % See survival.tex. @@ -74,7 +74,7 @@ For more Emacs documentation, and the \TeX{} source for this card, see the Emacs distribution, - or {\tt http://www.gnu.org/software/emacs}\par}} + or {\tt https://www.gnu.org/software/emacs}\par}} \hsize 3.2in \vsize 7.95in diff --git a/etc/refcards/survival.tex b/etc/refcards/survival.tex index 81ee44e39d..7b5325b009 100644 --- a/etc/refcards/survival.tex +++ b/etc/refcards/survival.tex @@ -22,7 +22,7 @@ % 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 . +% along with GNU Emacs. If not, see . %**start of header @@ -61,7 +61,7 @@ For more Emacs documentation, and the \TeX{} source for this card, see the Emacs distribution, - or {\tt http://www.gnu.org/software/emacs}\par}} + or {\tt https://www.gnu.org/software/emacs}\par}} \hsize 3.2in \vsize 7.95in @@ -416,4 +416,3 @@ \section{Getting Help} % Local variables: % compile-command: "pdftex survival" % End: - diff --git a/etc/refcards/vipcard.tex b/etc/refcards/vipcard.tex index 5913dd4070..61ccdd53c7 100644 --- a/etc/refcards/vipcard.tex +++ b/etc/refcards/vipcard.tex @@ -21,7 +21,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -74,7 +74,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -679,4 +679,3 @@ \section{Ex Commands} % Local variables: % compile-command: "pdftex vipcard" % End: - diff --git a/etc/refcards/viperCard.tex b/etc/refcards/viperCard.tex index 6561a48b08..cebe485cf7 100644 --- a/etc/refcards/viperCard.tex +++ b/etc/refcards/viperCard.tex @@ -23,7 +23,7 @@ % 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 . +% along with GNU Emacs. If not, see . % This file is intended to be processed by plain TeX (TeX82). @@ -78,7 +78,7 @@ Released under the terms of the GNU General Public License version 3 or later. For more Emacs documentation, and the \TeX{} source for this card, -see the Emacs distribution, or {\tt http://www.gnu.org/software/emacs} +see the Emacs distribution, or {\tt https://www.gnu.org/software/emacs} \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -740,4 +740,3 @@ \subsection{Ex Miscellaneous Commands} % Local variables: % compile-command: "pdftex viperCard" % End: - diff --git a/etc/schema/locate.rnc b/etc/schema/locate.rnc index 9af0198105..3f4e7bba12 100644 --- a/etc/schema/locate.rnc +++ b/etc/schema/locate.rnc @@ -13,7 +13,7 @@ # 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 . +# along with GNU Emacs. If not, see . default namespace this = "http://thaiopensource.com/ns/locating-rules/1.0" namespace local = "" @@ -36,7 +36,7 @@ rule = | typeId # | typeIdBase | extensionRule - + ## Group of rules. Useful with xml:base. group = element group { common, rule* } @@ -212,6 +212,6 @@ extensionRule = anyElement = element * { attribute * { text }*, (text|anyElement)* } -common = +common = # attribute xml:base { xsd:anyURI }?, attribute * - (xml:base|this:*|local:*) { text }* diff --git a/etc/schema/relaxng.rnc b/etc/schema/relaxng.rnc index fae2bf1f01..7961457dd0 100644 --- a/etc/schema/relaxng.rnc +++ b/etc/schema/relaxng.rnc @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . default namespace rng = "http://relaxng.org/ns/structure/1.0" namespace local = "" @@ -39,7 +39,7 @@ param = element param { commonAttributes, nameNCName, xsd:string } exceptPattern = element except { common & pattern+ } -grammarContent = +grammarContent = definition | element div { common & grammarContent* } | element include { href, (common & includeContent*) } @@ -54,7 +54,7 @@ definition = combine = attribute combine { "choice" | "interleave" } -nameClass = +nameClass = element name { commonAttributes, xsd:QName } | element anyName { common & exceptNameClass? } | element nsName { common & exceptNameClass? } @@ -69,7 +69,7 @@ type = attribute type { xsd:NCName } common = commonAttributes, foreignElement* -commonAttributes = +commonAttributes = attribute ns { xsd:string }?, attribute datatypeLibrary { xsd:anyURI }?, foreignAttribute* diff --git a/etc/schema/schemas.xml b/etc/schema/schemas.xml index 97b29617c7..ef4a0b3e0e 100644 --- a/etc/schema/schemas.xml +++ b/etc/schema/schemas.xml @@ -13,7 +13,7 @@ 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 . --> +along with GNU Emacs. If not, see . --> diff --git a/etc/ses-example.ses b/etc/ses-example.ses index 5c0a281b1a..51a1684955 100644 --- a/etc/ses-example.ses +++ b/etc/ses-example.ses @@ -220,4 +220,4 @@ Sales summary - Acme fundraising ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License -;;; along with this program. If not, see . +;;; along with this program. If not, see . diff --git a/etc/srecode/c.srt b/etc/srecode/c.srt index 720da3daab..fe029a3c32 100644 --- a/etc/srecode/c.srt +++ b/etc/srecode/c.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "c-mode" @@ -131,7 +131,7 @@ Override this with your own preference to avoid using doxygen" ---- ;;; DOXYGEN FEATURES -;; +;; ;; context declaration diff --git a/etc/srecode/cpp.srt b/etc/srecode/cpp.srt index 444c14d819..6468eadc1d 100644 --- a/etc/srecode/cpp.srt +++ b/etc/srecode/cpp.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "c++-mode" @@ -56,7 +56,7 @@ Override this to affect applications, or the outer class structure for the user-facing template." ---- class {{?NAME}} {{#PARENTS}}{{#FIRST}}: {{/FIRST}}public {{NAME}}{{/PARENTS}} -{ +{ {{^}} }; ---- @@ -111,7 +111,7 @@ Override this with your own preference to avoid using doxygen." ---- ;;; DOXYGEN FEATURES -;; +;; ;; context classdecl diff --git a/etc/srecode/default.srt b/etc/srecode/default.srt index f7a8f09fc3..d8c7cd1be1 100644 --- a/etc/srecode/default.srt +++ b/etc/srecode/default.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "default" @@ -34,7 +34,7 @@ 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 this program. If not, see http://www.gnu.org/licenses/." +along with this program. If not, see https://www.gnu.org/licenses/." set DOLLAR "$" diff --git a/etc/srecode/doc-cpp.srt b/etc/srecode/doc-cpp.srt index 486bb63057..e23b37b883 100644 --- a/etc/srecode/doc-cpp.srt +++ b/etc/srecode/doc-cpp.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "c-mode" diff --git a/etc/srecode/doc-default.srt b/etc/srecode/doc-default.srt index 30a8311863..3290d6a84c 100644 --- a/etc/srecode/doc-default.srt +++ b/etc/srecode/doc-default.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "default" diff --git a/etc/srecode/doc-java.srt b/etc/srecode/doc-java.srt index a3a294d67f..ab0edb8193 100644 --- a/etc/srecode/doc-java.srt +++ b/etc/srecode/doc-java.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "java-mode" diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt index c25416eb13..c75997dc00 100644 --- a/etc/srecode/ede-autoconf.srt +++ b/etc/srecode/ede-autoconf.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "autoconf-mode" set escape_start "{{" diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt index 448534234c..0c7d566875 100644 --- a/etc/srecode/ede-make.srt +++ b/etc/srecode/ede-make.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "makefile-mode" set escape_start "{{" diff --git a/etc/srecode/el.srt b/etc/srecode/el.srt index cc3f1e8e81..66db5666c0 100644 --- a/etc/srecode/el.srt +++ b/etc/srecode/el.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set escape_start "$" set escape_end "$" @@ -307,5 +307,3 @@ bind "s" ;; end - - diff --git a/etc/srecode/getset-cpp.srt b/etc/srecode/getset-cpp.srt index 9f4341d039..50f5d224cb 100644 --- a/etc/srecode/getset-cpp.srt +++ b/etc/srecode/getset-cpp.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "c++-mode" set application "getset" @@ -47,4 +47,3 @@ f{{NAME}}(){{#NOTLAST}},{{/NOTLAST}} ---- ;; end - diff --git a/etc/srecode/java.srt b/etc/srecode/java.srt index db154dbf68..cfc55f8d79 100644 --- a/etc/srecode/java.srt +++ b/etc/srecode/java.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "java-mode" set escape_start "{{" @@ -162,8 +162,8 @@ template javadoc-class :indent :blank :time :user :tag * Created: {{DATE}} * * @author {{AUTHOR}} - * @version - * @since + * @version + * @since */ ---- diff --git a/etc/srecode/make.srt b/etc/srecode/make.srt index af2e950cfe..ef5f1bece7 100644 --- a/etc/srecode/make.srt +++ b/etc/srecode/make.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "makefile-mode" set escape_start "{{" diff --git a/etc/srecode/template.srt b/etc/srecode/template.srt index deb901f2db..8403a69861 100644 --- a/etc/srecode/template.srt +++ b/etc/srecode/template.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set escape_start "$" set escape_end "$" diff --git a/etc/srecode/test.srt b/etc/srecode/test.srt index 4e567adf79..9843e5338a 100644 --- a/etc/srecode/test.srt +++ b/etc/srecode/test.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "srecode-template-mode" set escape_start "$" @@ -83,7 +83,7 @@ template gapsomething :blank template inlinetext "Insert text that has no newlines" ---- - *In the middle* + *In the middle* ---- template includable :blank diff --git a/etc/srecode/texi.srt b/etc/srecode/texi.srt index 52acb77f21..def3b48d23 100644 --- a/etc/srecode/texi.srt +++ b/etc/srecode/texi.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "texinfo-mode" diff --git a/etc/srecode/wisent.srt b/etc/srecode/wisent.srt index ac59d770f5..7e8726cbac 100644 --- a/etc/srecode/wisent.srt +++ b/etc/srecode/wisent.srt @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . set mode "wisent-grammar-mode" set comment_start ";;" diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el index 5c9df3dc24..7171c4a708 100644 --- a/etc/themes/adwaita-theme.el +++ b/etc/themes/adwaita-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el index d1111de96a..568411fd23 100644 --- a/etc/themes/deeper-blue-theme.el +++ b/etc/themes/deeper-blue-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index c32d18ce3d..ed4b4f3df7 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index 6ec0316365..a181b7351b 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -4,7 +4,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; URL: https://github.com/fniessen/emacs-leuven-theme -;; Version: 20170715.0521 +;; Version: 20170912.2328 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el index 319b5f3e47..48d65d2690 100644 --- a/etc/themes/light-blue-theme.el +++ b/etc/themes/light-blue-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index 9b461cc5e6..dc1f9e6c7b 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el index 53772fbb3e..74de3efa45 100644 --- a/etc/themes/misterioso-theme.el +++ b/etc/themes/misterioso-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index 91bda44286..58a2a5937d 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index 9f7c0c2940..820c4639d1 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index 3890fe0010..881d1909a3 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index f816412dfb..0d2c0063b5 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el index 9ec532d9ba..bdfedadb95 100644 --- a/etc/themes/wheatgrass-theme.el +++ b/etc/themes/wheatgrass-theme.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el index 0192289a5b..eedf9abbba 100644 --- a/etc/themes/whiteboard-theme.el +++ b/etc/themes/whiteboard-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el index 80bac921a1..da0c289862 100644 --- a/etc/themes/wombat-theme.el +++ b/etc/themes/wombat-theme.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index a41e7b01cd..e099fe8dd1 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -1132,7 +1132,7 @@ and comes with permission to distribute copies on certain conditions: 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 . + along with GNU Emacs. If not, see . Please read the file COPYING and then do give copies of GNU Emacs to your friends. Help stamp out software obstructionism ("ownership") by diff --git a/etc/tutorials/TUTORIAL.bg b/etc/tutorials/TUTORIAL.bg index ed6f29c6d8..f34153932f 100644 --- a/etc/tutorials/TUTORIAL.bg +++ b/etc/tutorials/TUTORIAL.bg @@ -1178,7 +1178,7 @@ comes with permission to distribute copies on certain conditions: 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 . + along with GNU Emacs. If not, see . Моля, прочетете файла COPYING и тогава давайте копия на ГНУ Емакс на свои приятели. Помогнете да спрем затвореността на програмите diff --git a/etc/tutorials/TUTORIAL.cn b/etc/tutorials/TUTORIAL.cn index fe8f500aaf..a9fc6f0bbf 100644 --- a/etc/tutorials/TUTORIAL.cn +++ b/etc/tutorials/TUTORIAL.cn @@ -1013,7 +1013,7 @@ and comes with permission to distribute copies on certain conditions: 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 . + along with GNU Emacs. If not, see . Please read the file COPYING and then do give copies of GNU Emacs to your friends. Help stamp out software obstructionism ("ownership") by @@ -1039,7 +1039,7 @@ using, writing, and sharing free software! 售性或特定目的适用性所为的默示性担保。详情请参照GNU通用公共授权。 您应已收到附随于 GNU Emacs 的GNU通用公共授权的副本；如果没有，请参照 - . + . 敬请阅读文件“COPYING”，然后向你的朋友们分发 GNU Emacs 拷贝。让我们以使 用、编写和分享自由软件的实际行动来共同祛除软件障碍主义（所谓的“所有 diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index beac4b71af..f3e6bee955 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -1016,7 +1016,7 @@ Software Foundation, אם בגרסא 3 של הרשיון, ואם (כאופציה אנא עיינו ב־GNU General Public License. ‏GNU Emacs אמור להיות מלווה בעותק של GNU General Public License; אם לא -קיבלתם אותו, תוכלו למצוא אותו ב־‪‬. +קיבלתם אותו, תוכלו למצוא אותו sב־‪‬. הנכם מוזמנים לקרוא את הקובץ COPYING ואז אכן לחלק עותקים של GNU Emacs לחבריכם. עזרו לנו לחסל את "הבעלות" על תוכנה שאינה אלא חבלה בתוכנה, diff --git a/etc/tutorials/TUTORIAL.nl b/etc/tutorials/TUTORIAL.nl index d0453bdfd6..6f70e2cf84 100644 --- a/etc/tutorials/TUTORIAL.nl +++ b/etc/tutorials/TUTORIAL.nl @@ -1254,7 +1254,7 @@ and comes with permission to distribute copies on certain conditions: 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 . + along with GNU Emacs. If not, see . Please read the file COPYING and then do give copies of GNU Emacs to your friends. Help stamp out software obstructionism ("ownership") by diff --git a/etc/tutorials/TUTORIAL.sl b/etc/tutorials/TUTORIAL.sl index 4e59341f8c..a9b8991a19 100644 --- a/etc/tutorials/TUTORIAL.sl +++ b/etc/tutorials/TUTORIAL.sl @@ -1134,7 +1134,7 @@ Copyright © 1985, 1996, 1998, 2001-2017 Free Software Foundation, Inc. General Public License«. Kopijo »GNU General Public License« bi morali prejeti skupaj s paketom - GNU Emacs. Če je niste, je na voljo na . + GNU Emacs. Če je niste, je na voljo na . Prosimo, preberite datoteko COPYING in potem ponudite kopijo programa GNU Emacs svojim prijateljem. Pomagajte zatreti obstrukcionizem diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv index 45bd35067b..a0b041f31a 100644 --- a/etc/tutorials/TUTORIAL.sv +++ b/etc/tutorials/TUTORIAL.sv @@ -1155,7 +1155,7 @@ This file is part of GNU Emacs. 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 . + along with GNU Emacs. If not, see . Please read the file COPYING and then do give copies of GNU Emacs to your friends. Help stamp out software obstructionism ("ownership") by diff --git a/etc/tutorials/TUTORIAL.zh b/etc/tutorials/TUTORIAL.zh index c677cbd3f5..07c3e1f03c 100644 --- a/etc/tutorials/TUTORIAL.zh +++ b/etc/tutorials/TUTORIAL.zh @@ -960,7 +960,7 @@ Emacs，請使用 C-z 。 本快速指南的翻譯人員列表如下，如果您在閱讀本文之前，「完全」對 Emacs 沒有概念，請告訴我們您的意見以作為本文後續的改進依據。翻譯也提供了一份 《GNU Emacs 中文處理說明》在 -http://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份 +https://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份 內容已經整理到本快速指南〉，也請您自行參閱。 編輯器是電腦使用者最常接觸到的應用程式，因此不應該讓初學者感到過於困難， @@ -972,7 +972,7 @@ http://www.gnu.org/software/chinese/guide/emacs-chinese.zh.html 〈部份 issue here>」。 如果您是 Emacs 老手，GNU Chinese Translators Team (GNU/CTT) - 歡迎您的加入，我們現在正需要願 + 歡迎您的加入，我們現在正需要願 意投入翻譯 Emacs 使用手冊的人員。 本快速指南並沒有採用習慣上編輯器所使用的翻譯術語，一方面因為它的實際意 diff --git a/leim/Makefile.in b/leim/Makefile.in index a21c2d9515..f18010af60 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -19,7 +19,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/leim/README b/leim/README index 7bcdbd37f2..26c511ed91 100644 --- a/leim/README +++ b/leim/README @@ -51,4 +51,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/leim/leim-ext.el b/leim/leim-ext.el index c0779c32a5..0e6430ba74 100644 --- a/leim/leim-ext.el +++ b/leim/leim-ext.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index fa8de0bcc9..5947fbde82 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index e77b7c94cc..d444a54b9a 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 5e181ccacb..b3ebb84ca0 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lib-src/etags.c b/lib-src/etags.c index b4ce43de4f..4000f47a41 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -44,7 +44,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* NB To comply with the above BSD license, copyright information is diff --git a/lib-src/hexl.c b/lib-src/hexl.c index d949af0890..df49a598ca 100644 --- a/lib-src/hexl.c +++ b/lib-src/hexl.c @@ -16,7 +16,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ #include diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index c48f202a51..69c7f37a17 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* The arguments given to this program are all the C and Lisp source files diff --git a/lib-src/movemail.c b/lib-src/movemail.c index e5ca0b1661..ce8dfd2ad9 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Important notice: defining MAIL_USE_FLOCK or MAIL_USE_LOCKF *will diff --git a/lib-src/pop.c b/lib-src/pop.c index 1a85bd23e7..ba5ac6eb82 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lib-src/pop.h b/lib-src/pop.h index 474cf1a8db..8194985120 100644 --- a/lib-src/pop.h +++ b/lib-src/pop.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lib-src/profile.c b/lib-src/profile.c index f4ab45c171..6308041fbc 100644 --- a/lib-src/profile.c +++ b/lib-src/profile.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /** diff --git a/lib-src/rcs2log b/lib-src/rcs2log index 1a1771b2b2..5e5709201e 100755 --- a/lib-src/rcs2log +++ b/lib-src/rcs2log @@ -17,7 +17,7 @@ # GNU General Public License for more details. # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . Copyright='Copyright (C) 2017 Free Software Foundation, Inc. diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index 942aeeb399..5816edf1d2 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* This program allows a game to securely and atomically update a diff --git a/lib/Makefile.in b/lib/Makefile.in index ee41ea3e55..1f5b154f35 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . srcdir = @srcdir@ VPATH = @srcdir@ diff --git a/lib/save-cwd.c b/lib/save-cwd.c index c1de48e87d..fbd944bb72 100644 --- a/lib/save-cwd.c +++ b/lib/save-cwd.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Gnulib needs to save and restore the current working directory to fully emulate functions like fstatat. But Emacs doesn't care what diff --git a/lib/save-cwd.h b/lib/save-cwd.h index d066a0e564..577bc35dc0 100644 --- a/lib/save-cwd.h +++ b/lib/save-cwd.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Jim Meyering. */ diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 653200577d..913f937c57 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . SHELL = @SHELL@ @@ -481,7 +481,7 @@ check-defun-dups: ## ones that don't change very often at that) seems pretty pointless ## to me. -# http://debbugs.gnu.org/1004 +# https://debbugs.gnu.org/1004 # CC Mode uses a compile time macro system which causes a compile time # dependency in cc-*.elc files on the macros in other cc-*.el and the # version string in cc-defs.el. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 01ad3d478f..dbda5b5d2e 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/align.el b/lisp/align.el index 081f587d4b..084cd21b40 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el index c07bbd0b76..4338181c34 100644 --- a/lisp/allout-widgets.el +++ b/lisp/allout-widgets.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/allout.el b/lisp/allout.el index 529de85cd4..d0be847aa7 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 72d70c2102..34e1daebb0 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/apropos.el b/lisp/apropos.el index 86d9b51429..807fd854c1 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 938c143b8e..b06c07fea8 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/array.el b/lisp/array.el index 1481ff26df..d9554618db 100644 --- a/lisp/array.el +++ b/lisp/array.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 529e3024a6..8f69ce323e 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/auth-source.el b/lisp/auth-source.el index d4b44a5952..1cb7f5d57e 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/autoarg.el b/lisp/autoarg.el index 79916933ed..7677b9ed7b 100644 --- a/lisp/autoarg.el +++ b/lisp/autoarg.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el index fef42161bf..2820c8a9af 100644 --- a/lisp/autoinsert.el +++ b/lisp/autoinsert.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -200,7 +200,7 @@ If this contains a %s, that will be replaced by the matching rule." \;; GNU General Public License for more details. \;; You should have received a copy of the GNU General Public License -\;; along with this program. If not, see . +\;; along with this program. If not, see . \;;; Commentary: @@ -237,7 +237,7 @@ A copy of the license is included in the section entitled ``GNU Free Documentation License''. A copy of the license is also available from the Free Software -Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}. +Foundation Web site at @url{https://www.gnu.org/licenses/fdl.html}. @end quotation @@ -284,7 +284,7 @@ The document was typeset with * GNU Free Documentation License:: License for copying this manual. @end menu -@c Get fdl.texi from http://www.gnu.org/licenses/fdl.html +@c Get fdl.texi from https://www.gnu.org/licenses/fdl.html @include fdl.texi @node Index diff --git a/lisp/autorevert.el b/lisp/autorevert.el index a15386aa1a..4b70f73fe3 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/avoid.el b/lisp/avoid.el index a4935c4889..1a471983fc 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/battery.el b/lisp/battery.el index b1834f06ff..570cee140b 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/bindings.el b/lisp/bindings.el index be44b45136..3a679f778a 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 5b8ded7b22..1c8ff3df23 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/bs.el b/lisp/bs.el index c626698faf..07d23e465e 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 83d6bb6b0e..cb10754828 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/button.el b/lisp/button.el index 99c03d9d68..7e9a712dca 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 4e074d6b24..f70a6d0eb0 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 9db901a975..e64308bad6 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -544,7 +544,7 @@ (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq) (eq (car-safe (nth 1 math-simplify-expr)) 'var) - (not (math-expr-contains (nth 2 math-simplify-expr) + (not (math-expr-contains (nth 2 math-simplify-expr) (nth 1 math-simplify-expr)))) (setcar (cdr math-simplify-expr) (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) diff --git a/lisp/calc/calc-arith.el b/lisp/calc/calc-arith.el index ec08ea4dd3..008d5480dd 100644 --- a/lisp/calc/calc-arith.el +++ b/lisp/calc/calc-arith.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -448,7 +448,7 @@ ((Math-negp a) 1) ((Math-zerop a) 2) ((eq (car a) 'intv) - (cond + (cond ((math-known-posp (nth 2 a)) 4) ((math-known-negp (nth 3 a)) 1) ((Math-zerop (nth 2 a)) 6) @@ -1436,12 +1436,12 @@ (and (math-identity-matrix-p a t) (or (and (eq (car-safe b) 'calcFunc-idn) (= (length b) 2) - (list 'calcFunc-idn (math-mul + (list 'calcFunc-idn (math-mul (nth 1 (nth 1 a)) (nth 1 b)) (1- (length a)))) (and (math-known-scalarp b) - (list 'calcFunc-idn (math-mul + (list 'calcFunc-idn (math-mul (nth 1 (nth 1 a)) b) (1- (length a)))) (and (math-known-matrixp b) @@ -1449,11 +1449,11 @@ (and (math-identity-matrix-p b t) (or (and (eq (car-safe a) 'calcFunc-idn) (= (length a) 2) - (list 'calcFunc-idn (math-mul (nth 1 a) + (list 'calcFunc-idn (math-mul (nth 1 a) (nth 1 (nth 1 b))) (1- (length b)))) (and (math-known-scalarp a) - (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b))) + (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b))) (1- (length b)))) (and (math-known-matrixp a) (math-mul a (nth 1 (nth 1 b)))))) @@ -1717,7 +1717,7 @@ (defun math-div-new-non-trig (ntr) (if math-div-non-trig - (setq math-div-non-trig + (setq math-div-non-trig (list '* ntr math-div-non-trig)) (setq math-div-non-trig ntr))) @@ -1958,7 +1958,7 @@ (not (equal a math-simplify-only))) (list '^ a b)) ((and (eq (car-safe a) '*) - (or + (or (and (math-known-matrixp (nth 1 a)) (math-known-matrixp (nth 2 a))) @@ -1970,7 +1970,7 @@ (if (and (= b -1) (math-known-square-matrixp (nth 1 a)) (math-known-square-matrixp (nth 2 a))) - (math-mul (math-pow-fancy (nth 2 a) -1) + (math-mul (math-pow-fancy (nth 2 a) -1) (math-pow-fancy (nth 1 a) -1)) (list '^ a b))) ((and (eq (car-safe a) '*) @@ -2358,7 +2358,7 @@ (defalias 'calcFunc-float 'math-float) -;; The variable math-trunc-prec is local to math-trunc in calc-misc.el, +;; The variable math-trunc-prec is local to math-trunc in calc-misc.el, ;; but used by math-trunc-fancy which is called by math-trunc. (defvar math-trunc-prec) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index ffca7c37e6..3a7807bae5 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,7 +32,7 @@ (defconst math-bignum-logb-digit-size (logb math-bignum-digit-size) "The logb of the size of a bignum digit. -This is the largest value of B such that 2^B is less than +This is the largest value of B such that 2^B is less than the size of a Calc bignum digit.") (defconst math-bignum-digit-power-of-two @@ -171,7 +171,7 @@ the size of a Calc bignum digit.") (calc-wrapper (if (and (>= n 2) (<= n 36)) (progn - (calc-change-mode + (calc-change-mode (list 'calc-number-radix 'calc-twos-complement-mode) (list n (or arg (calc-is-option))) t) ;; also change global value so minibuffer sees it @@ -424,7 +424,7 @@ the size of a Calc bignum digit.") (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two - (logxor (cdr q) + (logxor (cdr q) (1- math-bignum-digit-power-of-two)))))) (defun calcFunc-lsh (a &optional n w) ; [I I] [Public] @@ -845,7 +845,7 @@ the size of a Calc bignum digit.") (setq num (concat (make-string (- digs len) ?0) num)))) (when calc-group-digits (setq num (math-group-float num))) - (concat + (concat (number-to-string calc-number-radix) "##" num))) diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 91fbb7b2b8..20b24060fc 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index a00adc0099..06c9dc9d10 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 14ab97fbed..bc88401752 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index d93a86ac06..7973fc182b 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-fin.el b/lisp/calc/calc-fin.el index 647574684e..92ef8f3a44 100644 --- a/lisp/calc/calc-fin.el +++ b/lisp/calc/calc-fin.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index 6aa421ec20..338967159d 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-frac.el b/lisp/calc/calc-frac.el index d98cdda4ea..3aa9eb8b97 100644 --- a/lisp/calc/calc-frac.el +++ b/lisp/calc/calc-frac.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -206,7 +206,7 @@ (defun calcFunc-fdiv (a b) ; [R I I] [Public] (cond ((Math-num-integerp a) - (cond + (cond ((Math-num-integerp b) (if (Math-zerop b) (math-reject-arg a "*Division by zero") @@ -217,7 +217,7 @@ (math-make-frac (math-mul (math-trunc a) (nth 2 b)) (nth 1 b)))) (t (math-reject-arg b 'integerp)))) ((eq (car-safe a) 'frac) - (cond + (cond ((Math-num-integerp b) (if (Math-zerop b) (math-reject-arg a "*Division by zero") @@ -227,7 +227,7 @@ (math-reject-arg a "*Division by zero") (math-make-frac (math-mul (nth 1 a) (nth 2 b)) (math-mul (nth 2 a) (nth 1 b))))) (t (math-reject-arg b 'integerp)))) - (t + (t (math-reject-arg a 'integerp)))) (provide 'calc-frac) diff --git a/lisp/calc/calc-funcs.el b/lisp/calc/calc-funcs.el index 2bb460df3c..1dde2ede87 100644 --- a/lisp/calc/calc-funcs.el +++ b/lisp/calc/calc-funcs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -564,7 +564,7 @@ ((Math-lessp '(float 8 0) (math-abs-approx x)) (let* ((z (math-div '(float 8 0) x)) (y (math-sqr z)) - (xx (math-add x + (xx (math-add x (math-read-number-simple "-0.785398164"))) (a1 (math-poly-eval y (list @@ -633,7 +633,7 @@ (setq sc (cons (math-neg (cdr sc)) (car sc))) (if (math-negp x) (setq sc (cons (math-neg (car sc)) (math-neg (cdr sc)))))) - (math-mul (math-sqrt (math-div + (math-mul (math-sqrt (math-div (math-read-number-simple "0.636619722") x)) (math-sub (math-mul (cdr sc) a1) @@ -813,39 +813,39 @@ (defvar math-bernoulli-b-cache (list - (list 'frac + (list 'frac -174611 (math-read-number-simple "802857662698291200000")) - (list 'frac - 43867 + (list 'frac + 43867 (math-read-number-simple "5109094217170944000")) - (list 'frac - -3617 + (list 'frac + -3617 (math-read-number-simple "10670622842880000")) - (list 'frac - 1 + (list 'frac + 1 (math-read-number-simple "74724249600")) - (list 'frac - -691 + (list 'frac + -691 (math-read-number-simple "1307674368000")) - (list 'frac - 1 + (list 'frac + 1 (math-read-number-simple "47900160")) - (list 'frac - -1 + (list 'frac + -1 (math-read-number-simple "1209600")) - (list 'frac - 1 - 30240) - (list 'frac - -1 + (list 'frac + 1 + 30240) + (list 'frac + -1 720) - (list 'frac - 1 - 12) + (list 'frac + 1 + 12) 1 )) -(defvar math-bernoulli-B-cache +(defvar math-bernoulli-B-cache '((frac -174611 330) (frac 43867 798) (frac -3617 510) (frac 7 6) (frac -691 2730) (frac 5 66) (frac -1 30) (frac 1 42) diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index bc05ffe427..c0598e6015 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index 356e571c99..3f95799284 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-incom.el b/lisp/calc/calc-incom.el index 59b591510d..1ff50e2044 100644 --- a/lisp/calc/calc-incom.el +++ b/lisp/calc/calc-incom.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-keypd.el b/lisp/calc/calc-keypd.el index dc49f2888c..cc3bfcf2cd 100644 --- a/lisp/calc/calc-keypd.el +++ b/lisp/calc/calc-keypd.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-lang.el b/lisp/calc/calc-lang.el index ce1ddb5695..50a7eec1da 100644 --- a/lisp/calc/calc-lang.el +++ b/lisp/calc/calc-lang.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-macs.el b/lisp/calc/calc-macs.el index b2cd580c2e..394c2e298e 100644 --- a/lisp/calc/calc-macs.el +++ b/lisp/calc/calc-macs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-map.el b/lisp/calc/calc-map.el index 76a58f4e9c..6f60d2eca7 100644 --- a/lisp/calc/calc-map.el +++ b/lisp/calc/calc-map.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -795,8 +795,8 @@ ;;; Do substitutions in parallel to avoid crosstalk. -;; The variables math-ms-temp and math-ms-args are local to -;; math-multi-subst, but are used by math-multi-subst-rec, which +;; The variables math-ms-temp and math-ms-args are local to +;; math-multi-subst, but are used by math-multi-subst-rec, which ;; is called by math-multi-subst. (defvar math-ms-temp) (defvar math-ms-args) @@ -811,7 +811,7 @@ (math-multi-subst-rec expr))) (defun math-multi-subst-rec (expr) - (cond ((setq math-ms-temp (assoc expr math-ms-args)) + (cond ((setq math-ms-temp (assoc expr math-ms-args)) (cdr math-ms-temp)) ((Math-primp expr) expr) ((and (eq (car expr) 'calcFunc-lambda) (> (length expr) 2)) @@ -820,7 +820,7 @@ (while (cdr (setq expr (cdr expr))) (setq new (cons (car expr) new)) (if (assoc (car expr) math-ms-args) - (setq math-ms-args (cons (cons (car expr) (car expr)) + (setq math-ms-args (cons (cons (car expr) (car expr)) math-ms-args)))) (nreverse (cons (math-multi-subst-rec (car expr)) new)))) (t diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 2590761d53..6d51536ac7 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -44,15 +44,15 @@ (1- n)) "The number of digits in an Emacs float.") -;;; Find the largest power of 10 which is an Emacs float, -;;; then back off by one so that any float d.dddd...eN +;;; Find the largest power of 10 which is an Emacs float, +;;; then back off by one so that any float d.dddd...eN ;;; is an Emacs float, for acceptable d.dddd.... (defvar math-largest-emacs-expt (let ((x 1) (pow 1e2)) - ;; The following loop is for efficiency; it should stop when - ;; 10^(2x) is too large. This could be indicated by a range + ;; The following loop is for efficiency; it should stop when + ;; 10^(2x) is too large. This could be indicated by a range ;; error when computing 10^(2x) or an infinite value for 10^(2x). (while (and pow @@ -102,9 +102,9 @@ If this can't be done, return NIL." (condition-case nil (math-read-number (number-to-string - (funcall fn - (string-to-number - (let + (funcall fn + (string-to-number + (let ((calc-number-radix 10) (calc-twos-complement-mode nil) (calc-float-format (list 'float calc-internal-prec)) @@ -948,7 +948,7 @@ If this can't be done, return NIL." (math-mul xs (car sc)) (math-sqr (cdr sc))))))) (math-make-sdev (calcFunc-sec (nth 1 x)) - (math-div + (math-div (math-mul (nth 2 x) (calcFunc-sin (nth 1 x))) (math-sqr (calcFunc-cos (nth 1 x))))))) @@ -1010,7 +1010,7 @@ If this can't be done, return NIL." (math-mul xs (cdr sc)) (math-sqr (car sc))))))) (math-make-sdev (calcFunc-csc (nth 1 x)) - (math-div + (math-div (math-mul (nth 2 x) (calcFunc-cos (nth 1 x))) (math-sqr (calcFunc-sin (nth 1 x))))))) @@ -1114,7 +1114,7 @@ If this can't be done, return NIL." (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) (sc (math-sin-cos-raw (nth 1 x))) - (d (math-add-float + (d (math-add-float (math-mul-float (math-sqr (car sc)) (math-sqr sh)) (math-mul-float (math-sqr (cdr sc)) @@ -1139,7 +1139,7 @@ If this can't be done, return NIL." (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) (sc (math-sin-cos-raw (nth 1 x))) - (d (math-add-float + (d (math-add-float (math-mul-float (math-sqr (car sc)) (math-sqr ch)) (math-mul-float (math-sqr (cdr sc)) @@ -1164,17 +1164,17 @@ If this can't be done, return NIL." (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) (sc (math-sin-cos-raw (nth 1 x))) - (d (math-add-float + (d (math-add-float (math-sqr (car sc)) (math-sqr sh)))) (and (not (eq (nth 1 d) 0)) (list 'cplx - (math-div-float + (math-div-float (math-mul-float (car sc) (cdr sc)) d) (math-neg - (math-div-float - (math-mul-float sh ch) + (math-div-float + (math-mul-float sh ch) d)))))) ((eq (car x) 'polar) (math-polar (math-cot-raw (math-complex x)))) @@ -1223,7 +1223,7 @@ If this can't be done, return NIL." (math-cos-raw-2 xmpo2 orgx)) ((math-lessp-float x (math-neg (math-pi-over-4))) (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx))) - ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx)) + ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx)) '(float 0 0)) ((math-use-emacs-fn 'sin x)) (calc-symbolic-mode (signal 'inexact-result nil)) @@ -1765,7 +1765,7 @@ If this can't be done, return NIL." '(float 0 0)) (calc-symbolic-mode (signal 'inexact-result nil)) ((math-posp (nth 1 x)) ; positive and real - (cond + (cond ((math-use-emacs-fn 'log x)) (t (let ((xdigs (1- (math-numdigs (nth 1 x))))) @@ -1818,7 +1818,7 @@ If this can't be done, return NIL." (defconst math-approx-ln-10 (math-read-number-simple "2.302585092994045684018") "An approximation for ln(10).") - + (math-defcache math-ln-10 math-approx-ln-10 (math-ln-raw-2 '(float 1 1))) @@ -1963,7 +1963,7 @@ If this can't be done, return NIL." (math-div '(float 2 0) (math-add expx (math-div -1 expx)))))) ((eq (car-safe x) 'sdev) (math-make-sdev (calcFunc-csch (nth 1 x)) - (math-mul (nth 2 x) + (math-mul (nth 2 x) (math-mul (calcFunc-csch (nth 1 x)) (calcFunc-coth (nth 1 x)))))) ((eq (car x) 'intv) diff --git a/lisp/calc/calc-menu.el b/lisp/calc/calc-menu.el index e0305e36e2..546e65091f 100644 --- a/lisp/calc/calc-menu.el +++ b/lisp/calc/calc-menu.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index e6af092063..a3e41cae8a 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-mode.el b/lisp/calc/calc-mode.el index 3b37881599..4a87281a39 100644 --- a/lisp/calc/calc-mode.el +++ b/lisp/calc/calc-mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index dc97c45766..77769e47da 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-nlfit.el b/lisp/calc/calc-nlfit.el index 684d0f17b7..b3335bbb00 100644 --- a/lisp/calc/calc-nlfit.el +++ b/lisp/calc/calc-nlfit.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index a36213077f..b2f69bc233 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 6e9322fc04..610e4dc5ba 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-rewr.el b/lisp/calc/calc-rewr.el index e50f8e1566..4f0d71a276 100644 --- a/lisp/calc/calc-rewr.el +++ b/lisp/calc/calc-rewr.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,7 +30,7 @@ (defvar math-rewrite-default-iters 100) -;; The variable calc-rewr-sel is local to calc-rewrite-selection and +;; The variable calc-rewr-sel is local to calc-rewrite-selection and ;; calc-rewrite, but is used by calc-locate-selection-marker. (defvar calc-rewr-sel) @@ -219,7 +219,7 @@ (not (equal math-rewrite-whole-expr save-expr)))) (if (symbolp (car sched)) (progn - (setq math-rewrite-whole-expr + (setq math-rewrite-whole-expr (math-normalize (list (car sched) math-rewrite-whole-expr))) (if trace-buffer (let ((fmt (math-format-stack-value @@ -490,13 +490,13 @@ ;; The variable math-import-list is local to part of math-compile-rewrites, ;; but is also used in a different part, and so the local version could -;; be affected by the non-local version when math-compile-rewrites calls itself. +;; be affected by the non-local version when math-compile-rewrites calls itself. (defvar math-import-list nil) -;; The variables math-regs, math-num-regs, math-prog-last, math-bound-vars, +;; The variables math-regs, math-num-regs, math-prog-last, math-bound-vars, ;; math-conds, math-copy-neg, math-rhs, math-pattern, math-remembering and -;; math-aliased-vars are local to math-compile-rewrites, -;; but are used by many functions math-rwcomp-*, which are called by +;; math-aliased-vars are local to math-compile-rewrites, +;; but are used by many functions math-rwcomp-*, which are called by ;; math-compile-rewrites. (defvar math-regs) (defvar math-num-regs) @@ -753,8 +753,8 @@ (list expr))) ;; The variables math-rewrite-heads-heads (i.e.; heads for math-rewrite-heads) -;; math-rewrite-heads-blanks and math-rewrite-heads-skips are local to -;; math-rewrite-heads, but used by math-rewrite-heads-rec, which is called by +;; math-rewrite-heads-blanks and math-rewrite-heads-skips are local to +;; math-rewrite-heads, but used by math-rewrite-heads-rec, which is called by ;; math-rewrite-heads. (defvar math-rewrite-heads-heads) (defvar math-rewrite-heads-skips) @@ -844,7 +844,7 @@ (cond ((equal expr math-rwcomp-subst-old) math-rwcomp-subst-new) ((Math-primp expr) expr) (t (if (eq (car expr) math-rwcomp-subst-old-func) - (math-build-call math-rwcomp-subst-new-func + (math-build-call math-rwcomp-subst-new-func (mapcar 'math-rwcomp-subst-rec (cdr expr))) (cons (car expr) @@ -1489,12 +1489,12 @@ (progn (terpri) (princ (car pc)) (if (and (natnump (nth 1 (car pc))) (< (nth 1 (car pc)) (length math-apply-rw-regs))) - (princ + (princ (format "\n part = %s" (aref math-apply-rw-regs (nth 1 (car pc)))))))) (cond ((eq (setq op (car (setq inst (car pc)))) 'func) - (if (and (consp + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (eq (car part) (car (setq inst (cdr (cdr inst))))) @@ -1533,7 +1533,7 @@ (aset mark 2 0)) ((eq op 'try) - (if (and (consp (setq part + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (memq (car part) (nth 2 inst)) (= (length part) 3) @@ -1658,7 +1658,7 @@ op (aref mark 2)) (cond ((eq op 0) (if (setq op (cdr (aref mark 1))) - (aset math-apply-rw-regs (nth 4 inst) + (aset math-apply-rw-regs (nth 4 inst) (car (aset mark 1 op))) (if (nth 5 inst) (progn @@ -1668,7 +1668,7 @@ (math-rwfail t)))) ((eq op 1) (if (setq op (cdr (aref mark 1))) - (aset math-apply-rw-regs (nth 4 inst) + (aset math-apply-rw-regs (nth 4 inst) (car (aset mark 1 op))) (if (= (aref mark 3) 1) (if (nth 5 inst) @@ -1725,7 +1725,7 @@ (t (math-rwfail t)))) ((eq op 'integer) - (if (Math-integerp (setq part + (if (Math-integerp (setq part (aref math-apply-rw-regs (nth 1 inst)))) (setq pc (cdr pc)) (if (Math-primp part) @@ -1756,7 +1756,7 @@ (math-rwfail))))) ((eq op 'negative) - (if (math-looks-negp (setq part + (if (math-looks-negp (setq part (aref math-apply-rw-regs (nth 1 inst)))) (setq pc (cdr pc)) (if (Math-primp part) @@ -1774,7 +1774,7 @@ (setq part (math-rweval (math-simplify (calcFunc-sign - (math-sub + (math-sub (aref math-apply-rw-regs (nth 1 inst)) (aref math-apply-rw-regs (nth 3 inst)))))))) (if (cond ((eq op 'calcFunc-eq) @@ -1793,7 +1793,7 @@ (math-rwfail))) ((eq op 'func-def) - (if (and + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (eq (car part) (car (setq inst (cdr (cdr inst)))))) @@ -1815,8 +1815,8 @@ (math-rwfail))) ((eq op 'func-opt) - (if (or (not - (and + (if (or (not + (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (eq (car part) (nth 2 inst)))) @@ -1833,7 +1833,7 @@ (setq pc (cdr pc)))) ((eq op 'mod) - (if (if (Math-zerop + (if (if (Math-zerop (setq part (aref math-apply-rw-regs (nth 1 inst)))) (Math-zerop (nth 3 inst)) (and (not (Math-zerop (nth 2 inst))) @@ -1847,7 +1847,7 @@ (math-rwfail))) ((eq op 'apply) - (if (and (consp + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (not (Math-objvecp part)) (not (eq (car part) 'var))) @@ -1860,19 +1860,19 @@ (math-rwfail))) ((eq op 'cons) - (if (and (consp + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (eq (car part) 'vec) (cdr part)) (progn (aset math-apply-rw-regs (nth 2 inst) (nth 1 part)) - (aset math-apply-rw-regs (nth 3 inst) + (aset math-apply-rw-regs (nth 3 inst) (cons 'vec (cdr (cdr part)))) (setq pc (cdr pc))) (math-rwfail))) ((eq op 'rcons) - (if (and (consp + (if (and (consp (setq part (aref math-apply-rw-regs (car (cdr inst))))) (eq (car part) 'vec) (cdr part)) @@ -1898,7 +1898,7 @@ (setq pc (cdr pc))) ((eq op 'copy) - (aset math-apply-rw-regs (nth 2 inst) + (aset math-apply-rw-regs (nth 2 inst) (aref math-apply-rw-regs (nth 1 inst))) (setq pc (cdr pc))) diff --git a/lisp/calc/calc-rules.el b/lisp/calc/calc-rules.el index bcace46816..b29e5bf349 100644 --- a/lisp/calc/calc-rules.el +++ b/lisp/calc/calc-rules.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-sel.el b/lisp/calc/calc-sel.el index d7f87f4910..a363469450 100644 --- a/lisp/calc/calc-sel.el +++ b/lisp/calc/calc-sel.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -140,8 +140,8 @@ (calc-change-current-selection sel) (error "%d is not a valid sub-formula index" num))))) -;; The variables calc-fnp-op and calc-fnp-num are local to -;; calc-find-nth-part (and calc-select-previous) but used by +;; The variables calc-fnp-op and calc-fnp-num are local to +;; calc-find-nth-part (and calc-select-previous) but used by ;; calc-find-nth-part-rec, which is called by them. (defvar calc-fnp-op) (defvar calc-fnp-num) @@ -650,7 +650,7 @@ alg) (let ((calc-dollar-values (list sel)) (calc-dollar-used 0)) - (setq alg (calc-do-alg-entry "" "Replace selection with: " nil + (setq alg (calc-do-alg-entry "" "Replace selection with: " nil 'calc-selection-history)) (and alg (progn diff --git a/lisp/calc/calc-stat.el b/lisp/calc/calc-stat.el index 2b79712f30..d70d4cd40e 100644 --- a/lisp/calc/calc-stat.el +++ b/lisp/calc/calc-stat.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-store.el b/lisp/calc/calc-store.el index 67931a7447..16d35f28ec 100644 --- a/lisp/calc/calc-store.el +++ b/lisp/calc/calc-store.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-stuff.el b/lisp/calc/calc-stuff.el index 48e3a3404d..afdeac1b6f 100644 --- a/lisp/calc/calc-stuff.el +++ b/lisp/calc/calc-stuff.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-trail.el b/lisp/calc/calc-trail.el index a9e294354b..9f949675b2 100644 --- a/lisp/calc/calc-trail.el +++ b/lisp/calc/calc-trail.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-undo.el b/lisp/calc/calc-undo.el index 06181f8c5c..17e1633c98 100644 --- a/lisp/calc/calc-undo.el +++ b/lisp/calc/calc-undo.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -75,7 +75,7 @@ (let ((v (intern (nth 1 action)))) (calc-record-undo (list 'store (nth 1 action) (and (boundp v) (symbol-value v)))) - (if (y-or-n-p (format "Un-store variable %s? " + (if (y-or-n-p (format "Un-store variable %s? " (calc-var-name (nth 1 action)))) (progn (if (nth 2 action) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index a8074eaeb2..b7b43acefc 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-vec.el b/lisp/calc/calc-vec.el index 0ce0d422f2..c049933eeb 100644 --- a/lisp/calc/calc-vec.el +++ b/lisp/calc/calc-vec.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index e97d878941..fec2512266 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 6a9af44181..d9e8cff16a 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el index bb4c30e123..53e0257206 100644 --- a/lisp/calc/calcalg2.el +++ b/lisp/calc/calcalg2.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calcalg3.el b/lisp/calc/calcalg3.el index dc6ac93e20..11e6342be2 100644 --- a/lisp/calc/calcalg3.el +++ b/lisp/calc/calcalg3.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -120,7 +120,7 @@ (defvar calc-curve-fit-history nil "History for calc-curve-fit.") -(defun calc-curve-fit (arg &optional calc-curve-model +(defun calc-curve-fit (arg &optional calc-curve-model calc-curve-coefnames calc-curve-varnames) (interactive "P") (calc-slow-wrapper @@ -148,7 +148,7 @@ "P prefix = plot result" "' = alg entry, $ = stack, u = Model1, U = Model2"))) (while (not calc-curve-model) - (message + (message "Fit to model: %s:%s%s" (nth which msgs) (if plot "P" " ") @@ -194,27 +194,27 @@ calc-curve-varnames nil) nil)) ((= key ?1) ; linear or multilinear - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 0)) - (setq calc-curve-model + (setq calc-curve-model (math-mul calc-curve-coefnames (cons 'vec (cons 1 (cdr calc-curve-varnames)))))) ((and (>= key ?2) (<= key ?9)) ; polynomial (calc-get-fit-variables 1 (- key ?0 -1) (and homog 0)) - (setq calc-curve-model + (setq calc-curve-model (math-build-polynomial-expr (cdr calc-curve-coefnames) (nth 1 calc-curve-varnames)))) ((= key ?i) ; exact polynomial (calc-get-fit-variables 1 (1- (length (nth 1 data))) (and homog 0)) - (setq calc-curve-model + (setq calc-curve-model (math-build-polynomial-expr (cdr calc-curve-coefnames) (nth 1 calc-curve-varnames)))) ((= key ?p) ; power law - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 1)) - (setq calc-curve-model - (math-mul + (setq calc-curve-model + (math-mul (nth 1 calc-curve-coefnames) (calcFunc-reduce '(var mul var-mul) @@ -223,9 +223,9 @@ calc-curve-varnames (cons 'vec (cdr (cdr calc-curve-coefnames)))))))) ((= key ?^) ; exponential law - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 1)) - (setq calc-curve-model + (setq calc-curve-model (math-mul (nth 1 calc-curve-coefnames) (calcFunc-reduce '(var mul var-mul) @@ -258,9 +258,9 @@ (cdr (nth 1 plot))))))) (calc-fit-hubbert-linear-curve func)) ((memq key '(?e ?E)) - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 1)) - (setq calc-curve-model + (setq calc-curve-model (math-mul (nth 1 calc-curve-coefnames) (calcFunc-reduce '(var mul var-mul) @@ -275,18 +275,18 @@ (cons 'vec (cdr (cdr calc-curve-coefnames))) calc-curve-varnames)))))) ((memq key '(?x ?X)) - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 0)) - (setq calc-curve-model + (setq calc-curve-model (math-mul calc-curve-coefnames (cons 'vec (cons 1 (cdr calc-curve-varnames))))) (setq calc-curve-model (if (eq key ?x) (list 'calcFunc-exp calc-curve-model) (list '^ 10 calc-curve-model)))) ((memq key '(?l ?L)) - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ calc-curve-nvars) (and homog 0)) - (setq calc-curve-model + (setq calc-curve-model (math-mul calc-curve-coefnames (cons 'vec (cons 1 (cdr (calcFunc-map @@ -296,7 +296,7 @@ var-log10)) calc-curve-varnames))))))) ((= key ?q) - (calc-get-fit-variables calc-curve-nvars + (calc-get-fit-variables calc-curve-nvars (1+ (* 2 calc-curve-nvars)) (and homog 0)) (let ((c calc-curve-coefnames) (v calc-curve-varnames)) @@ -310,15 +310,15 @@ (list '- (car v) (nth 1 c)) 2))))))) ((= key ?g) - (setq - calc-curve-model - (math-read-expr + (setq + calc-curve-model + (math-read-expr "(AFit / BFit sqrt(2 pi)) exp(-0.5 * ((XFit - CFit) / BFit)^2)") calc-curve-varnames '(vec (var XFit var-XFit)) calc-curve-coefnames '(vec (var AFit var-AFit) (var BFit var-BFit) (var CFit var-CFit))) - (calc-get-fit-variables 1 (1- (length calc-curve-coefnames)) + (calc-get-fit-variables 1 (1- (length calc-curve-coefnames)) (and homog 1))) ((memq key '(?\$ ?\' ?u ?U)) (let* ((defvars nil) @@ -327,7 +327,7 @@ (let* ((calc-dollar-values calc-arg-values) (calc-dollar-used 0) (calc-hashes-used 0)) - (setq calc-curve-model + (setq calc-curve-model (calc-do-alg-entry "" "Model formula: " nil 'calc-curve-fit-history)) (if (/= (length calc-curve-model) 1) @@ -358,19 +358,19 @@ (or (null (nth 3 calc-curve-model)) (math-vectorp (nth 3 calc-curve-model)))) (setq calc-curve-varnames (nth 2 calc-curve-model) - calc-curve-coefnames + calc-curve-coefnames (or (nth 3 calc-curve-model) (cons 'vec (math-all-vars-but - calc-curve-model + calc-curve-model calc-curve-varnames))) calc-curve-model (nth 1 calc-curve-model)) (error "Incorrect model specifier"))))) (or calc-curve-varnames - (let ((with-y + (let ((with-y (eq (car-safe calc-curve-model) 'calcFunc-eq))) (if calc-curve-coefnames - (calc-get-fit-variables + (calc-get-fit-variables (if with-y (1+ calc-curve-nvars) calc-curve-nvars) (1- (length calc-curve-coefnames)) (math-all-vars-but @@ -378,9 +378,9 @@ nil with-y) (let* ((coefs (math-all-vars-but calc-curve-model nil)) (vars nil) - (n (- - (length coefs) - calc-curve-nvars + (n (- + (length coefs) + calc-curve-nvars (if with-y 2 1))) p) (if (< n 0) @@ -388,12 +388,12 @@ (setq p (nthcdr n coefs)) (setq vars (cdr p)) (setcdr p nil) - (calc-get-fit-variables + (calc-get-fit-variables (if with-y (1+ calc-curve-nvars) calc-curve-nvars) (length coefs) vars coefs with-y))))) (if record-entry - (calc-record (list 'vec calc-curve-model + (calc-record (list 'vec calc-curve-model calc-curve-varnames calc-curve-coefnames) "modl")))) (t (beep)))) @@ -422,7 +422,7 @@ (calc-graph-set-styles nil nil) (calc-graph-point-style nil)) (setq plot (cdr (nth 1 plot))) - (setq plot + (setq plot (list 'intv 3 (math-sub @@ -1446,7 +1446,7 @@ ;;; Open Romberg method; "qromo" in section 4.4. ;; The variable math-ninteg-temp is local to math-ninteg-romberg, -;; but is used by math-ninteg-midpoint, which is used by +;; but is used by math-ninteg-midpoint, which is used by ;; math-ninteg-romberg. (defvar math-ninteg-temp) @@ -1564,7 +1564,7 @@ ;; The variables math-fit-first-var, math-fit-first-coef and ;; math-fit-new-coefs are local to math-general-fit, but are used by -;; calcFunc-fitvar, calcFunc-fitparam and calcFunc-fitdummy +;; calcFunc-fitvar, calcFunc-fitparam and calcFunc-fitdummy ;; (respectively), which are used by math-general-fit. (defvar math-fit-first-var) (defvar math-fit-first-coef) @@ -1903,7 +1903,7 @@ (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))) ;; The variables math-all-vars-vars (the vars for math-all-vars) and -;; math-all-vars-found are local to math-all-vars-in, but are used by +;; math-all-vars-found are local to math-all-vars-in, but are used by ;; math-all-vars-rec which is called by math-all-vars-in. (defvar math-all-vars-vars) (defvar math-all-vars-found) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 7c8013aa90..fe0a882cfb 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calc/calcsel2.el b/lisp/calc/calcsel2.el index 73497f049f..2299cd3da2 100644 --- a/lisp/calc/calcsel2.el +++ b/lisp/calc/calcsel2.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calculator.el b/lisp/calculator.el index 5366a9b959..e5488b8ae1 100644 --- a/lisp/calculator.el +++ b/lisp/calculator.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;===================================================================== ;;; Commentary: diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 08f1bf4978..2fc5040a75 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 6e624542cb..e0b7f4a3c2 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index 72e7675a78..5761e57681 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index 920ec7d5ce..bff0ade654 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index be709f5e1c..659b6349bb 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -406,7 +406,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'." (cadr (calendar-dst-find-startend year)) (nth 4 calendar-current-time-zone-cache)))) (if expr (eval expr))) - ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. + ;; New US rules commencing 2007. https://www.iana.org/time-zones (and (not (zerop calendar-daylight-time-offset)) (calendar-nth-named-day 2 0 3 year)))) @@ -417,7 +417,7 @@ This function respects the value of `calendar-dst-check-each-year-flag'." (nth 2 (calendar-dst-find-startend year)) (nth 5 calendar-current-time-zone-cache)))) (if expr (eval expr))) - ;; New US rules commencing 2007. ftp://elsie.nci.nih.gov/pub/. + ;; New US rules commencing 2007. https://www.iana.org/time-zones (and (not (zerop calendar-daylight-time-offset)) (calendar-nth-named-day 1 0 11 year)))) diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 3ecd90a86e..ede38217ee 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 15de7cde03..ba18b92ff9 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el index f002133900..41463cfc94 100644 --- a/lisp/calendar/cal-html.el +++ b/lisp/calendar/cal-html.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index c647893780..3650db493c 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index c802c848e0..427fc22b8e 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index 40887b4171..2ad3017d62 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index 2363cf535b..8f3a4a4a5a 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 1039b49591..90cce2840c 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index a845348b96..0ed5dc0bfb 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 571b397828..3365ae71a0 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 1ea10bf9d7..d299807107 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index f7ca3695a0..aca9d1c510 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1d6749319d..96ccd94382 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 4ee6719d32..520c730f5e 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 5b51b16d22..0a80b79f44 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index aa092b233e..129cd6d9ad 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 4d39b15aa0..9f7fad99f4 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index b781cb0eb4..dc405b9d97 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index f5cde3feac..5bf072384f 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index d9986231fd..61722f61ea 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index a4709c3b4b..a70e3ee416 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index ba7389c07a..79fda46284 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/case-table.el b/lisp/case-table.el index 271bb0a478..174e3f0afc 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cdl.el b/lisp/cdl.el index 16ba7e7d52..80ef76ace1 100644 --- a/lisp/cdl.el +++ b/lisp/cdl.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index 913f960b2a..faee7feeb2 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 0798e7c0c5..e18e66a12d 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index ee2265bec6..871fd94aeb 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index dbcce2d99b..4b6c6b01aa 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index a0b06f2820..bedbd98df3 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index b12e2a378f..5325bf52b5 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 87d73b2e42..a78af1b264 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/auto.el b/lisp/cedet/ede/auto.el index 6c0e5885cf..75f2d6bd7a 100644 --- a/lisp/cedet/ede/auto.el +++ b/lisp/cedet/ede/auto.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/autoconf-edit.el b/lisp/cedet/ede/autoconf-edit.el index c9783cae8b..e7481aad26 100644 --- a/lisp/cedet/ede/autoconf-edit.el +++ b/lisp/cedet/ede/autoconf-edit.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/base.el b/lisp/cedet/ede/base.el index 13d721a5f9..bfb5834d62 100644 --- a/lisp/cedet/ede/base.el +++ b/lisp/cedet/ede/base.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/config.el b/lisp/cedet/ede/config.el index a517ed18e0..64170fa1d0 100644 --- a/lisp/cedet/ede/config.el +++ b/lisp/cedet/ede/config.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/cpp-root.el b/lisp/cedet/ede/cpp-root.el index 319854e07c..9643578fa3 100644 --- a/lisp/cedet/ede/cpp-root.el +++ b/lisp/cedet/ede/cpp-root.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/custom.el b/lisp/cedet/ede/custom.el index 1c4e849d2d..55d4b4a5a9 100644 --- a/lisp/cedet/ede/custom.el +++ b/lisp/cedet/ede/custom.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/detect.el b/lisp/cedet/ede/detect.el index 54d48a2050..6240d46598 100644 --- a/lisp/cedet/ede/detect.el +++ b/lisp/cedet/ede/detect.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/dired.el b/lisp/cedet/ede/dired.el index 2555fab3a3..361881855f 100644 --- a/lisp/cedet/ede/dired.el +++ b/lisp/cedet/ede/dired.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/emacs.el b/lisp/cedet/ede/emacs.el index cac66fa734..f3ba4c3e1e 100644 --- a/lisp/cedet/ede/emacs.el +++ b/lisp/cedet/ede/emacs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 889cac8d95..4ba4ab1917 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/generic.el b/lisp/cedet/ede/generic.el index f7f98e618f..cf91c33f1f 100644 --- a/lisp/cedet/ede/generic.el +++ b/lisp/cedet/ede/generic.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index 22f5c3ed21..3a183b317e 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el index 845a491b88..f61ce34ba9 100644 --- a/lisp/cedet/ede/locate.el +++ b/lisp/cedet/ede/locate.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/make.el b/lisp/cedet/ede/make.el index 13591f6dc5..8fcaf52a96 100644 --- a/lisp/cedet/ede/make.el +++ b/lisp/cedet/ede/make.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el index 90d48fc763..e82577f4d3 100644 --- a/lisp/cedet/ede/makefile-edit.el +++ b/lisp/cedet/ede/makefile-edit.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/pconf.el b/lisp/cedet/ede/pconf.el index f8d9e0b746..8dc7f689ee 100644 --- a/lisp/cedet/ede/pconf.el +++ b/lisp/cedet/ede/pconf.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/pmake.el b/lisp/cedet/ede/pmake.el index 6feb9600e0..c199cae82b 100644 --- a/lisp/cedet/ede/pmake.el +++ b/lisp/cedet/ede/pmake.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-archive.el b/lisp/cedet/ede/proj-archive.el index 460df69f41..a9f3c708c0 100644 --- a/lisp/cedet/ede/proj-archive.el +++ b/lisp/cedet/ede/proj-archive.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-aux.el b/lisp/cedet/ede/proj-aux.el index 3b60eea7c2..8c5dfa7cf7 100644 --- a/lisp/cedet/ede/proj-aux.el +++ b/lisp/cedet/ede/proj-aux.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-comp.el b/lisp/cedet/ede/proj-comp.el index 80950ca704..0537946bed 100644 --- a/lisp/cedet/ede/proj-comp.el +++ b/lisp/cedet/ede/proj-comp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el index 9f4e69f01f..d48311548e 100644 --- a/lisp/cedet/ede/proj-elisp.el +++ b/lisp/cedet/ede/proj-elisp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-info.el b/lisp/cedet/ede/proj-info.el index d430e089c6..9ec7392425 100644 --- a/lisp/cedet/ede/proj-info.el +++ b/lisp/cedet/ede/proj-info.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-misc.el b/lisp/cedet/ede/proj-misc.el index 6d1070a7f7..75e409bd74 100644 --- a/lisp/cedet/ede/proj-misc.el +++ b/lisp/cedet/ede/proj-misc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-obj.el b/lisp/cedet/ede/proj-obj.el index e7fa7730bd..9fb94124c6 100644 --- a/lisp/cedet/ede/proj-obj.el +++ b/lisp/cedet/ede/proj-obj.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-prog.el b/lisp/cedet/ede/proj-prog.el index 3a14907271..2a9ea1a513 100644 --- a/lisp/cedet/ede/proj-prog.el +++ b/lisp/cedet/ede/proj-prog.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-scheme.el b/lisp/cedet/ede/proj-scheme.el index 5ac2efa557..0c6f602fb0 100644 --- a/lisp/cedet/ede/proj-scheme.el +++ b/lisp/cedet/ede/proj-scheme.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj-shared.el b/lisp/cedet/ede/proj-shared.el index 6c17504a02..f4c8e7b794 100644 --- a/lisp/cedet/ede/proj-shared.el +++ b/lisp/cedet/ede/proj-shared.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index a7f64ac5f3..daedd37a25 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index 86b707a99f..de99b2939f 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/shell.el b/lisp/cedet/ede/shell.el index 37beea0b42..dc31840ca6 100644 --- a/lisp/cedet/ede/shell.el +++ b/lisp/cedet/ede/shell.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/simple.el b/lisp/cedet/ede/simple.el index d618b938e6..8f084754f0 100644 --- a/lisp/cedet/ede/simple.el +++ b/lisp/cedet/ede/simple.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/source.el b/lisp/cedet/ede/source.el index d72d0db393..b2d7680e3c 100644 --- a/lisp/cedet/ede/source.el +++ b/lisp/cedet/ede/source.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cedet/ede/speedbar.el b/lisp/cedet/ede/speedbar.el index f938f209a4..4012fdadf7 100644 --- a/lisp/cedet/ede/speedbar.el +++ b/lisp/cedet/ede/speedbar.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/srecode.el b/lisp/cedet/ede/srecode.el index 4193684dcf..0658491f44 100644 --- a/lisp/cedet/ede/srecode.el +++ b/lisp/cedet/ede/srecode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el index 42172ce5dc..f5ac3e3980 100644 --- a/lisp/cedet/ede/system.el +++ b/lisp/cedet/ede/system.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/ede/util.el b/lisp/cedet/ede/util.el index eb364d7eaf..5535eff1e1 100644 --- a/lisp/cedet/ede/util.el +++ b/lisp/cedet/ede/util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/inversion.el b/lisp/cedet/inversion.el index ec54276af1..253336f973 100644 --- a/lisp/cedet/inversion.el +++ b/lisp/cedet/inversion.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el index 88ee400141..964f5c2db0 100644 --- a/lisp/cedet/mode-local.el +++ b/lisp/cedet/mode-local.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el index 913c183a7e..51df5e9ffe 100644 --- a/lisp/cedet/pulse.el +++ b/lisp/cedet/pulse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index c38afed396..682ac89978 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index c7062fb24c..517e1be8ec 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/analyze/complete.el b/lisp/cedet/semantic/analyze/complete.el index 1ddbe131e6..1a45068370 100644 --- a/lisp/cedet/semantic/analyze/complete.el +++ b/lisp/cedet/semantic/analyze/complete.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/analyze/debug.el b/lisp/cedet/semantic/analyze/debug.el index fd218b6782..8e68e3b856 100644 --- a/lisp/cedet/semantic/analyze/debug.el +++ b/lisp/cedet/semantic/analyze/debug.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 1abbca5158..29a1ac9165 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/analyze/refs.el b/lisp/cedet/semantic/analyze/refs.el index 7fbaa2ce97..55fcd83043 100644 --- a/lisp/cedet/semantic/analyze/refs.el +++ b/lisp/cedet/semantic/analyze/refs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine.el b/lisp/cedet/semantic/bovine.el index 3c33eebb49..a3776b8d64 100644 --- a/lisp/cedet/semantic/bovine.el +++ b/lisp/cedet/semantic/bovine.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 3200a5c143..8dc0488615 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/debug.el b/lisp/cedet/semantic/bovine/debug.el index f7bc20687e..79aa400180 100644 --- a/lisp/cedet/semantic/bovine/debug.el +++ b/lisp/cedet/semantic/bovine/debug.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/el.el b/lisp/cedet/semantic/bovine/el.el index ba6b05d760..f5931e4f2c 100644 --- a/lisp/cedet/semantic/bovine/el.el +++ b/lisp/cedet/semantic/bovine/el.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/gcc.el b/lisp/cedet/semantic/bovine/gcc.el index e4864bc6ca..36f0935449 100644 --- a/lisp/cedet/semantic/bovine/gcc.el +++ b/lisp/cedet/semantic/bovine/gcc.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/grammar.el b/lisp/cedet/semantic/bovine/grammar.el index d34850f803..28af05d95e 100644 --- a/lisp/cedet/semantic/bovine/grammar.el +++ b/lisp/cedet/semantic/bovine/grammar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -505,7 +505,7 @@ Menu items are appended to the common grammar menu.") ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/make.el b/lisp/cedet/semantic/bovine/make.el index 2a224bd99b..691ac0e85a 100644 --- a/lisp/cedet/semantic/bovine/make.el +++ b/lisp/cedet/semantic/bovine/make.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/bovine/scm.el b/lisp/cedet/semantic/bovine/scm.el index 2e87993d0f..547ca7a5fc 100644 --- a/lisp/cedet/semantic/bovine/scm.el +++ b/lisp/cedet/semantic/bovine/scm.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/chart.el b/lisp/cedet/semantic/chart.el index 4f8ae245bd..8063f2cbb1 100644 --- a/lisp/cedet/semantic/chart.el +++ b/lisp/cedet/semantic/chart.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index 5bd76f018a..ff8e61e54d 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/ctxt.el b/lisp/cedet/semantic/ctxt.el index 01e156267a..13bea30265 100644 --- a/lisp/cedet/semantic/ctxt.el +++ b/lisp/cedet/semantic/ctxt.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-debug.el b/lisp/cedet/semantic/db-debug.el index 9e6d725f4e..8595cceeca 100644 --- a/lisp/cedet/semantic/db-debug.el +++ b/lisp/cedet/semantic/db-debug.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index 187f72242d..5b4e7eba27 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-el.el b/lisp/cedet/semantic/db-el.el index 89bbd1c0c2..768af034c6 100644 --- a/lisp/cedet/semantic/db-el.el +++ b/lisp/cedet/semantic/db-el.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-file.el b/lisp/cedet/semantic/db-file.el index ed8d7bb144..1e398c5a28 100644 --- a/lisp/cedet/semantic/db-file.el +++ b/lisp/cedet/semantic/db-file.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index c09af59ea7..c678739671 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el index 0afa6619d2..38fec0203a 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-javascript.el b/lisp/cedet/semantic/db-javascript.el index e8a3edcaf0..348512a212 100644 --- a/lisp/cedet/semantic/db-javascript.el +++ b/lisp/cedet/semantic/db-javascript.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el index 3bd991b368..8072ca9e69 100644 --- a/lisp/cedet/semantic/db-mode.el +++ b/lisp/cedet/semantic/db-mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-ref.el b/lisp/cedet/semantic/db-ref.el index a75a73ce10..049420ee74 100644 --- a/lisp/cedet/semantic/db-ref.el +++ b/lisp/cedet/semantic/db-ref.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db-typecache.el b/lisp/cedet/semantic/db-typecache.el index 8c8cf15eaf..68f9e200ed 100644 --- a/lisp/cedet/semantic/db-typecache.el +++ b/lisp/cedet/semantic/db-typecache.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 0ba9f2f9c6..e7ee879bf3 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index 5c793e44aa..c0a5fcb5e2 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/decorate.el b/lisp/cedet/semantic/decorate.el index fc00a527bf..ad866e9fe0 100644 --- a/lisp/cedet/semantic/decorate.el +++ b/lisp/cedet/semantic/decorate.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index c7b5eb55ef..6876e5f3a4 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/decorate/mode.el b/lisp/cedet/semantic/decorate/mode.el index a749fca9cc..fb05a35cce 100644 --- a/lisp/cedet/semantic/decorate/mode.el +++ b/lisp/cedet/semantic/decorate/mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/dep.el b/lisp/cedet/semantic/dep.el index 8c3ec0e06f..f8d830bc29 100644 --- a/lisp/cedet/semantic/dep.el +++ b/lisp/cedet/semantic/dep.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/doc.el b/lisp/cedet/semantic/doc.el index c8be665727..d2b075655d 100644 --- a/lisp/cedet/semantic/doc.el +++ b/lisp/cedet/semantic/doc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el index d982b6e258..967af0bc35 100644 --- a/lisp/cedet/semantic/ede-grammar.el +++ b/lisp/cedet/semantic/ede-grammar.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 9c7ae69081..78822c487a 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index bf8eb9df11..0959dfc725 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index b724429850..1ec8e68c37 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/fw.el b/lisp/cedet/semantic/fw.el index 3527f3e6af..ea3fc2a2d6 100644 --- a/lisp/cedet/semantic/fw.el +++ b/lisp/cedet/semantic/fw.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el index 9b5370815e..6e7a1ad398 100644 --- a/lisp/cedet/semantic/grammar-wy.el +++ b/lisp/cedet/semantic/grammar-wy.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index f57c54a25b..61266bcc60 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -583,7 +583,7 @@ Typically a DEFINE expression should look like this: ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/html.el b/lisp/cedet/semantic/html.el index 7901d6aec2..4485a1f44c 100644 --- a/lisp/cedet/semantic/html.el +++ b/lisp/cedet/semantic/html.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/ia-sb.el b/lisp/cedet/semantic/ia-sb.el index 7901dd53dd..d7e1acae93 100644 --- a/lisp/cedet/semantic/ia-sb.el +++ b/lisp/cedet/semantic/ia-sb.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index 4696388a9c..d4201fcf51 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -163,7 +163,7 @@ Completion options are calculated with `semantic-analyze-possible-completions'." (if (not syms) (progn (message "No smart completions found.") - ;; Disabled - see http://debbugs.gnu.org/14522 + ;; Disabled - see https://debbugs.gnu.org/14522 ;; (message "No smart completions found. Trying Senator.") ;; (when (semantic-analyze-context-p a) ;; ;; This is a quick way of getting a nice completion list diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 787748692e..a106725f86 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/imenu.el b/lisp/cedet/semantic/imenu.el index a521f313f9..28d624908e 100644 --- a/lisp/cedet/semantic/imenu.el +++ b/lisp/cedet/semantic/imenu.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index 00f9ee783b..3c81b7ae65 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index cb33e483a6..35d77a8f87 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/lex.el b/lisp/cedet/semantic/lex.el index b2a63cdcc3..eec6e6762f 100644 --- a/lisp/cedet/semantic/lex.el +++ b/lisp/cedet/semantic/lex.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/mru-bookmark.el b/lisp/cedet/semantic/mru-bookmark.el index 067439d477..5fa58e08ea 100644 --- a/lisp/cedet/semantic/mru-bookmark.el +++ b/lisp/cedet/semantic/mru-bookmark.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/sb.el b/lisp/cedet/semantic/sb.el index 41fe8857cc..fbec9f2b01 100644 --- a/lisp/cedet/semantic/sb.el +++ b/lisp/cedet/semantic/sb.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 9bade56965..717c2e3011 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/senator.el b/lisp/cedet/semantic/senator.el index f1918c4091..e86658628b 100644 --- a/lisp/cedet/semantic/senator.el +++ b/lisp/cedet/semantic/senator.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/sort.el b/lisp/cedet/semantic/sort.el index e77b64f7ba..32e39d7454 100644 --- a/lisp/cedet/semantic/sort.el +++ b/lisp/cedet/semantic/sort.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index a16672e39d..b9fe63d684 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/cscope.el b/lisp/cedet/semantic/symref/cscope.el index 181e399768..502c3ef9f3 100644 --- a/lisp/cedet/semantic/symref/cscope.el +++ b/lisp/cedet/semantic/symref/cscope.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/filter.el b/lisp/cedet/semantic/symref/filter.el index e386033319..53be5e0def 100644 --- a/lisp/cedet/semantic/symref/filter.el +++ b/lisp/cedet/semantic/symref/filter.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/global.el b/lisp/cedet/semantic/symref/global.el index e91ecf07bc..35f6a249d9 100644 --- a/lisp/cedet/semantic/symref/global.el +++ b/lisp/cedet/semantic/symref/global.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 341a083775..bc19cd30c4 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/idutils.el b/lisp/cedet/semantic/symref/idutils.el index 3c94f01c6d..290bed1224 100644 --- a/lisp/cedet/semantic/symref/idutils.el +++ b/lisp/cedet/semantic/symref/idutils.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index e1a789d673..d0ad23934d 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/tag-file.el b/lisp/cedet/semantic/tag-file.el index ac11dbeb44..65d9e2cae5 100644 --- a/lisp/cedet/semantic/tag-file.el +++ b/lisp/cedet/semantic/tag-file.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/tag-ls.el b/lisp/cedet/semantic/tag-ls.el index 3a66fc7df5..aa9b4b9714 100644 --- a/lisp/cedet/semantic/tag-ls.el +++ b/lisp/cedet/semantic/tag-ls.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/tag-write.el b/lisp/cedet/semantic/tag-write.el index 76a1d79e10..6ce77edf10 100644 --- a/lisp/cedet/semantic/tag-write.el +++ b/lisp/cedet/semantic/tag-write.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 6b2a49558d..59788c774e 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/texi.el b/lisp/cedet/semantic/texi.el index 79f879899d..e9bc3415e3 100644 --- a/lisp/cedet/semantic/texi.el +++ b/lisp/cedet/semantic/texi.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 70f3a34334..b31fd07f3c 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/util.el b/lisp/cedet/semantic/util.el index 31562bc16a..f5d9054bdc 100644 --- a/lisp/cedet/semantic/util.el +++ b/lisp/cedet/semantic/util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el index 90a863bd3c..235f83821d 100644 --- a/lisp/cedet/semantic/wisent.el +++ b/lisp/cedet/semantic/wisent.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index cb19b1b861..0ed9ba3259 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/wisent/grammar.el b/lisp/cedet/semantic/wisent/grammar.el index d0dc3e7b39..29106da5f9 100644 --- a/lisp/cedet/semantic/wisent/grammar.el +++ b/lisp/cedet/semantic/wisent/grammar.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -370,7 +370,7 @@ Menu items are appended to the common grammar menu.") ;; 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 .") +;; along with GNU Emacs. If not, see .") (defvar wisent-make-parsers--python-license ";; It is derived in part from the Python grammar, used under the diff --git a/lisp/cedet/semantic/wisent/java-tags.el b/lisp/cedet/semantic/wisent/java-tags.el index 9deb997435..479fc7fbe8 100644 --- a/lisp/cedet/semantic/wisent/java-tags.el +++ b/lisp/cedet/semantic/wisent/java-tags.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -75,7 +75,7 @@ This function override `get-local-variables'." ;; Add 'this' if in a fcn (when (semantic-tag-of-class-p ct 'function) ;; Append a new tag THIS into our space. - (setq vars (cons (semantic-tag-new-variable + (setq vars (cons (semantic-tag-new-variable "this" (semantic-tag-name (semantic-current-tag-parent)) nil) vars))) diff --git a/lisp/cedet/semantic/wisent/javascript.el b/lisp/cedet/semantic/wisent/javascript.el index cf1911b46c..b73cb01819 100644 --- a/lisp/cedet/semantic/wisent/javascript.el +++ b/lisp/cedet/semantic/wisent/javascript.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/wisent/python.el b/lisp/cedet/semantic/wisent/python.el index 4e7ee3d0cf..591895d5aa 100644 --- a/lisp/cedet/semantic/wisent/python.el +++ b/lisp/cedet/semantic/wisent/python.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/semantic/wisent/wisent.el b/lisp/cedet/semantic/wisent/wisent.el index 08cad524ae..d4d2b3d2ac 100644 --- a/lisp/cedet/semantic/wisent/wisent.el +++ b/lisp/cedet/semantic/wisent/wisent.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index e824062f7b..c8eee15bae 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/args.el b/lisp/cedet/srecode/args.el index facf96e9af..c4a15a2d6a 100644 --- a/lisp/cedet/srecode/args.el +++ b/lisp/cedet/srecode/args.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/compile.el b/lisp/cedet/srecode/compile.el index 1b6cd70409..21ab9b8f2e 100644 --- a/lisp/cedet/srecode/compile.el +++ b/lisp/cedet/srecode/compile.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/cpp.el b/lisp/cedet/srecode/cpp.el index 8f9c083284..fe1dd77ae9 100644 --- a/lisp/cedet/srecode/cpp.el +++ b/lisp/cedet/srecode/cpp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/ctxt.el b/lisp/cedet/srecode/ctxt.el index 28dbd36739..664e06d73e 100644 --- a/lisp/cedet/srecode/ctxt.el +++ b/lisp/cedet/srecode/ctxt.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/dictionary.el b/lisp/cedet/srecode/dictionary.el index 2844c1b52d..4507581621 100644 --- a/lisp/cedet/srecode/dictionary.el +++ b/lisp/cedet/srecode/dictionary.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index babd177c9b..f8fcdef584 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/el.el b/lisp/cedet/srecode/el.el index 526a2a2107..e725074b7a 100644 --- a/lisp/cedet/srecode/el.el +++ b/lisp/cedet/srecode/el.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/expandproto.el b/lisp/cedet/srecode/expandproto.el index 74742f66d7..87bcdb3b94 100644 --- a/lisp/cedet/srecode/expandproto.el +++ b/lisp/cedet/srecode/expandproto.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el index 34771859d6..bbde255b41 100644 --- a/lisp/cedet/srecode/extract.el +++ b/lisp/cedet/srecode/extract.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el index 0bef8545eb..7818a66a57 100644 --- a/lisp/cedet/srecode/fields.el +++ b/lisp/cedet/srecode/fields.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/filters.el b/lisp/cedet/srecode/filters.el index 7b9b9798f5..1be451be28 100644 --- a/lisp/cedet/srecode/filters.el +++ b/lisp/cedet/srecode/filters.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -54,4 +54,3 @@ (provide 'srecode/filters) ;;; srecode/filters.el ends here - diff --git a/lisp/cedet/srecode/find.el b/lisp/cedet/srecode/find.el index 913013c259..35b3753c91 100644 --- a/lisp/cedet/srecode/find.el +++ b/lisp/cedet/srecode/find.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/getset.el b/lisp/cedet/srecode/getset.el index 0b32af2351..b23ae8eceb 100644 --- a/lisp/cedet/srecode/getset.el +++ b/lisp/cedet/srecode/getset.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el index c582e328b2..1e2cbc84e6 100644 --- a/lisp/cedet/srecode/insert.el +++ b/lisp/cedet/srecode/insert.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/java.el b/lisp/cedet/srecode/java.el index 30734f2b9e..0ede5d28b0 100644 --- a/lisp/cedet/srecode/java.el +++ b/lisp/cedet/srecode/java.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/map.el b/lisp/cedet/srecode/map.el index d5b4c5ffc8..10541f61a9 100644 --- a/lisp/cedet/srecode/map.el +++ b/lisp/cedet/srecode/map.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/mode.el b/lisp/cedet/srecode/mode.el index 566ab5d366..ddbce0a63c 100644 --- a/lisp/cedet/srecode/mode.el +++ b/lisp/cedet/srecode/mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index 7e24a32048..44c5248ad9 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/srt-mode.el b/lisp/cedet/srecode/srt-mode.el index d3ce72aef8..602a1ce843 100644 --- a/lisp/cedet/srecode/srt-mode.el +++ b/lisp/cedet/srecode/srt-mode.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cedet/srecode/srt.el b/lisp/cedet/srecode/srt.el index 070261c47c..4c885fe9ab 100644 --- a/lisp/cedet/srecode/srt.el +++ b/lisp/cedet/srecode/srt.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/table.el b/lisp/cedet/srecode/table.el index 98e0c2d1d1..f85a88165f 100644 --- a/lisp/cedet/srecode/table.el +++ b/lisp/cedet/srecode/table.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -288,4 +288,3 @@ Use PREDICATE is the same as for the `sort' function." (provide 'srecode/table) ;;; srecode/table.el ends here - diff --git a/lisp/cedet/srecode/template.el b/lisp/cedet/srecode/template.el index 95510772ca..7da896989f 100644 --- a/lisp/cedet/srecode/template.el +++ b/lisp/cedet/srecode/template.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cedet/srecode/texi.el b/lisp/cedet/srecode/texi.el index 5cc57bebee..9bf52e10f6 100644 --- a/lisp/cedet/srecode/texi.el +++ b/lisp/cedet/srecode/texi.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/char-fold.el b/lisp/char-fold.el index ea4486353a..18ce5bea4f 100644 --- a/lisp/char-fold.el +++ b/lisp/char-fold.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/chistory.el b/lisp/chistory.el index 8b6f3d1525..c270bffe11 100644 --- a/lisp/chistory.el +++ b/lisp/chistory.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index 0a41a401af..1bf79f3c1a 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/color.el b/lisp/color.el index e22b3cf0f6..2db01a53c8 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/comint.el b/lisp/comint.el index 51b659167d..17f1ab4ca0 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/completion.el b/lisp/completion.el index d56ea93ad1..42366acbf7 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/composite.el b/lisp/composite.el index a3e0001346..ab39e087e1 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index ecdda4e702..6c513640bb 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 6dbb45ec6b..1e13e95047 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cus-face.el b/lisp/cus-face.el index aa5ecd2e22..0fc084e69b 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/cus-start.el b/lisp/cus-start.el index c28b8a147f..b197f2f1de 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index d2ee14d8bd..1aac7bf631 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/custom.el b/lisp/custom.el index ecfa34db5b..352fc6bd53 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index 86eb4e737d..4bdfffe864 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/delim-col.el b/lisp/delim-col.el index db89206f32..120131fe03 100644 --- a/lisp/delim-col.el +++ b/lisp/delim-col.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/delsel.el b/lisp/delsel.el index 8cb7adeaa3..17b46efc7c 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/descr-text.el b/lisp/descr-text.el index b3c96988dd..12d0016de3 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/desktop.el b/lisp/desktop.el index a2260ba490..73228ce040 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dframe.el b/lisp/dframe.el index f60fffe7a7..7f77d8991f 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 2b89e527c3..7e2252fcf1 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dired-x.el b/lisp/dired-x.el index bfb5574da3..78fa5ed778 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dired.el b/lisp/dired.el index c7e28a4e71..782d8ffa51 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el index 6004c7c7ca..137a0cbfa5 100644 --- a/lisp/dirtrack.el +++ b/lisp/dirtrack.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 59cc8d61ee..1410e27329 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index c9dd28a40f..3b6b101de4 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dnd.el b/lisp/dnd.el index 3ae5e4f894..defd8a8e07 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 2eb555821d..a222076edb 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Requirements: diff --git a/lisp/dom.el b/lisp/dom.el index 52e7f4baf1..70938f539b 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/double.el b/lisp/double.el index ab9e23b301..91dc095fed 100644 --- a/lisp/double.el +++ b/lisp/double.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 3d80f9dd9a..41667e6188 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -92,4 +92,3 @@ Changes can be (define-key special-event-map [config-changed-event] 'dynamic-setting-handle-config-changed-event) - diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el index b399be5d30..51c33c64be 100644 --- a/lisp/ebuff-menu.el +++ b/lisp/ebuff-menu.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/echistory.el b/lisp/echistory.el index 2146faae1d..588f60521d 100644 --- a/lisp/echistory.el +++ b/lisp/echistory.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el index 70277facb0..ed23d9f5cc 100644 --- a/lisp/ecomplete.el +++ b/lisp/ecomplete.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 5fefc3102d..b050f4d64c 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ehelp.el b/lisp/ehelp.el index a3719f6391..1e89f84313 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 2a4895eb2b..7f523d1df4 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/electric.el b/lisp/electric.el index a71e79ff78..d7929945db 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/elide-head.el b/lisp/elide-head.el index 3904edd7f6..5bede73eaa 100644 --- a/lisp/elide-head.el +++ b/lisp/elide-head.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 3342bea209..32b6a47b05 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; LCD Archive Entry: ;; advice|Hans Chalupsky|hans@cs.buffalo.edu| diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index e811ee23fe..27426c4530 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -898,7 +898,7 @@ FILE's modification time." (autoload--save-buffer)))) ;; FIXME This command should be deprecated. -;; See http://debbugs.gnu.org/22213#41 +;; See https://debbugs.gnu.org/22213#41 ;;;###autoload (defun update-file-autoloads (file &optional save-after outfile) "Update the autoloads for FILE. @@ -917,7 +917,7 @@ Return FILE if there was no autoload cookie in it, else nil." (let* ((generated-autoload-file (or outfile generated-autoload-file)) (autoload-modified-buffers nil) ;; We need this only if the output file handles more than one input. - ;; See http://debbugs.gnu.org/22213#38 and subsequent. + ;; See https://debbugs.gnu.org/22213#38 and subsequent. (autoload-timestamps t) (no-autoloads (autoload-generate-file-autoloads file))) (if autoload-modified-buffers diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 32f7d2c6d8..8435b29b04 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index bb877dd2c9..4649cf343c 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el index a2217d2095..445e78b427 100644 --- a/lisp/emacs-lisp/benchmark.el +++ b/lisp/emacs-lisp/benchmark.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el index d345151907..0f86923518 100644 --- a/lisp/emacs-lisp/bindat.el +++ b/lisp/emacs-lisp/bindat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 962a7ae5cd..69f03c5166 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 4fa31dd4c2..c6ad209cd8 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c3bb777641..1b42961f1a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 4507af7a59..fe92288d54 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/chart.el b/lisp/emacs-lisp/chart.el index dc108f956c..2c37923353 100644 --- a/lisp/emacs-lisp/chart.el +++ b/lisp/emacs-lisp/chart.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el index c46426cd36..6d503bae2d 100644 --- a/lisp/emacs-lisp/check-declare.el +++ b/lisp/emacs-lisp/check-declare.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index bc67a6be51..7997ba6014 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 99df209d1a..214adbc581 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 1a3f8e1f4d..b2f76abd88 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index df0e0a8858..17e2434f58 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 6ac08d839b..da7176f662 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3405c92e8d..d90e70d3d8 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index ab6354de7c..e550f5a095 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index eb50d75687..87c03280f7 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 67ff1a00bd..6a21936ebc 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 306237ca38..5ac40234f0 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index b6936131fc..11569e4056 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index 0fad27cafe..2a417f1758 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/cursor-sensor.el b/lisp/emacs-lisp/cursor-sensor.el index e68b429258..b6e25b9684 100644 --- a/lisp/emacs-lisp/cursor-sensor.el +++ b/lisp/emacs-lisp/cursor-sensor.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 2b8782590c..0247179a84 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index fffe972460..3fa3818526 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 66673b4d26..90d5001c84 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 158b9212fb..bf087fc2e9 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 4fc9a783a5..35b2af1a3f 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 3190346497..dbc56e272f 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 33c71ec580..6b39b4f262 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index 8403a8a655..bf0bc85735 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 9d618e1dc8..22bf812fcb 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index e82eaa2b01..745bd89f06 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 8ef92df513..da8d9a017b 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index ba4331f126..f464d02467 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index 36ab2c165c..fb57453f39 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 8b92d5b7ac..75f1097acf 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index 8c16546198..cba9a00fa5 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -256,7 +256,7 @@ Otherwise work like `message'." (progn (add-hook 'minibuffer-exit-hook (lambda () (setq eldoc-mode-line-string nil - ;; http://debbugs.gnu.org/16920 + ;; https://debbugs.gnu.org/16920 eldoc-last-message nil)) nil t) (with-current-buffer diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index cce9553ff6..8d10a162b0 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 7bdd749d5a..2be9c9da86 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 1413b9cd0b..6d9a7d9211 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 579e5e0aad..d4276221ba 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -102,7 +102,7 @@ This is like `equal-including-properties' except that it compares the property values of text properties structurally (by recursing) rather than with `eq'. Perhaps this is what `equal-including-properties' should do in the first place; see -Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." +Emacs bug 6581 at URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; This implementation is inefficient. Rather than making it ;; efficient, let's hope bug 6581 gets fixed so that we can delete ;; it altogether. diff --git a/lisp/emacs-lisp/ewoc.el b/lisp/emacs-lisp/ewoc.el index cc574568d5..e1b94a3ec9 100644 --- a/lisp/emacs-lisp/ewoc.el +++ b/lisp/emacs-lisp/ewoc.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 9b98f05ae8..29c42f3693 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index a33937cd75..18ba834b91 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index fe5d2d0728..f3597cc387 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index 165b0d4507..14208857bc 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 42b1c21695..892d6e9716 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index 78611c661a..9dc59467ff 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index cf8e2f22d8..00e5e6eb48 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/let-alist.el b/lisp/emacs-lisp/let-alist.el index cf82fe3ec6..70a58c4b1c 100644 --- a/lisp/emacs-lisp/let-alist.el +++ b/lisp/emacs-lisp/let-alist.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index a1c5b6977f..4e4957faa1 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index fa25a0c397..fd12635d85 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 0c1fe42fed..c3d62fd59b 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 9bc194c478..b7496d5a60 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el index af7a9ee4ab..d055a54fb3 100644 --- a/lisp/emacs-lisp/map-ynp.el +++ b/lisp/emacs-lisp/map-ynp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index e098eef829..0f9a74422b 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -22,7 +22,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index c68ecbc59e..c638d5df51 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -17,7 +17,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index a3d90f4fb1..923da4681a 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 7301dbd61d..8b101c1323 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 5935845743..c703cae445 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 7ef46a48bd..d9cd37e9ec 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index b5e7589b95..053dd452ea 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index 2eff1d1ab3..84925cb335 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 5feaad88c7..ef91eb4b97 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/regi.el b/lisp/emacs-lisp/regi.el index 351dba560f..9f612a146a 100644 --- a/lisp/emacs-lisp/regi.el +++ b/lisp/emacs-lisp/regi.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el index b0ec3bcbe0..69754b05e2 100644 --- a/lisp/emacs-lisp/ring.el +++ b/lisp/emacs-lisp/ring.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index b66f2c6d51..54755a7dc1 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 23e444fe24..2861ed75ce 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index df586486d3..103e131ea3 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 7baccbc752..87c4782e21 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -18,7 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 8d41f9298b..077ad22c75 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index d1d5176944..f613783785 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 6844c25b1a..e940588db7 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index efcaeedd11..7e4beb6743 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . (require 'testcover) diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el index f9bf9a4c73..69ae175eff 100644 --- a/lisp/emacs-lisp/tcover-unsafep.el +++ b/lisp/emacs-lisp/tcover-unsafep.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . (require 'testcover) diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 17891fd609..691860bbd7 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/thunk.el b/lisp/emacs-lisp/thunk.el index f4c075d22c..bb6d277c27 100644 --- a/lisp/emacs-lisp/thunk.el +++ b/lisp/emacs-lisp/thunk.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index 1a38254bcb..fb0e98c5b8 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index d872256dad..1de3043cd9 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el index 3f5d78df31..31bb9d1b96 100644 --- a/lisp/emacs-lisp/tq.el +++ b/lisp/emacs-lisp/tq.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el index 1c57d7363c..4a83937acb 100644 --- a/lisp/emacs-lisp/trace.el +++ b/lisp/emacs-lisp/trace.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; LCD Archive Entry: ;; trace|Hans Chalupsky|hans@cs.buffalo.edu| diff --git a/lisp/emacs-lisp/unsafep.el b/lisp/emacs-lisp/unsafep.el index 1ab65a044e..88f053d9f7 100644 --- a/lisp/emacs-lisp/unsafep.el +++ b/lisp/emacs-lisp/unsafep.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el index 671d2795c3..2765877f3e 100644 --- a/lisp/emacs-lisp/warnings.el +++ b/lisp/emacs-lisp/warnings.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el index dbf6ac8844..6624c99cdb 100644 --- a/lisp/emacs-lock.el +++ b/lisp/emacs-lock.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 63b8e9bf93..9d97fee4e3 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el index baa430e5b7..9d51f4a717 100644 --- a/lisp/emulation/cua-gmrk.el +++ b/lisp/emulation/cua-gmrk.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 3538181dfa..339203414e 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Acknowledgments diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el index 9afb25ca09..354d288985 100644 --- a/lisp/emulation/edt-lk201.el +++ b/lisp/emulation/edt-lk201.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index 457ad55dd6..963da2ba59 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el index 3ea249fe79..c59ad9799d 100644 --- a/lisp/emulation/edt-pc.el +++ b/lisp/emulation/edt-pc.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el index a8c186b166..98f51dabc1 100644 --- a/lisp/emulation/edt-vt100.el +++ b/lisp/emulation/edt-vt100.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index a6b2d785ac..bdb606c69e 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . diff --git a/lisp/emulation/keypad.el b/lisp/emulation/keypad.el index 0c7135e78b..aea2440627 100644 --- a/lisp/emulation/keypad.el +++ b/lisp/emulation/keypad.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index a697aa7d03..21200ae02a 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 185cf990f7..7d52d5a3a1 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index a67dd4d762..3fd492b3dd 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index a18833d250..6227e33417 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 1353f7e177..d79fa454f3 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 2600c50322..d36f57352f 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index e32b41f575..e09a2bb9a6 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index bded174b0d..2a66262f6c 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -30,7 +30,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/env.el b/lisp/env.el index 859f280802..5f8c4f5e5c 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el index 5eb6ca50a3..cbf8b974d8 100644 --- a/lisp/epa-dired.el +++ b/lisp/epa-dired.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epa-file.el b/lisp/epa-file.el index c97acb837a..7b5ad38f70 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index c6577c81eb..5f12a15336 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 7069273afa..1eb73e3132 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epa.el b/lisp/epa.el index 52963b6d3c..6e908e1aa3 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 6aed354ca4..dff5e99a8d 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/epg.el b/lisp/epg.el index 1e24b8d116..8a4696627e 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/erc/erc-autoaway.el b/lisp/erc/erc-autoaway.el index 827527966c..aa74957fc9 100644 --- a/lisp/erc/erc-autoaway.el +++ b/lisp/erc/erc-autoaway.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 3368d6701a..89923257dd 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el index ee5d6fe09e..606e1a28e1 100644 --- a/lisp/erc/erc-button.el +++ b/lisp/erc/erc-button.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index 0d3b23701c..12f6120419 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 1ad66802fe..ec79046643 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 542e1909cb..8003661e57 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-desktop-notifications.el b/lisp/erc/erc-desktop-notifications.el index 113f1cffa6..47504c91e4 100644 --- a/lisp/erc/erc-desktop-notifications.el +++ b/lisp/erc/erc-desktop-notifications.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-ezbounce.el b/lisp/erc/erc-ezbounce.el index 94735787e2..3af1bd7f7a 100644 --- a/lisp/erc/erc-ezbounce.el +++ b/lisp/erc/erc-ezbounce.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-fill.el b/lisp/erc/erc-fill.el index d58ccfa9a9..2ca67d2036 100644 --- a/lisp/erc/erc-fill.el +++ b/lisp/erc/erc-fill.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 1f27036f40..a655d48a6a 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-ibuffer.el b/lisp/erc/erc-ibuffer.el index cb9c21fc3c..03d51d9879 100644 --- a/lisp/erc/erc-ibuffer.el +++ b/lisp/erc/erc-ibuffer.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -189,4 +189,3 @@ ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-identd.el b/lisp/erc/erc-identd.el index 61360f40f5..c237325e48 100644 --- a/lisp/erc/erc-identd.el +++ b/lisp/erc/erc-identd.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -118,4 +118,3 @@ The default port is specified by `erc-identd-port'." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-imenu.el b/lisp/erc/erc-imenu.el index 95c2b35c69..9440cb10e7 100644 --- a/lisp/erc/erc-imenu.el +++ b/lisp/erc/erc-imenu.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -134,4 +134,3 @@ Don't rely on this function, read it first!" ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index aa83ffe92a..3c4136c261 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -218,4 +218,3 @@ This function is run from `erc-nickserv-identified-hook'." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-lang.el b/lisp/erc/erc-lang.el index 4aa31529da..7551b1d2e1 100644 --- a/lisp/erc/erc-lang.el +++ b/lisp/erc/erc-lang.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -180,7 +180,7 @@ This is based on the technical contents of ISO 639:1988 (E/F) \"Code for the representation of names of languages\". Typed by Keld.Simonsen@dkuug.dk 1990-11-30 - + Minor corrections, 1992-09-08 by Keld Simonsen Sundanese corrected, 1992-11-11 by Keld Simonsen Telugu corrected, 1995-08-24 by Keld Simonsen diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 7d6413ee7f..4248c6a5fe 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -228,4 +228,3 @@ to RFC and send the LIST header (#321) at start of list transmission." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 09cffdcd84..b8b00297a5 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 3f6b1e546a..60e9425ce3 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-menu.el b/lisp/erc/erc-menu.el index 9db1e75435..79e583138d 100644 --- a/lisp/erc/erc-menu.el +++ b/lisp/erc/erc-menu.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -151,4 +151,3 @@ ERC menu yet.") ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-netsplit.el b/lisp/erc/erc-netsplit.el index 583e071c67..71ac0101ca 100644 --- a/lisp/erc/erc-netsplit.el +++ b/lisp/erc/erc-netsplit.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -151,7 +151,7 @@ join from that split has been detected or not.") (when (nth 2 ass) ;; There was already a netjoin for this netsplit, it ;; seems like the old one didn't get finished... - (erc-display-message + (erc-display-message parsed 'notice (process-buffer proc) 'netsplit ?s split) (setcar (nthcdr 2 ass) t) @@ -208,4 +208,3 @@ join from that split has been detected or not.") ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 59a9356c2a..bf964bc6ba 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-notify.el b/lisp/erc/erc-notify.el index 54c8bebab3..983773d3fb 100644 --- a/lisp/erc/erc-notify.el +++ b/lisp/erc/erc-notify.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-page.el b/lisp/erc/erc-page.el index d441b099bb..1b453c5b5f 100644 --- a/lisp/erc/erc-page.el +++ b/lisp/erc/erc-page.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -110,4 +110,3 @@ receive pages if `erc-page-mode' is on." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index 6dfe0a7786..893bcc0564 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -225,7 +225,7 @@ If optional argument IGNORE-SELF is non-nil, don't return the current nick." (erc-get-channel-user-list))) (nicks nil)) (dolist (user users) - (unless (or (not user) + (unless (or (not user) (and ignore-self (string= (erc-server-user-nickname (car user)) (erc-current-nick)))) @@ -286,4 +286,3 @@ up to where point is right now." ;; Local Variables: ;; indent-tabs-mode: nil ;; End: - diff --git a/lisp/erc/erc-replace.el b/lisp/erc/erc-replace.el index ec443ec022..0b27076de5 100644 --- a/lisp/erc/erc-replace.el +++ b/lisp/erc/erc-replace.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -93,4 +93,3 @@ It replaces text according to `erc-replace-alist'." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-ring.el b/lisp/erc/erc-ring.el index 4e31ec20a6..174eac2c5e 100644 --- a/lisp/erc/erc-ring.el +++ b/lisp/erc/erc-ring.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-services.el b/lisp/erc/erc-services.el index 6e7c918316..bce771112e 100644 --- a/lisp/erc/erc-services.el +++ b/lisp/erc/erc-services.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-sound.el b/lisp/erc/erc-sound.el index 4ca7a59bbb..8992639e1b 100644 --- a/lisp/erc/erc-sound.el +++ b/lisp/erc/erc-sound.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -148,4 +148,3 @@ See also `play-sound-file'." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-speedbar.el b/lisp/erc/erc-speedbar.el index 4f44f415fd..f530470ec5 100644 --- a/lisp/erc/erc-speedbar.el +++ b/lisp/erc/erc-speedbar.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-spelling.el b/lisp/erc/erc-spelling.el index 9b0e5faaf6..2ccc54fa9c 100644 --- a/lisp/erc/erc-spelling.el +++ b/lisp/erc/erc-spelling.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-stamp.el b/lisp/erc/erc-stamp.el index 7ce22b380d..2796722a94 100644 --- a/lisp/erc/erc-stamp.el +++ b/lisp/erc/erc-stamp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -420,4 +420,3 @@ enabled when the message was inserted." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index c49971e872..b1b893bf2b 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/erc/erc-truncate.el b/lisp/erc/erc-truncate.el index 7f5bb326b7..a50e2fbe5e 100644 --- a/lisp/erc/erc-truncate.el +++ b/lisp/erc/erc-truncate.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -115,4 +115,3 @@ Meant to be used in hooks, like `erc-insert-post-hook'." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc-xdcc.el b/lisp/erc/erc-xdcc.el index 4b0b7b9afa..290e56e423 100644 --- a/lisp/erc/erc-xdcc.el +++ b/lisp/erc/erc-xdcc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -136,4 +136,3 @@ being evaluated and should return strings." ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8547821f08..ab36371b9c 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -28,20 +28,20 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ERC is a powerful, modular, and extensible IRC client for Emacs. ;; For more information, see the following URLs: -;; * http://sv.gnu.org/projects/erc/ +;; * https://sv.gnu.org/projects/erc/ ;; * http://www.emacswiki.org/cgi-bin/wiki/ERC ;; As of 2006-06-13, ERC development is now hosted on Savannah -;; (http://sv.gnu.org/projects/erc). I invite everyone who wants to +;; (https://sv.gnu.org/projects/erc). I invite everyone who wants to ;; hack on it to contact me in order to get write ;; access to the shared Arch archive. diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index 990eb02024..f951efa65d 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-banner.el b/lisp/eshell/em-banner.el index aee7daa49f..268b4289f4 100644 --- a/lisp/eshell/em-banner.el +++ b/lisp/eshell/em-banner.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 47c2cb4dab..33ce3b5e93 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-cmpl.el b/lisp/eshell/em-cmpl.el index 571348620b..c64c2df342 100644 --- a/lisp/eshell/em-cmpl.el +++ b/lisp/eshell/em-cmpl.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index c10ff16ef2..0d87f2a599 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index fee3ff2098..11d7ffcfc5 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-hist.el b/lisp/eshell/em-hist.el index 5c6e629120..1ab3c60b2c 100644 --- a/lisp/eshell/em-hist.el +++ b/lisp/eshell/em-hist.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 38e38132bf..bb087d2feb 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 9e6890ebc9..72a7bc4afc 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 2fd1db2113..76dd13ff84 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-rebind.el b/lisp/eshell/em-rebind.el index a1f9054dae..07f4318e58 100644 --- a/lisp/eshell/em-rebind.el +++ b/lisp/eshell/em-rebind.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el index b8333adf55..bbc2f9acf6 100644 --- a/lisp/eshell/em-script.el +++ b/lisp/eshell/em-script.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el index 718198689f..f79f46387b 100644 --- a/lisp/eshell/em-smart.el +++ b/lisp/eshell/em-smart.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ea38f12124..261a32e97c 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index d2697227bc..e322cea1e2 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 86e0d829a1..a86596953d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index fe839de03a..7b80f64d62 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index 7843ca166b..b317f4e1d2 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 2434220877..6c26af8999 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 0b292306ff..14ae6b4ae1 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-io.el b/lisp/eshell/esh-io.el index 97d48c1fd0..ca791982f5 100644 --- a/lisp/eshell/esh-io.el +++ b/lisp/eshell/esh-io.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 0999f9c4a8..ea2fe1a6c2 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-module.el b/lisp/eshell/esh-module.el index cbff8c8411..fe4c88e1cf 100644 --- a/lisp/eshell/esh-module.el +++ b/lisp/eshell/esh-module.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index 59757ab6eb..c141fe0bce 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index ba5cb5c2db..3e9ac281a1 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index d65839b72a..c204ec869b 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index cdd05bd7e9..d038609d95 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el index faf5f89d64..f85f0e82b3 100644 --- a/lisp/eshell/eshell.el +++ b/lisp/eshell/eshell.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/expand.el b/lisp/expand.el index d06287e6f9..7dab2051f1 100644 --- a/lisp/expand.el +++ b/lisp/expand.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/ezimage.el b/lisp/ezimage.el index 25e0ed306a..115ebc5670 100644 --- a/lisp/ezimage.el +++ b/lisp/ezimage.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 4e6ada8acd..129b90301b 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: diff --git a/lisp/facemenu.el b/lisp/facemenu.el index ae5865d739..5db640ba25 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/faces.el b/lisp/faces.el index d9c90fda6b..f85d31e6c8 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ffap.el b/lisp/ffap.el index 8bcfbfcdff..2228aca081 100644 --- a/lisp/ffap.el +++ b/lisp/ffap.el @@ -6,7 +6,6 @@ ;; Maintainer: emacs-devel@gnu.org ;; Created: 29 Mar 1993 ;; Keywords: files, hypermedia, matching, mouse, convenience -;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ ;; This file is part of GNU Emacs. @@ -21,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/filecache.el b/lisp/filecache.el index 02b5f79c07..38a434b11b 100644 --- a/lisp/filecache.el +++ b/lisp/filecache.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 6a3b9e1743..18c44ec3e1 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary diff --git a/lisp/files-x.el b/lisp/files-x.el index b7c6f51e65..667737075e 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/files.el b/lisp/files.el index 72ace24644..c55c8097c1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/filesets.el b/lisp/filesets.el index 4542d6a5ef..c2bdec0e6d 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/find-cmd.el b/lisp/find-cmd.el index 93abe02f14..9801ee3afa 100644 --- a/lisp/find-cmd.el +++ b/lisp/find-cmd.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/find-dired.el b/lisp/find-dired.el index 2292b5f32d..2d2540b133 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/find-file.el b/lisp/find-file.el index d3691694d1..8b45c9d5be 100644 --- a/lisp/find-file.el +++ b/lisp/find-file.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index a795211f4f..e079e15b0a 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/finder.el b/lisp/finder.el index 361572f7c2..b599c440fa 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -209,7 +209,7 @@ from; the default is `load-path'." ;; There are multiple files in the tree with the same basename. ;; So skipping files based on basename means you randomly (depending ;; on which order the files are traversed in) miss some packages. -;; http://debbugs.gnu.org/14010 +;; https://debbugs.gnu.org/14010 ;; You might think this could lead to two files providing the same package, ;; but it does not, because the duplicates are (at time of writing) ;; all due to files in cedet, which end up with package-override set. diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el index c0609b0c3a..5b16ee4214 100644 --- a/lisp/flow-ctrl.el +++ b/lisp/flow-ctrl.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/foldout.el b/lisp/foldout.el index da69f8b259..3f6485434d 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/follow.el b/lisp/follow.el index 5dd74f37a1..761513bae3 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/font-core.el b/lisp/font-core.el index f64e1b646a..06b36a2351 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 5eedb7849a..3c9660dc64 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/format-spec.el b/lisp/format-spec.el index 95ed000452..fecf9d77b5 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/format.el b/lisp/format.el index cbcba8250d..dbb40485c7 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/forms.el b/lisp/forms.el index e13dc170cb..dacbd8c467 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/frame.el b/lisp/frame.el index 2a14302e9f..5f0e97d5b0 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/frameset.el b/lisp/frameset.el index ebf09d3ab5..661f0aee27 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/fringe.el b/lisp/fringe.el index acd13b54b1..3cb6f9d115 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 8823faac0f..09a5488a17 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 5157256594..bb666ff934 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index af8ccf182e..897ca7048b 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 45035646f7..4050046aab 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index 93d86526af..daf578180f 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 226a56e187..986bb47337 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -4244,7 +4244,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (defun article-verify-x-pgp-sig () "Verify X-PGP-Sig." - ;; + ;; (interactive) (if (gnus-buffer-live-p gnus-original-article-buffer) (let ((sig (with-current-buffer gnus-original-article-buffer diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 11e765d2d7..b9aa763bcd 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index ff8fcca61f..30f377feea 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index 655881396c..cef7df5e91 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index fa3df7b14a..12c8903d02 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index 3194e966f0..3cd98ce680 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el index 605dda2509..5ea2d691f1 100644 --- a/lisp/gnus/gnus-cloud.el +++ b/lisp/gnus/gnus-cloud.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index e5787e8625..600b33f226 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index 7b59967912..0917b023af 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 81f9650ae3..28e2699a6a 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index b81c6d08f5..5000486d19 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index 10533cafd9..9394c3d770 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 6e7b307770..77bf93af50 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index f91ebbeff1..2f21efb6ee 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index 93af05f4b3..6f8722b0c7 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 787c0e3a0f..1b45847c0b 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el index b4763c7681..bcf09f434e 100644 --- a/lisp/gnus/gnus-gravatar.el +++ b/lisp/gnus/gnus-gravatar.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 8a061b70bf..985efe6272 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -2429,7 +2429,7 @@ Valid input formats include: (gnus-read-ephemeral-gmane-group group start range))) (defcustom gnus-bug-group-download-format-alist - '((emacs . "http://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes") + '((emacs . "https://debbugs.gnu.org/cgi/bugreport.cgi?bug=%s;mboxmaint=yes;mboxstat=yes") (debian . "http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=%s&mbox=yes;mboxmaint=yes")) "Alist of symbols for bug trackers and the corresponding URL format string. diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index d4dccfb7b1..6d529558f7 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 1f194f888d..cca4a81d1c 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index aaeba4a433..0c7381286c 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index c405c04e38..4c15471b97 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index b1499722f4..4762025bf7 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index 502b295cd6..9062292673 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 32cf171331..e3cdd9c393 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index c42c34adce..cd6bbd0357 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 85969edc81..7a28be19d4 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-notifications.el b/lisp/gnus/gnus-notifications.el index 288dbe1b9f..e97e6a6433 100644 --- a/lisp/gnus/gnus-notifications.el +++ b/lisp/gnus/gnus-notifications.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 41463e3f02..da56b4eef0 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 0680123e34..b30b2e9099 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index 51f6459d2f..466238d252 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el index a47e19b8f0..6477d0114a 100644 --- a/lisp/gnus/gnus-rfc1843.el +++ b/lisp/gnus/gnus-rfc1843.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 7037328b7a..ab2ffa9228 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 19cf799a2f..11a45dda9a 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -43,7 +43,7 @@ for each score file or each score file directory. Gnus will decide by itself what score files are applicable to which group. Say you want to use the single score file -\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all +\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" and all score files in the \"/ftp.some-where:/pub/score\" directory. (setq gnus-global-score-files diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index 2c5fd34f8c..00f0636cf7 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 809371d610..a614906258 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index bed5993b9c..82056cf165 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index aaa8ab9a88..3c3c594fe7 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 0259692967..48571096cc 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -9844,7 +9844,7 @@ IDNA encoded domain names looks like `xn--bar'. If a string remain unencoded after running this function, it is likely an invalid IDNA string (`xn--bar' is invalid). -You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') +You must have GNU Libidn (URL `https://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") (gnus-summary-select-article) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index 6d6e20dc12..ea42a3e505 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index 74e0601c6e..23cabadad6 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 93541f0db6..b7477a7fa8 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 6219217349..526d00754b 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index 143500cc04..e05f849bb3 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 255bb5f42e..8e47ae3f98 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index d3edcd0851..8c0846be9f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el index b569c7f16c..b6801f7885 100644 --- a/lisp/gnus/gssapi.el +++ b/lisp/gnus/gssapi.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index e51181ef5f..84db6c3528 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index e15d820a27..3befd46620 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 80f270a0c1..690dd28c8a 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-archive.el b/lisp/gnus/mm-archive.el index 103cc89c35..0451f21758 100644 --- a/lisp/gnus/mm-archive.el +++ b/lisp/gnus/mm-archive.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index d773289722..319d789c00 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 9b77dadddb..c6ac0567fb 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 1a9b5ab3de..248992ea96 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index a6e76ff7be..79d9ae3741 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index e3e6f5d780..68008ea0d2 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index 5c8f99b048..39e1af9492 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index 89f397e3ed..a7db3dadbc 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 177589c5f0..436235c463 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index fb80e6bf3c..86e217131a 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 57c371a65f..80bd8d0e06 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 1821d1a49f..c6bc612a8f 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index ce28607a04..9ee2c95b7c 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 0df908f2a2..86370729de 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index f973670e8e..11f3f750f3 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index 2b4843488c..025c3d3cad 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 5aa481e067..c61cbc8d7c 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 0390b5b8d2..2589fa8089 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index 718306abce..7eb3e824bc 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 7f7db8721d..e9e769cac5 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 12a1b2b284..62a1575270 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 6850cad2e6..f6bf586697 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 18c92f9f77..9b1317347a 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el index 1e57f7c6f6..63bd063cbd 100644 --- a/lisp/gnus/nngateway.el +++ b/lisp/gnus/nngateway.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 4440f17c2b..0ea99d53a4 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 6424d9d780..6e2a735233 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index 9640f2c746..51147ed433 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 71d9631776..db5415cf9f 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 03cb445675..272240f5a9 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index a678a79743..7c96171623 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index c854f19c7c..3a33fb9075 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index bec174db86..050f0cd2dd 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index b0c7bf41ad..b7d1bc2237 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el index e40126d6e0..7d400791fa 100644 --- a/lisp/gnus/nnnil.el +++ b/lisp/gnus/nnnil.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index 77e7f2a2d0..be38f8d1d7 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnregistry.el b/lisp/gnus/nnregistry.el index b1a2416e2f..fac332af97 100644 --- a/lisp/gnus/nnregistry.el +++ b/lisp/gnus/nnregistry.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 8115057723..9a3a562a5d 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index 1db0a4192a..b14b5cde8d 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index a71f4c7b5d..ad93815b9c 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index dcd610317e..543f7b66c4 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index 8e5b20047f..4327824c7e 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index d106cf0c27..098ecd5dc3 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index 763a1cd5be..3a94863633 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index e3c284f033..f62b65a066 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 17a7f89ae9..b45b487d9e 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 5466cf9edd..08d382bcbd 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el index bcdde736b3..04e62903d9 100644 --- a/lisp/gnus/spam-wash.el +++ b/lisp/gnus/spam-wash.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 5f0ea94b28..6378e3e97e 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index 87b9e50c9d..46229bcb91 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 15b2c07ba2..d75fec2b56 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/help-macro.el b/lisp/help-macro.el index c8f93bc5e5..3181a492ff 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 24dfb9120b..a98bce0138 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/help.el b/lisp/help.el index bc7ee2c9b1..bc8035db0e 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -306,7 +306,7 @@ If that doesn't give a function, return nil." (defun describe-gnu-project () "Browse online information on the GNU project." (interactive) - (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) + (browse-url "https://www.gnu.org/gnu/thegnuproject.html")) (define-obsolete-function-alias 'describe-project 'describe-gnu-project "22.2") @@ -1335,7 +1335,7 @@ The result, when formatted by `substitute-command-keys', should equal STRING." ;; The following functions used to be in help-fns.el, which is not preloaded. ;; But for various reasons, they are more widely needed, so they were -;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001 +;; moved to this file, which is preloaded. https://debbugs.gnu.org/17001 (defun help-split-fundoc (docstring def) "Split a function DOCSTRING into the actual doc and the usage info. diff --git a/lisp/hex-util.el b/lisp/hex-util.el index e2e3d7f07c..5289f06f4e 100644 --- a/lisp/hex-util.el +++ b/lisp/hex-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/hexl.el b/lisp/hexl.el index 0a598b22f6..f591439558 100644 --- a/lisp/hexl.el +++ b/lisp/hexl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el index 6fcaad085d..4dddc17b59 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 36901c302d..e3552fcac3 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/hilit-chg.el b/lisp/hilit-chg.el index 1a41056481..4979ed84b6 100644 --- a/lisp/hilit-chg.el +++ b/lisp/hilit-chg.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el index 8dc53bd8ec..be3fedf0af 100644 --- a/lisp/hippie-exp.el +++ b/lisp/hippie-exp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/hl-line.el b/lisp/hl-line.el index 38fe683785..9ccc354e84 100644 --- a/lisp/hl-line.el +++ b/lisp/hl-line.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 74393ffbae..791b110bf4 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -29,7 +29,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 8bcd18864c..686bc392b6 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 2e751cebd6..e0c91e20ed 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index c83c21315a..fed9e75f17 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/icomplete.el b/lisp/icomplete.el index a4153e806d..038f58f730 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ido.el b/lisp/ido.el index 23669d22d1..23c039d32e 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -497,7 +497,7 @@ as first char even if `ido-enable-prefix' is nil." :type 'boolean :group 'ido) -;; See http://debbugs.gnu.org/2042 for more info. +;; See https://debbugs.gnu.org/2042 for more info. (defcustom ido-buffer-disable-smart-matches t "Non-nil means not to re-order matches for buffer switching. By default, Ido arranges matches in the following order: @@ -4835,7 +4835,7 @@ Modified from `icomplete-completions'." (put 'dired 'ido 'dir) (put 'dired-other-window 'ido 'dir) (put 'dired-other-frame 'ido 'dir) -;; See http://debbugs.gnu.org/11954 for reasons. +;; See https://debbugs.gnu.org/11954 for reasons. (put 'dired-do-copy 'ido 'ignore) (put 'dired-do-rename 'ido 'ignore) diff --git a/lisp/ielm.el b/lisp/ielm.el index 42b065fe62..4ec195528c 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/iimage.el b/lisp/iimage.el index abb88ec502..7226476fac 100644 --- a/lisp/iimage.el +++ b/lisp/iimage.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 49dba52c88..f48f1a1b87 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/image-file.el b/lisp/image-file.el index 33cea95d53..285151df90 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 4b92e8673a..87d18fd3c4 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/image.el b/lisp/image.el index 8cea7fb2c8..1d0776180b 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/image/compface.el b/lisp/image/compface.el index f4c3d5f4df..ccbd0a3e3b 100644 --- a/lisp/image/compface.el +++ b/lisp/image/compface.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/image/gravatar.el b/lisp/image/gravatar.el index 54ca3be96a..6628195cfa 100644 --- a/lisp/image/gravatar.el +++ b/lisp/image/gravatar.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/imenu.el b/lisp/imenu.el index c1fd4005ab..e2c946c3a0 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/indent.el b/lisp/indent.el index e7a30b885d..d5ba0bd849 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/info-look.el b/lisp/info-look.el index 6963c78270..f52f48edec 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -31,9 +31,9 @@ ;; ;; Scheme: ;; LaTeX: -;; +;; ;; (or CTAN mirrors) -;; Perl: (or CPAN mirrors) +;; Perl: (or CPAN mirrors) ;; Traditionally, makeinfo quoted `like this', but version 5 and later ;; quotes 'like this' or ‘like this’. Doc specs with patterns @@ -959,7 +959,7 @@ Return nil if there is nothing appropriate in the buffer near point." :mode 'scheme-mode :regexp "[^()`'‘’,\" \t\n]+" :ignore-case t - ;; Aubrey Jaffer's rendition from + ;; Aubrey Jaffer's rendition from :doc-spec '(("(r5rs)Index" nil "^[ \t]+-+ [^:]+:[ \t]*" "\\b"))) diff --git a/lisp/info-xref.el b/lisp/info-xref.el index 8c029d46b3..4fc7c4f699 100644 --- a/lisp/info-xref.el +++ b/lisp/info-xref.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/info.el b/lisp/info.el index b0b4789edd..993dc079a8 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -4023,7 +4023,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (define-key map "h" 'Info-help) ;; This is for compatibility with standalone info (>~ version 5.2). ;; Though for some time, standalone info had H and h reversed. - ;; See . + ;; See . (define-key map "H" 'describe-mode) (define-key map "i" 'Info-index) (define-key map "I" 'Info-virtual-index) diff --git a/lisp/informat.el b/lisp/informat.el index b35e2ed379..a1ed7a9484 100644 --- a/lisp/informat.el +++ b/lisp/informat.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index aa9bd2d11c..0ac79562e2 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/characters.el b/lisp/international/characters.el index e48fc83c3d..51d8765f8b 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 8a1a9cfc58..c6c62ef0a0 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/isearch-x.el b/lisp/international/isearch-x.el index 40bdb38b22..dce323e429 100644 --- a/lisp/international/isearch-x.el +++ b/lisp/international/isearch-x.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el index 39f1e9f46b..327657512a 100644 --- a/lisp/international/iso-ascii.el +++ b/lisp/international/iso-ascii.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el index ebf90a3122..69969d6857 100644 --- a/lisp/international/iso-cvt.el +++ b/lisp/international/iso-cvt.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This lisp code is a general framework for translating various diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el index a665a39b63..8695847482 100644 --- a/lisp/international/iso-transl.el +++ b/lisp/international/iso-transl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 63eede093d..f5220b04cd 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/ja-dic-utl.el b/lisp/international/ja-dic-utl.el index 7005ba8572..86ba3749df 100644 --- a/lisp/international/ja-dic-utl.el +++ b/lisp/international/ja-dic-utl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/kinsoku.el b/lisp/international/kinsoku.el index f87d2e9ed1..9f20b3e978 100644 --- a/lisp/international/kinsoku.el +++ b/lisp/international/kinsoku.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/kkc.el b/lisp/international/kkc.el index 17a3b6c2db..261c1c658c 100644 --- a/lisp/international/kkc.el +++ b/lisp/international/kkc.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el index 4b09bfbd19..761b9643d9 100644 --- a/lisp/international/latexenc.el +++ b/lisp/international/latexenc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index d9b71c8f44..7919248667 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index a596411eb7..9d22d6e8dd 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index a7764b6a53..d4bdfd4958 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 655a5ca6d4..e1e60d192e 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 257f8854c3..ca84a23077 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 6cfb7e6d45..5f1ef5e7d0 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el index cabcf90078..bdd621fe9a 100644 --- a/lisp/international/ogonek.el +++ b/lisp/international/ogonek.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/quail.el b/lisp/international/quail.el index c94c9fc1be..448ea8e057 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/rfc1843.el b/lisp/international/rfc1843.el index 9b91854714..494de1d5a9 100644 --- a/lisp/international/rfc1843.el +++ b/lisp/international/rfc1843.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -54,9 +54,7 @@ HZ-encoded are decoded." "HZ+ decoding support if non-nil. HZ+ specification (also known as HZP) is to provide a standardized 7-bit representation of mixed Big5, GB, and ASCII text for convenient -e-mail transmission, news posting, etc. -The document of HZ+ 0.78 specification can be found at -ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" +e-mail transmission, news posting, etc." :type 'boolean :group 'mime) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index 077809b6c1..94d2bf1808 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index 130bc742a5..5c6db19bb3 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -647,7 +647,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; details. ;; ;; You should have received a copy of the GNU General Public License along with -;; CCE. If not, see .") +;; CCE. If not, see .") ("chinese-ziranma" "$AWTH;(B" "ziranma.cin" cn-gb-2312 "ZIRANMA.el" @@ -675,7 +675,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; details. ;; ;; You should have received a copy of the GNU General Public License along with -;; CCE. If not, see .") +;; CCE. If not, see .") ("chinese-ctlau" "$AAuTA(B" "CTLau.html" cn-gb-2312 "CTLau.el" @@ -700,7 +700,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # GNU General Public License for more details. ;; # ;; # You should have received a copy of the GNU General Public License -;; # along with this program. If not, see .") +;; # along with this program. If not, see .") ("chinese-ctlaub" "$(0N,Gn(B" "CTLau-b5.html" big5 "CTLau-b5.el" @@ -725,7 +725,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\"." ;; # GNU General Public License for more details. ;; # ;; # You should have received a copy of the GNU General Public License -;; # along with this program. If not, see .") +;; # along with this program. If not, see .") )) ;; Generate a code of a Quail package in the current buffer from Tsang diff --git a/lisp/international/ucs-normalize.el b/lisp/international/ucs-normalize.el index b510fe1aec..08231080f8 100644 --- a/lisp/international/ucs-normalize.el +++ b/lisp/international/ucs-normalize.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/international/utf-7.el b/lisp/international/utf-7.el index 16942cecee..82f725cccb 100644 --- a/lisp/international/utf-7.el +++ b/lisp/international/utf-7.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -79,7 +79,7 @@ ESC and SKIP-CHARS are adjusted for the normal and IMAP versions." (esc (if imap ?& ?+)) ;; These are characters which can be encoded asis. (skip-chars (if imap - "\t\n\r\x20-\x25\x27-\x7e" ; rfc2060 + "\t\n\r\x20-\x25\x27-\x7e" ; rfc2060 ;; This includes the rfc2152 optional set. ;; Perhaps it shouldn't (like iconv). "\t\n\r -*,-[]-}")) diff --git a/lisp/international/utf7.el b/lisp/international/utf7.el index f245d7eb69..68081b23a8 100644 --- a/lisp/international/utf7.el +++ b/lisp/international/utf7.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/isearch.el b/lisp/isearch.el index 5f34dcadb5..7c576a67d4 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/isearchb.el b/lisp/isearchb.el index 16a08dc9e4..86275f80f8 100644 --- a/lisp/isearchb.el +++ b/lisp/isearchb.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index 8537dae7f8..33a941676d 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -602,7 +602,7 @@ non-nil in a repeated invocation of this function." (save-restriction ;; Don't be blindsided by narrowing that starts in the middle ;; of a jit-lock-defer-multiline. - (widen) + (widen) (when (and (>= jit-lock-context-unfontify-pos (point-min)) (< jit-lock-context-unfontify-pos (point-max))) ;; If we're in text that matches a complex multi-line diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index 0dedaa5ba0..b1bdc278fe 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 9e780f82b3..07b9033e24 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/json.el b/lisp/json.el index 025a77d4b0..7e924b6777 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/kermit.el b/lisp/kermit.el index f1900b4853..8863f2ed1a 100644 --- a/lisp/kermit.el +++ b/lisp/kermit.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 2db8061fa4..582a58eda1 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/burmese.el b/lisp/language/burmese.el index 420e8d7491..25425ec485 100644 --- a/lisp/language/burmese.el +++ b/lisp/language/burmese.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -56,4 +56,3 @@ (vector "." 0 'font-shape-gstring)))) (set-char-table-range composition-function-table '(#x1000 . #x107F) elt) (set-char-table-range composition-function-table '(#xAA60 . #xAA7B) elt)) - diff --git a/lisp/language/cham.el b/lisp/language/cham.el index a025ff0d20..4749f2e8db 100644 --- a/lisp/language/cham.el +++ b/lisp/language/cham.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/china-util.el b/lisp/language/china-util.el index 955c2999b8..f5174fb5e9 100644 --- a/lisp/language/china-util.el +++ b/lisp/language/china-util.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/chinese.el b/lisp/language/chinese.el index a412838af7..9ba178d723 100644 --- a/lisp/language/chinese.el +++ b/lisp/language/chinese.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/cyril-util.el b/lisp/language/cyril-util.el index a96f2fb047..7644064c5a 100644 --- a/lisp/language/cyril-util.el +++ b/lisp/language/cyril-util.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index 1e47057e9b..ba985a4754 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/czech.el b/lisp/language/czech.el index 0ebf2cb7bd..21213c65fd 100644 --- a/lisp/language/czech.el +++ b/lisp/language/czech.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/english.el b/lisp/language/english.el index fefb24171a..3e8f3123c3 100644 --- a/lisp/language/english.el +++ b/lisp/language/english.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 4d7ccd1269..cdf41ba909 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author: TAKAHASHI Naoto diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 3e71d437bd..f0bb049fdb 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author: TAKAHASHI Naoto diff --git a/lisp/language/european.el b/lisp/language/european.el index 6c0232efd3..d9ce05c24a 100644 --- a/lisp/language/european.el +++ b/lisp/language/european.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/georgian.el b/lisp/language/georgian.el index 14e3510844..4371809295 100644 --- a/lisp/language/georgian.el +++ b/lisp/language/georgian.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/greek.el b/lisp/language/greek.el index 357f0633a6..1a40148064 100644 --- a/lisp/language/greek.el +++ b/lisp/language/greek.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/hanja-util.el b/lisp/language/hanja-util.el index 200ae896b0..6af47982ba 100644 --- a/lisp/language/hanja-util.el +++ b/lisp/language/hanja-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/hebrew.el b/lisp/language/hebrew.el index 4e33fb63bc..9e049de8b5 100644 --- a/lisp/language/hebrew.el +++ b/lisp/language/hebrew.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index 930cba1bd9..fc8f4c9d98 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/indian.el b/lisp/language/indian.el index c84c8fede6..0bb123e189 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -116,7 +116,7 @@ South Indian Language Telugu is supported in this language environment.")) (sample-text . "Kannada (ಕನ್ನಡ) ನಮಸ್ಕಾರ") (documentation . "\ Kannada language and script is supported in this language -environment.")) +environment.")) '("Indian")) (set-language-info-alist @@ -140,7 +140,7 @@ South Indian language Malayalam is supported in this language environment.")) (defconst devanagari-composable-pattern (let ((table '(("a" . "[\u0900-\u0902]") ; vowel modifier (above) - ("A" . "\u0903") ; vowel modifier (post) + ("A" . "\u0903") ; vowel modifier (post) ("V" . "[\u0904-\u0914\u0960-\u0961\u0972]") ; independent vowel ("C" . "[\u0915-\u0939\u0958-\u095F\u0979-\u097F]") ; consonant ("R" . "\u0930") ; RA @@ -347,7 +347,7 @@ South Indian language Malayalam is supported in this language environment.")) (let ((table '(("A" . "[\u0D02-\u0D03]") ; SIGN ANUSVARA .. VISARGA ("V" . "[\u0D05-\u0D14\u0D60-\u0D61]") ; independent vowel - ("C" . "[\u0D15-\u0D39]") ; consonant + ("C" . "[\u0D15-\u0D39]") ; consonant ("Y" . "[\u0D2F-\u0D30\u0D32\u0D35]") ; YA, RA, LA, VA ("v" . "[\u0D3E-\u0D4C\u0D57\u0D62-\u0D63]") ; postbase matra ("H" . "\u0D4D") ; SIGN VIRAMA diff --git a/lisp/language/japan-util.el b/lisp/language/japan-util.el index 01cdd8bef9..988b925409 100644 --- a/lisp/language/japan-util.el +++ b/lisp/language/japan-util.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el index 4203c4cc94..57147f62e3 100644 --- a/lisp/language/japanese.el +++ b/lisp/language/japanese.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -185,7 +185,7 @@ eucJP-ms is defined in ." "Shift_JIS 8-bit encoding for Japanese (MIME:SHIFT_JIS-2004)" :coding-type 'shift-jis :mnemonic ?S - :charset-list '(ascii katakana-jisx0201 + :charset-list '(ascii katakana-jisx0201 japanese-jisx0213.2004-1 japanese-jisx0213-2)) (define-coding-system-alias 'shift_jis-2004 'japanese-shift-jis-2004) @@ -197,15 +197,15 @@ eucJP-ms is defined in ." (tutorial . "TUTORIAL.ja") (charset japanese-jisx0208 japanese-jisx0212 latin-jisx0201 katakana-jisx0201 - japanese-jisx0213.2004-1 japanese-jisx0213-1 + japanese-jisx0213.2004-1 japanese-jisx0213-1 japanese-jisx0213-2 japanese-jisx0208-1978) (coding-system iso-2022-jp japanese-iso-8bit japanese-shift-jis japanese-iso-7bit-1978-irv iso-2022-jp-2004 japanese-shift-jis-2004 euc-jis-2004) (coding-priority iso-2022-jp japanese-iso-8bit - japanese-shift-jis - iso-2022-jp-2004 euc-jis-2004 + japanese-shift-jis + iso-2022-jp-2004 euc-jis-2004 japanese-shift-jis-2004 iso-2022-jp-2) (input-method . "japanese") diff --git a/lisp/language/khmer.el b/lisp/language/khmer.el index 8663ff22ca..4a07032196 100644 --- a/lisp/language/khmer.el +++ b/lisp/language/khmer.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/language/korea-util.el b/lisp/language/korea-util.el index 12bb1e10bd..c49e627ea9 100644 --- a/lisp/language/korea-util.el +++ b/lisp/language/korea-util.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/korean.el b/lisp/language/korean.el index a8a30110c7..52560d6fb4 100644 --- a/lisp/language/korean.el +++ b/lisp/language/korean.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el index 28b2043ed5..94504ff9ba 100644 --- a/lisp/language/lao-util.el +++ b/lisp/language/lao-util.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/lao.el b/lisp/language/lao.el index 03519c9bee..266c3c634f 100644 --- a/lisp/language/lao.el +++ b/lisp/language/lao.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index c03fd429fe..2843c7c903 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/romanian.el b/lisp/language/romanian.el index 421ddcdd1a..00deb69884 100644 --- a/lisp/language/romanian.el +++ b/lisp/language/romanian.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/sinhala.el b/lisp/language/sinhala.el index 037d753f52..efd8aacc5a 100644 --- a/lisp/language/sinhala.el +++ b/lisp/language/sinhala.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: @@ -30,7 +30,7 @@ (sample-text . "Sinhala (සිංහල) ආයුබෝවන්") (documentation . t))) -(set-char-table-range +(set-char-table-range composition-function-table '(#xD80 . #xDFF) (list (vector diff --git a/lisp/language/slovak.el b/lisp/language/slovak.el index 6c729424d2..9682722e6e 100644 --- a/lisp/language/slovak.el +++ b/lisp/language/slovak.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/tai-viet.el b/lisp/language/tai-viet.el index f4074ae271..3c58910625 100644 --- a/lisp/language/tai-viet.el +++ b/lisp/language/tai-viet.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/thai-util.el b/lisp/language/thai-util.el index db421ebd5a..c8c844fbe2 100644 --- a/lisp/language/thai-util.el +++ b/lisp/language/thai-util.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/thai-word.el b/lisp/language/thai-word.el index d3c00f9ac3..e67dd09343 100644 --- a/lisp/language/thai-word.el +++ b/lisp/language/thai-word.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; The used Thai word list has been taken from IBM's ICU4J project ;; (file `thai6.ucs', version 1.4, converted to TIS encoding, with diff --git a/lisp/language/thai.el b/lisp/language/thai.el index 4d199842bc..945ea31c8d 100644 --- a/lisp/language/thai.el +++ b/lisp/language/thai.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el index 624da5c6d2..f3648c9b20 100644 --- a/lisp/language/tibet-util.el +++ b/lisp/language/tibet-util.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; History: ;; 1997.03.13 Modification in treatment of text properties; diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index f24e3b373f..962dd2bee5 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; History: diff --git a/lisp/language/tv-util.el b/lisp/language/tv-util.el index ba1ee66882..a667956a06 100644 --- a/lisp/language/tv-util.el +++ b/lisp/language/tv-util.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code @@ -72,7 +72,7 @@ (tone-rule '(tr . bl)) (prev-viet nil) ch info pos components overhang) - (while (< from to) + (while (< from to) (or ch (setq ch (char-after from) info (aref tai-viet-glyph-info ch))) @@ -138,4 +138,3 @@ ;; (provide 'tai-viet-util) - diff --git a/lisp/language/utf-8-lang.el b/lisp/language/utf-8-lang.el index 40aec43d7e..4156bf5766 100644 --- a/lisp/language/utf-8-lang.el +++ b/lisp/language/utf-8-lang.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/viet-util.el b/lisp/language/viet-util.el index ca670d80ff..f1946f6b69 100644 --- a/lisp/language/viet-util.el +++ b/lisp/language/viet-util.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/language/vietnamese.el b/lisp/language/vietnamese.el index cd36580d76..c170216062 100644 --- a/lisp/language/vietnamese.el +++ b/lisp/language/vietnamese.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/arabic.el b/lisp/leim/quail/arabic.el index 22d6117217..b027d4019f 100644 --- a/lisp/leim/quail/arabic.el +++ b/lisp/leim/quail/arabic.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/croatian.el b/lisp/leim/quail/croatian.el index 7ebf8758aa..a9b1ca8516 100644 --- a/lisp/leim/quail/croatian.el +++ b/lisp/leim/quail/croatian.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/cyril-jis.el b/lisp/leim/quail/cyril-jis.el index 609b601568..210fe97f5a 100644 --- a/lisp/leim/quail/cyril-jis.el +++ b/lisp/leim/quail/cyril-jis.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/cyrillic.el b/lisp/leim/quail/cyrillic.el index 600193ddc1..95b443f210 100644 --- a/lisp/leim/quail/cyrillic.el +++ b/lisp/leim/quail/cyrillic.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/czech.el b/lisp/leim/quail/czech.el index 762d702f43..26f30f36ec 100644 --- a/lisp/leim/quail/czech.el +++ b/lisp/leim/quail/czech.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el index eaf3a03baf..8d19a23370 100644 --- a/lisp/leim/quail/ethiopic.el +++ b/lisp/leim/quail/ethiopic.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author: TAKAHASHI Naoto diff --git a/lisp/leim/quail/georgian.el b/lisp/leim/quail/georgian.el index df29715659..bc3b5d2f6d 100644 --- a/lisp/leim/quail/georgian.el +++ b/lisp/leim/quail/georgian.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/greek.el b/lisp/leim/quail/greek.el index 05351e0e55..d1414abddc 100644 --- a/lisp/leim/quail/greek.el +++ b/lisp/leim/quail/greek.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/hangul.el b/lisp/leim/quail/hangul.el index 782d8d50a7..5d509c96e8 100644 --- a/lisp/leim/quail/hangul.el +++ b/lisp/leim/quail/hangul.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/hanja-jis.el b/lisp/leim/quail/hanja-jis.el index 2c7eebb834..79730b816e 100644 --- a/lisp/leim/quail/hanja-jis.el +++ b/lisp/leim/quail/hanja-jis.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/hanja.el b/lisp/leim/quail/hanja.el index 8c00ad1bbf..9c659e224e 100644 --- a/lisp/leim/quail/hanja.el +++ b/lisp/leim/quail/hanja.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/hanja3.el b/lisp/leim/quail/hanja3.el index c140f90223..0b58f6762d 100644 --- a/lisp/leim/quail/hanja3.el +++ b/lisp/leim/quail/hanja3.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/hebrew.el b/lisp/leim/quail/hebrew.el index d90b362407..772da70b5c 100644 --- a/lisp/leim/quail/hebrew.el +++ b/lisp/leim/quail/hebrew.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 8f549ae226..c1a9b2e4f8 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/ipa-praat.el b/lisp/leim/quail/ipa-praat.el index 42bc2010cb..2c1c8df5f0 100644 --- a/lisp/leim/quail/ipa-praat.el +++ b/lisp/leim/quail/ipa-praat.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/ipa.el b/lisp/leim/quail/ipa.el index 6f0368c981..e513c5f055 100644 --- a/lisp/leim/quail/ipa.el +++ b/lisp/leim/quail/ipa.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el index 98865aceb7..2d39d5e2fd 100644 --- a/lisp/leim/quail/japanese.el +++ b/lisp/leim/quail/japanese.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/lao.el b/lisp/leim/quail/lao.el index 14cf926828..af3b589262 100644 --- a/lisp/leim/quail/lao.el +++ b/lisp/leim/quail/lao.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el index cc721343c5..a6a5ac8459 100644 --- a/lisp/leim/quail/latin-alt.el +++ b/lisp/leim/quail/latin-alt.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author (of latin-post.el): TAKAHASHI Naoto diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index ac8d5b40ad..313de991d8 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/latin-post.el b/lisp/leim/quail/latin-post.el index a5564483ee..238b0efc09 100644 --- a/lisp/leim/quail/latin-post.el +++ b/lisp/leim/quail/latin-post.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author: TAKAHASHI Naoto diff --git a/lisp/leim/quail/latin-pre.el b/lisp/leim/quail/latin-pre.el index 9e4726abff..ca9c5f6e46 100644 --- a/lisp/leim/quail/latin-pre.el +++ b/lisp/leim/quail/latin-pre.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/lrt.el b/lisp/leim/quail/lrt.el index d3cfce6863..bad4155952 100644 --- a/lisp/leim/quail/lrt.el +++ b/lisp/leim/quail/lrt.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/persian.el b/lisp/leim/quail/persian.el index 56ba145daf..093d30665d 100644 --- a/lisp/leim/quail/persian.el +++ b/lisp/leim/quail/persian.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -215,7 +215,7 @@ (">" ?<) ("?" ?؟) - ;; Level 3 Entered with \ + ;; Level 3 Entered with \ ;; ("\\" ?\\) ;; خط اريب وارو ("\\\\" ?\\) diff --git a/lisp/leim/quail/programmer-dvorak.el b/lisp/leim/quail/programmer-dvorak.el index 1dc8edc1ef..00d9a3c594 100644 --- a/lisp/leim/quail/programmer-dvorak.el +++ b/lisp/leim/quail/programmer-dvorak.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/py-punct.el b/lisp/leim/quail/py-punct.el index 9fe06c07c0..39809af14b 100644 --- a/lisp/leim/quail/py-punct.el +++ b/lisp/leim/quail/py-punct.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/pypunct-b5.el b/lisp/leim/quail/pypunct-b5.el index 37c12659cc..ef5863101d 100644 --- a/lisp/leim/quail/pypunct-b5.el +++ b/lisp/leim/quail/pypunct-b5.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/rfc1345.el b/lisp/leim/quail/rfc1345.el index 74f7d09565..5b66d91b5a 100644 --- a/lisp/leim/quail/rfc1345.el +++ b/lisp/leim/quail/rfc1345.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/sgml-input.el b/lisp/leim/quail/sgml-input.el index c334b51cb4..7383683120 100644 --- a/lisp/leim/quail/sgml-input.el +++ b/lisp/leim/quail/sgml-input.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/sisheng.el b/lisp/leim/quail/sisheng.el index 8a1ddcff1e..bbc251ab55 100644 --- a/lisp/leim/quail/sisheng.el +++ b/lisp/leim/quail/sisheng.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el index 817dcd08c4..779f9b0c28 100644 --- a/lisp/leim/quail/slovak.el +++ b/lisp/leim/quail/slovak.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/symbol-ksc.el b/lisp/leim/quail/symbol-ksc.el index 31e839bfe8..70a54c7be6 100644 --- a/lisp/leim/quail/symbol-ksc.el +++ b/lisp/leim/quail/symbol-ksc.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; 94.10.24 Written for Mule Ver.2.0 (koaunghi.un@zdv.uni-tuebingen.de) ;;; 94.11.04 Updated for Mule Ver.2.1 (koaunghi.un@zdv.uni-tuebingen.de) diff --git a/lisp/leim/quail/tamil-dvorak.el b/lisp/leim/quail/tamil-dvorak.el index a625d90001..d080f7e596 100644 --- a/lisp/leim/quail/tamil-dvorak.el +++ b/lisp/leim/quail/tamil-dvorak.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/thai.el b/lisp/leim/quail/thai.el index 02f8b78d76..7cf11daf9d 100644 --- a/lisp/leim/quail/thai.el +++ b/lisp/leim/quail/thai.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el index 4e1c5b51c5..8971b1ddf7 100644 --- a/lisp/leim/quail/tibetan.el +++ b/lisp/leim/quail/tibetan.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Author: Toru TOMABECHI diff --git a/lisp/leim/quail/uni-input.el b/lisp/leim/quail/uni-input.el index 595155e026..744edc6147 100644 --- a/lisp/leim/quail/uni-input.el +++ b/lisp/leim/quail/uni-input.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/viqr.el b/lisp/leim/quail/viqr.el index 879fba4da2..b7591b15e0 100644 --- a/lisp/leim/quail/viqr.el +++ b/lisp/leim/quail/viqr.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/vntelex.el b/lisp/leim/quail/vntelex.el index 074b806bd4..210e26ad18 100644 --- a/lisp/leim/quail/vntelex.el +++ b/lisp/leim/quail/vntelex.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/vnvni.el b/lisp/leim/quail/vnvni.el index 5d21030a52..327ebb847b 100644 --- a/lisp/leim/quail/vnvni.el +++ b/lisp/leim/quail/vnvni.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/leim/quail/welsh.el b/lisp/leim/quail/welsh.el index 7b0ca2c2df..c524139d2e 100644 --- a/lisp/leim/quail/welsh.el +++ b/lisp/leim/quail/welsh.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/linum.el b/lisp/linum.el index 9cfb94dab6..3bee384708 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 18c30f781f..5d42ed958e 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/loadup.el b/lisp/loadup.el index af42cd9711..d048f0736b 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -337,7 +337,7 @@ ;; We reset load-path after dumping. ;; For a permanent change in load-path, use configure's ;; --enable-locallisppath option. - ;; See http://debbugs.gnu.org/16107 for more details. + ;; See https://debbugs.gnu.org/16107 for more details. (or (equal lp load-path) (message "Warning: Change in load-path due to site-load will be \ lost after dumping"))) diff --git a/lisp/locate.el b/lisp/locate.el index 738c333ac2..20b05c234f 100644 --- a/lisp/locate.el +++ b/lisp/locate.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/lpr.el b/lisp/lpr.el index 4c8dc2c3e7..b0a6e94975 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 9a81ef07ad..280e7f4bc3 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/macros.el b/lisp/macros.el index fc65489fe6..34e81f693f 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 1d6828b44b..f055215a8c 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el index fc3b9618d6..c5e634607a 100644 --- a/lisp/mail/blessmail.el +++ b/lisp/mail/blessmail.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index c1aec6923f..7bd9078342 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -187,7 +187,7 @@ Prompts for bug subject. Leaves you in a mail buffer." 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") 'action (lambda (button) - (browse-url "http://debbugs.gnu.org/")) + (browse-url "https://debbugs.gnu.org/")) 'follow-link t) (insert ". Please check that diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index 860d353002..130e164057 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el index 07e24bd78b..5e18d892d4 100644 --- a/lisp/mail/footnote.el +++ b/lisp/mail/footnote.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index 71567b4c0f..ff00ce4069 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index fd793a2830..86496beb0f 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 180d195d55..81af0d541c 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index b056739c65..b525d8972c 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index 0578b98c93..49df82c38b 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mail-prsvr.el b/lisp/mail/mail-prsvr.el index 07f650942c..9703e47fc3 100644 --- a/lisp/mail/mail-prsvr.el +++ b/lisp/mail/mail-prsvr.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index c23af87365..0164ffdc46 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 4e3a3f9d11..ef0e40f020 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el index 8f3f901c22..56fdd26b38 100644 --- a/lisp/mail/mailalias.el +++ b/lisp/mail/mailalias.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index 88624199df..102730f476 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index bceba77c46..b388c32c73 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el index 4e0802804f..e4886eabe6 100644 --- a/lisp/mail/metamail.el +++ b/lisp/mail/metamail.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 21856c325c..13a39e5211 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el index 262191db4a..9533697c77 100644 --- a/lisp/mail/qp.el +++ b/lisp/mail/qp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index b13da94c40..6cb5e4a887 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rfc2045.el b/lisp/mail/rfc2045.el index 11a6151887..f5185d22f7 100644 --- a/lisp/mail/rfc2045.el +++ b/lisp/mail/rfc2045.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; RFC 2045 is: "Multipurpose Internet Mail Extensions (MIME) Part ;; One: Format of Internet Message Bodies". diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index e2af86b324..0c93331de8 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index 66f539f698..e27113a9e3 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el index 6cb243ce5c..3f09f87f1b 100644 --- a/lisp/mail/rfc2368.el +++ b/lisp/mail/rfc2368.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el index 5edcef5428..e8bbea3257 100644 --- a/lisp/mail/rfc822.el +++ b/lisp/mail/rfc822.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index 648aa22aaa..dee2d1c513 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;;; ----------- diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index b240588289..12b1191e98 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index e9bb5560df..b91a81503e 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 761a58f931..b366e5c71b 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 1ffd4668ac..60b2066b2c 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index ac151f97fa..b53b95ea52 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index a2f9320446..8b918ec6e6 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 681a9c4340..a668d2e0bd 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 37ac46c6af..95d9b63f14 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index 12d69aa23c..3e22fd8411 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 93bfe0e39d..aff90d33ed 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index f3a6e3115b..c0dd7aaf59 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; LCD Archive Entry ;; supercite|Barry A. Warsaw|supercite-help@python.org diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el index 3dce1c6902..db50c4e6bf 100644 --- a/lisp/mail/uce.el +++ b/lisp/mail/uce.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index 73d7464bc1..77e97c7be9 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el index 2ff6646747..16e1ba3995 100644 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index e68acbd2b8..2811b0bf44 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mail/yenc.el b/lisp/mail/yenc.el index c8e2d2c7bc..b84b16144d 100644 --- a/lisp/mail/yenc.el +++ b/lisp/mail/yenc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/makesum.el b/lisp/makesum.el index 48f51dee4c..ffebf15db9 100644 --- a/lisp/makesum.el +++ b/lisp/makesum.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/man.el b/lisp/man.el index 4a14f638fc..7a892c6e88 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/master.el b/lisp/master.el index 07e9ee5abc..3745e216c4 100644 --- a/lisp/master.el +++ b/lisp/master.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el index 57fe7abde5..5bdf8b9dda 100644 --- a/lisp/mb-depth.el +++ b/lisp/mb-depth.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/md4.el b/lisp/md4.el index 23d00ab060..10f3d18883 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 75ffd1e2b4..972f84ee6c 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Avishai Yacobi suggested some menu rearrangements. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index d424247a4f..86248feff6 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index d62ac671ea..7e69e7556c 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-buffers.el b/lisp/mh-e/mh-buffers.el index 233f8988f0..e088bca48b 100644 --- a/lisp/mh-e/mh-buffers.el +++ b/lisp/mh-e/mh-buffers.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index c052398923..98067ce129 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index dbdadb10bf..3dc7a62f3c 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index 38558f2dc0..f511bf7dc4 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -3035,12 +3035,12 @@ XEmacs. For more information, see URL `ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.z'). Recent versions of XEmacs have internal support for \"X-Face:\" images. If your version of XEmacs does not, then you'll need both \"uncompface\" -and the x-face package (see URL `ftp://ftp.jpl.org/pub/elisp/'). +and the x-face package (see URL `http://www.jpl.org/ftp/pub/elisp/'). Finally, MH-E will display images referenced by the \"X-Image-URL:\" header field if neither the \"Face:\" nor the \"X-Face:\" fields are present. The display of the images requires \"wget\" (see URL -`http://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\" +`https://www.gnu.org/software/wget/wget.html'), \"fetch\", or \"curl\" to fetch the image and the \"convert\" program from the ImageMagick suite (see URL `http://www.imagemagick.org/'). Of the three header fields this is the most efficient in terms of network usage since the diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index f846f17943..49cf3d3dff 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 5252f92966..cfff8cb662 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 318759ddc1..33673251c9 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index ecc7f7e543..9518e96799 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el index a7ff8f3146..fcdb3f0227 100644 --- a/lisp/mh-e/mh-inc.el +++ b/lisp/mh-e/mh-inc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 25e116cb28..9057af43d6 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index ca4ec39733..28c18e4dd2 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index bc4a006642..280bcc683f 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 7238de08b9..9d1edf0fc4 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el index 906899d3b6..d7b686cfec 100644 --- a/lisp/mh-e/mh-print.el +++ b/lisp/mh-e/mh-print.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 1e708e529c..936d451e2d 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index b0fdfce8e8..95a5a08b1a 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index 6fc518b57c..9d3bd2dcd2 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index ab320caf60..ce843a6a7c 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 8d14d85239..4438bf2c8e 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-thread.el b/lisp/mh-e/mh-thread.el index b1b1512614..9b9ef34150 100644 --- a/lisp/mh-e/mh-thread.el +++ b/lisp/mh-e/mh-thread.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-tool-bar.el b/lisp/mh-e/mh-tool-bar.el index 07dd29b4be..3add54f03e 100644 --- a/lisp/mh-e/mh-tool-bar.el +++ b/lisp/mh-e/mh-tool-bar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index 1ed2e0f871..7cb52ffa9e 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index dbfaa35c73..92afd63262 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/midnight.el b/lisp/midnight.el index b9893fbfce..dfe0df3339 100644 --- a/lisp/midnight.el +++ b/lisp/midnight.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el index 096800155b..1d223e6fd0 100644 --- a/lisp/minibuf-eldef.el +++ b/lisp/minibuf-eldef.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index e5b1029c01..f13f1fa798 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/misc.el b/lisp/misc.el index dc47c37dbc..8806ac8383 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/misearch.el b/lisp/misearch.el index 884b33020a..89b437f1f1 100644 --- a/lisp/misearch.el +++ b/lisp/misearch.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el index 44d9973e63..4da25dee9c 100644 --- a/lisp/mouse-copy.el +++ b/lisp/mouse-copy.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el index 5a83e57347..775a464b23 100644 --- a/lisp/mouse-drag.el +++ b/lisp/mouse-drag.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mouse.el b/lisp/mouse.el index 2fbaaadf16..3f448f018a 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mpc.el b/lisp/mpc.el index 73692e228f..c23d8ced71 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/msb.el b/lisp/msb.el index 7b48af729e..c2ab2f5e9b 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 1428e5f4d0..2956ba5516 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 80b84765a0..73f62c8551 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 20ae072f65..b104148d54 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1317,7 +1317,7 @@ used instead of `browse-url-new-window-flag'." (if (file-exists-p (setq pidfile (format "/tmp/Mosaic.%d" pid))) (delete-file pidfile)) - ;; http://debbugs.gnu.org/17428. Use O_EXCL. + ;; https://debbugs.gnu.org/17428. Use O_EXCL. (write-region nil nil pidfile nil 'silent nil 'excl))) ;; Send signal SIGUSR to Mosaic (message "Signaling Mosaic...") diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index d740829f99..e79e326dbe 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/dig.el b/lisp/net/dig.el index 7e733675b6..ee98e5c444 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 8615813e07..b4500bd432 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 661ef51e60..899cdb00a4 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index 222673247b..1077cc4e8b 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index 083fd7fe7e..05f682d267 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 79d6f2ebc6..6a831b1265 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 644df7ab78..b19a838e64 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This package provides a common interface to query directory servers using diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index bfca103bdb..8dff028b9f 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This library provides an interface to use BBDB as a backend of diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index e1900e71ff..bdc72ef621 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This library provides specific LDAP protocol support for the diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index 43384e2d6f..2653cfab69 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This library provides an interface to use the Mac's AddressBook, diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2938e35dd5..bff592c3fe 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el index 5db87329c3..d4943a3303 100644 --- a/lisp/net/gnutls.el +++ b/lisp/net/gnutls.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index 2c2274d41b..6356b9047f 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index 246683444f..24246af02e 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el index 53fa153a1e..b4ef54038e 100644 --- a/lisp/net/hmac-md5.el +++ b/lisp/net/hmac-md5.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/imap.el b/lisp/net/imap.el index 7b293921a4..34206ef84c 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index d530338766..22873ba233 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index f943015e18..ed35c220ec 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/mairix.el b/lisp/net/mairix.el index 00806a178b..5dd190c101 100644 --- a/lisp/net/mairix.el +++ b/lisp/net/mairix.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 280c667470..d15df6974b 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index a30d9f6aad..46a93ee76b 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el index bf60eee673..7d8f996fd2 100644 --- a/lisp/net/network-stream.el +++ b/lisp/net/network-stream.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 8f748c1eba..5f68dea1be 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ====================================================================== diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index eab3e24441..d5c9d32a07 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ====================================================================== ;;; Commentary: diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index c781f0dfec..97bb21ee64 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ====================================================================== ;;; Commentary: diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index 93198e3dba..913b89b43f 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ====================================================================== diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index e93da3e1c4..61b98165d1 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ====================================================================== ;;; Commentary: diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 971bdf64f4..075671e0fb 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . (defconst newsticker-version "1.99" "Version number of newsticker.el.") (make-obsolete-variable 'newsticker-version 'emacs-version "25.1") diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el index 8d3463ef0a..e2053a0935 100644 --- a/lisp/net/nsm.el +++ b/lisp/net/nsm.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 4baa8f2081..137231c9af 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/pinentry.el b/lisp/net/pinentry.el index 3e43b7d9de..f8d81fde91 100644 --- a/lisp/net/pinentry.el +++ b/lisp/net/pinentry.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/pop3.el b/lisp/net/pop3.el index 2ef6321725..91408b8278 100644 --- a/lisp/net/pop3.el +++ b/lisp/net/pop3.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/puny.el b/lisp/net/puny.el index bdd59be070..af9b031bf2 100644 --- a/lisp/net/puny.el +++ b/lisp/net/puny.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/quickurl.el b/lisp/net/quickurl.el index 652eb2ffe8..c9b17937df 100644 --- a/lisp/net/quickurl.el +++ b/lisp/net/quickurl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -39,7 +39,7 @@ ;; where is a string that acts as the keyword lookup and is ;; the URL associated with it. An example might be: ;; -;; ("GNU" . "http://www.gnu.org/") +;; ("GNU" . "https://www.gnu.org/") ;; ;; A list entry looks like: ;; @@ -50,12 +50,12 @@ ;; used when presenting a list of URLS using `quickurl-list'. An example ;; might be: ;; -;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation") +;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation") ;; ;; Given the above, your quickurl file might look like: ;; -;; (("GNU" . "http://www.gnu.org/") -;; ("FSF" "http://www.fsf.org/" "The Free Software Foundation") +;; (("GNU" . "https://www.gnu.org/") +;; ("FSF" "https://www.fsf.org/" "The Free Software Foundation") ;; ("emacs" . "http://www.emacs.org/") ;; ("davep" "http://www.davep.org/" "Dave's homepage")) ;; diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 6377f791f4..127290e598 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/rfc2104.el b/lisp/net/rfc2104.el index 71cf5bd828..7d85c34ff6 100644 --- a/lisp/net/rfc2104.el +++ b/lisp/net/rfc2104.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/rlogin.el b/lisp/net/rlogin.el index a07c490154..ab7135af56 100644 --- a/lisp/net/rlogin.el +++ b/lisp/net/rlogin.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el index cd6c7e1a58..269e9a5462 100644 --- a/lisp/net/sasl-cram.el +++ b/lisp/net/sasl-cram.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el index 445d4bf37b..e74b90dabc 100644 --- a/lisp/net/sasl-digest.el +++ b/lisp/net/sasl-digest.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el index cb6961b14b..606aa03607 100644 --- a/lisp/net/sasl-ntlm.el +++ b/lisp/net/sasl-ntlm.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sasl-scram-rfc.el b/lisp/net/sasl-scram-rfc.el index 1dc4803c82..18415359b8 100644 --- a/lisp/net/sasl-scram-rfc.el +++ b/lisp/net/sasl-scram-rfc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index 6128b91b1d..2a166db7ce 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/secrets.el b/lisp/net/secrets.el index 9bcfc378f4..fa49b646b0 100644 --- a/lisp/net/secrets.el +++ b/lisp/net/secrets.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/shr-color.el b/lisp/net/shr-color.el index b0c706eb5d..65ab544bb5 100644 --- a/lisp/net/shr-color.el +++ b/lisp/net/shr-color.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/shr.el b/lisp/net/shr.el index cb915da1c1..7af6148e47 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el index 1a54e1aa73..832b443b12 100644 --- a/lisp/net/sieve-manage.el +++ b/lisp/net/sieve-manage.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sieve-mode.el b/lisp/net/sieve-mode.el index 87bb3a245b..165bbbd8d4 100644 --- a/lisp/net/sieve-mode.el +++ b/lisp/net/sieve-mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 665a0a8e15..c3acd36fa4 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/snmp-mode.el b/lisp/net/snmp-mode.el index e6a27f43a0..413882ae86 100644 --- a/lisp/net/snmp-mode.el +++ b/lisp/net/snmp-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el index c0b71cdf17..4fdd038244 100644 --- a/lisp/net/soap-client.el +++ b/lisp/net/soap-client.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el index 2516bc9924..722d4d6288 100644 --- a/lisp/net/soap-inspect.el +++ b/lisp/net/soap-inspect.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/net/socks.el b/lisp/net/socks.el index f18e69514b..63a65069c5 100644 --- a/lisp/net/socks.el +++ b/lisp/net/socks.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/starttls.el b/lisp/net/starttls.el index 4de3d69e4f..276807a374 100644 --- a/lisp/net/starttls.el +++ b/lisp/net/starttls.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -42,7 +42,7 @@ ;; it performs more verification of the certificates. ;; The GnuTLS support requires GnuTLS 0.9.90 (released 2003-10-08) or -;; later, from , or "starttls" +;; later, from , or "starttls" ;; from . ;; Usage is similar to `open-network-stream'. For example: diff --git a/lisp/net/telnet.el b/lisp/net/telnet.el index b38ef6c654..03569415ed 100644 --- a/lisp/net/telnet.el +++ b/lisp/net/telnet.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 11aae635aa..e89584994d 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 6e8dd2f9c8..30e0c17acf 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index a162ab00a5..dc97501be3 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 4c5a12d33b..78ef1a3ef4 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 9a50d62448..5d9a1fd196 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 85afd52bf4..9fd2e6d9de 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 6567991804..e55dd1178d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 01fe335963..016a9205c9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 8368cff684..e7646e68c2 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el index 5e5f05da4a..12d4cd4d9d 100644 --- a/lisp/net/tramp-uu.el +++ b/lisp/net/tramp-uu.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 14624593e0..45776078be 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -40,7 +40,7 @@ ;; Also see the todo list at the bottom of this file. ;; ;; The current version of Tramp can be retrieved from the following URL: -;; http://ftp.gnu.org/gnu/tramp/ +;; https://ftp.gnu.org/gnu/tramp/ ;; ;; There's a mailing list for this, as well. Its name is: ;; tramp-devel@gnu.org @@ -49,7 +49,7 @@ ;; ;; For the adventurous, the current development sources are available ;; via Git. You can find instructions about this at the following URL: -;; http://savannah.gnu.org/projects/tramp/ +;; https://savannah.gnu.org/projects/tramp/ ;; ;; Don't forget to put on your asbestos longjohns, first! diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 5f9b2b6f42..91222bd781 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el index f6e0cf87b9..79a06021e1 100644 --- a/lisp/net/webjump.el +++ b/lisp/net/webjump.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -76,9 +76,9 @@ '( ;; FSF, not including Emacs-specific. ("GNU Project FTP Archive" . - ;; GNU FTP Mirror List from http://www.gnu.org/order/ftp.html - [mirrors "ftp://ftp.gnu.org/pub/gnu/" - "http://ftpmirror.gnu.org"]) + ;; GNU FTP Mirror List from https://www.gnu.org/order/ftp.html + [mirrors "https://ftp.gnu.org/pub/gnu/" + "https://ftpmirror.gnu.org"]) ("GNU Project Home Page" . "www.gnu.org") ;; Emacs. diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el index 393f3a549f..7ad9c9f5c9 100644 --- a/lisp/net/zeroconf.el +++ b/lisp/net/zeroconf.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 8772b52376..2a0f8a8ae5 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/notifications.el b/lisp/notifications.el index 194b0894a9..9290f71d4e 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/novice.el b/lisp/novice.el index a5ad2a0c56..72c16af5fe 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-enc.el b/lisp/nxml/nxml-enc.el index b359076ef4..1a82b91775 100644 --- a/lisp/nxml/nxml-enc.el +++ b/lisp/nxml/nxml-enc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -91,7 +91,7 @@ ;; no-conversion gives the user a chance to fix it. 'no-conversion) ;; There are other things we might try here in the future - ;; eg UTF-8 BOM, UTF-16 with no BOM + ;; eg UTF-8 BOM, UTF-16 with no BOM ;; translate to EBCDIC (t (let ((enc-pos (xmltok-get-declared-encoding-position limit))) diff --git a/lisp/nxml/nxml-maint.el b/lisp/nxml/nxml-maint.el index 55abca18e0..9ba2b3287d 100644 --- a/lisp/nxml/nxml-maint.el +++ b/lisp/nxml/nxml-maint.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 7e33e743de..3f4dce261d 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-ns.el b/lisp/nxml/nxml-ns.el index a9388d9882..c4845a67f8 100644 --- a/lisp/nxml/nxml-ns.el +++ b/lisp/nxml/nxml-ns.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-outln.el b/lisp/nxml/nxml-outln.el index 2c414e489d..5a2ecae220 100644 --- a/lisp/nxml/nxml-outln.el +++ b/lisp/nxml/nxml-outln.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-parse.el b/lisp/nxml/nxml-parse.el index bce8cc9ee0..6c00dc7375 100644 --- a/lisp/nxml/nxml-parse.el +++ b/lisp/nxml/nxml-parse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-rap.el b/lisp/nxml/nxml-rap.el index 0132a2b923..daec948f1c 100644 --- a/lisp/nxml/nxml-rap.el +++ b/lisp/nxml/nxml-rap.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el index 9f085458d8..dcb3ef4bf6 100644 --- a/lisp/nxml/nxml-util.el +++ b/lisp/nxml/nxml-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el index a09c77c51a..b35774f471 100644 --- a/lisp/nxml/rng-cmpct.el +++ b/lisp/nxml/rng-cmpct.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-dt.el b/lisp/nxml/rng-dt.el index 6e60609445..b62ba57dc2 100644 --- a/lisp/nxml/rng-dt.el +++ b/lisp/nxml/rng-dt.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-loc.el b/lisp/nxml/rng-loc.el index 359a717868..891f101908 100644 --- a/lisp/nxml/rng-loc.el +++ b/lisp/nxml/rng-loc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-maint.el b/lisp/nxml/rng-maint.el index 8378b1d649..85614822be 100644 --- a/lisp/nxml/rng-maint.el +++ b/lisp/nxml/rng-maint.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-match.el b/lisp/nxml/rng-match.el index e3401741fb..075695bd5c 100644 --- a/lisp/nxml/rng-match.el +++ b/lisp/nxml/rng-match.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el index caa3d63e39..e878cfefaa 100644 --- a/lisp/nxml/rng-nxml.el +++ b/lisp/nxml/rng-nxml.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-parse.el b/lisp/nxml/rng-parse.el index f3afbdd07d..9796c8a70c 100644 --- a/lisp/nxml/rng-parse.el +++ b/lisp/nxml/rng-parse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-pttrn.el b/lisp/nxml/rng-pttrn.el index 29b55816a7..6975f3c1b7 100644 --- a/lisp/nxml/rng-pttrn.el +++ b/lisp/nxml/rng-pttrn.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el index 6b3190a1b0..4bd619eb6d 100644 --- a/lisp/nxml/rng-uri.el +++ b/lisp/nxml/rng-uri.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-util.el b/lisp/nxml/rng-util.el index a804771e33..f49a6814cd 100644 --- a/lisp/nxml/rng-util.el +++ b/lisp/nxml/rng-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el index 6837424857..a96aedfdc4 100644 --- a/lisp/nxml/rng-valid.el +++ b/lisp/nxml/rng-valid.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/rng-xsd.el b/lisp/nxml/rng-xsd.el index 51a05f8cad..79039abf18 100644 --- a/lisp/nxml/rng-xsd.el +++ b/lisp/nxml/rng-xsd.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/xmltok.el b/lisp/nxml/xmltok.el index 69dc541bc5..5d31392aa9 100644 --- a/lisp/nxml/xmltok.el +++ b/lisp/nxml/xmltok.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/nxml/xsd-regexp.el b/lisp/nxml/xsd-regexp.el index d56960c9fa..e22d6f7542 100644 --- a/lisp/nxml/xsd-regexp.el +++ b/lisp/nxml/xsd-regexp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obarray.el b/lisp/obarray.el index b1160ebea4..0915e22a72 100644 --- a/lisp/obarray.el +++ b/lisp/obarray.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/abbrevlist.el b/lisp/obsolete/abbrevlist.el index ebef215fcc..34393b3d79 100644 --- a/lisp/obsolete/abbrevlist.el +++ b/lisp/obsolete/abbrevlist.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/assoc.el b/lisp/obsolete/assoc.el index eab8d13a81..6313006f7d 100644 --- a/lisp/obsolete/assoc.el +++ b/lisp/obsolete/assoc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/bruce.el b/lisp/obsolete/bruce.el index 6af597d9fe..99f33b0d12 100644 --- a/lisp/obsolete/bruce.el +++ b/lisp/obsolete/bruce.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -39,7 +39,7 @@ ;; reading your meeting schedule notices or other email boring to everyone ;; but you and (you hope) the recipient. See below (I left in the original ;; writeup when I made this conversion), or the emacs documentation at -;; ftp://prep.ai.mit.edu/pub/gnu/emacs-manual*. +;; https://www.gnu.org/software/emacs/manual/. ;; Bruce is a direct copy of spook, with the word "spook" replaced with ;; the word "bruce". Thanks to "esr", whoever he, she or it may be, this diff --git a/lisp/obsolete/cc-compat.el b/lisp/obsolete/cc-compat.el index c9fdf739f1..6d05eec8e4 100644 --- a/lisp/obsolete/cc-compat.el +++ b/lisp/obsolete/cc-compat.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -106,7 +106,7 @@ This is in addition to c-continued-statement-offset.") (if (eq (char-before) ?{) (forward-char -1) (goto-char (cdr langelem))) - (let* ((curcol (save-excursion + (let* ((curcol (save-excursion (goto-char (cdr langelem)) (current-column))) (bocm-lossage @@ -138,7 +138,7 @@ This is in addition to c-continued-statement-offset.") (defun cc-block-close-offset (langelem) (save-excursion (let* ((here (point)) - bracep + bracep (curcol (progn (goto-char (cdr langelem)) (current-column))) @@ -154,7 +154,7 @@ This is in addition to c-continued-statement-offset.") (current-column)))) (- bocm-lossage curcol (if bracep 0 c-indent-level))))) - + (defun cc-substatement-open-offset (langelem) (+ c-continued-statement-offset c-continued-brace-offset)) diff --git a/lisp/obsolete/cl-compat.el b/lisp/obsolete/cl-compat.el index 930b59e89d..d021c68571 100644 --- a/lisp/obsolete/cl-compat.el +++ b/lisp/obsolete/cl-compat.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/complete.el b/lisp/obsolete/complete.el index 6a7fdc59c2..7b33de9f60 100644 --- a/lisp/obsolete/complete.el +++ b/lisp/obsolete/complete.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el index aa13be1bc6..85fd4dcdaf 100644 --- a/lisp/obsolete/crisp.el +++ b/lisp/obsolete/crisp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/cust-print.el b/lisp/obsolete/cust-print.el index b9aef43e0b..8c12306112 100644 --- a/lisp/obsolete/cust-print.el +++ b/lisp/obsolete/cust-print.el @@ -24,7 +24,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/erc-hecomplete.el b/lisp/obsolete/erc-hecomplete.el index 4b0b8efa6a..b1201eb9a9 100644 --- a/lisp/obsolete/erc-hecomplete.el +++ b/lisp/obsolete/erc-hecomplete.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -219,4 +219,3 @@ Window configurations are stored in ;; indent-tabs-mode: t ;; tab-width: 8 ;; End: - diff --git a/lisp/obsolete/eudcb-ph.el b/lisp/obsolete/eudcb-ph.el index 06d6f52f5b..28b9be0ffa 100644 --- a/lisp/obsolete/eudcb-ph.el +++ b/lisp/obsolete/eudcb-ph.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/fast-lock.el b/lisp/obsolete/fast-lock.el index d1e2c24feb..ebcdd235cf 100644 --- a/lisp/obsolete/fast-lock.el +++ b/lisp/obsolete/fast-lock.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/gs.el b/lisp/obsolete/gs.el index 5bc77d8c34..c821ebf79f 100644 --- a/lisp/obsolete/gs.el +++ b/lisp/obsolete/gs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/gulp.el b/lisp/obsolete/gulp.el index 11a7e02ab9..5aa4fb4e1d 100644 --- a/lisp/obsolete/gulp.el +++ b/lisp/obsolete/gulp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/html2text.el b/lisp/obsolete/html2text.el index f60b04a404..d1dc876f28 100644 --- a/lisp/obsolete/html2text.el +++ b/lisp/obsolete/html2text.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/iswitchb.el b/lisp/obsolete/iswitchb.el index 71cc917938..59c2ee7eb0 100644 --- a/lisp/obsolete/iswitchb.el +++ b/lisp/obsolete/iswitchb.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/landmark.el b/lisp/obsolete/landmark.el index b6bbca4480..99fd55107b 100644 --- a/lisp/obsolete/landmark.el +++ b/lisp/obsolete/landmark.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/lazy-lock.el b/lisp/obsolete/lazy-lock.el index 5fa8fa48fa..64304391bb 100644 --- a/lisp/obsolete/lazy-lock.el +++ b/lisp/obsolete/lazy-lock.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el index 3dde96c3bb..9cf6f7629f 100644 --- a/lisp/obsolete/ledit.el +++ b/lisp/obsolete/ledit.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el index e445b1ac55..24de4891ae 100644 --- a/lisp/obsolete/levents.el +++ b/lisp/obsolete/levents.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el index a790d21148..44ef617031 100644 --- a/lisp/obsolete/lmenu.el +++ b/lisp/obsolete/lmenu.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/longlines.el b/lisp/obsolete/longlines.el index a6c6a0c9fc..b45b4a4af9 100644 --- a/lisp/obsolete/longlines.el +++ b/lisp/obsolete/longlines.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el index bf8347bf9e..562c60aee2 100644 --- a/lisp/obsolete/lucid.el +++ b/lisp/obsolete/lucid.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/messcompat.el b/lisp/obsolete/messcompat.el index 46adf83600..6dc4df0cc8 100644 --- a/lisp/obsolete/messcompat.el +++ b/lisp/obsolete/messcompat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index 3e673725ae..aee1ef8e82 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/old-emacs-lock.el b/lisp/obsolete/old-emacs-lock.el index 233c105dc0..61986fe1fc 100644 --- a/lisp/obsolete/old-emacs-lock.el +++ b/lisp/obsolete/old-emacs-lock.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el index defd18b35a..0b96c52a74 100644 --- a/lisp/obsolete/old-whitespace.el +++ b/lisp/obsolete/old-whitespace.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/options.el b/lisp/obsolete/options.el index 2a61dc01ca..ae1ad3b9ab 100644 --- a/lisp/obsolete/options.el +++ b/lisp/obsolete/options.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/otodo-mode.el b/lisp/obsolete/otodo-mode.el index 5784601674..c7a05ad145 100644 --- a/lisp/obsolete/otodo-mode.el +++ b/lisp/obsolete/otodo-mode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; --------------------------------------------------------------------------- diff --git a/lisp/obsolete/pc-mode.el b/lisp/obsolete/pc-mode.el index c1b7ff92c7..fe282ffee5 100644 --- a/lisp/obsolete/pc-mode.el +++ b/lisp/obsolete/pc-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el index 59da29391d..5353859a62 100644 --- a/lisp/obsolete/pc-select.el +++ b/lisp/obsolete/pc-select.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/pgg-def.el b/lisp/obsolete/pgg-def.el index 8d59c688b9..25827269b2 100644 --- a/lisp/obsolete/pgg-def.el +++ b/lisp/obsolete/pgg-def.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/obsolete/pgg-gpg.el b/lisp/obsolete/pgg-gpg.el index 189b119bfa..1c08755bff 100644 --- a/lisp/obsolete/pgg-gpg.el +++ b/lisp/obsolete/pgg-gpg.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/obsolete/pgg-parse.el b/lisp/obsolete/pgg-parse.el index b44117773d..019d53d660 100644 --- a/lisp/obsolete/pgg-parse.el +++ b/lisp/obsolete/pgg-parse.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/pgg-pgp.el b/lisp/obsolete/pgg-pgp.el index 507fbbb913..cac5240a1b 100644 --- a/lisp/obsolete/pgg-pgp.el +++ b/lisp/obsolete/pgg-pgp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/obsolete/pgg-pgp5.el b/lisp/obsolete/pgg-pgp5.el index 8fd976fc23..1504283b69 100644 --- a/lisp/obsolete/pgg-pgp5.el +++ b/lisp/obsolete/pgg-pgp5.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/obsolete/pgg.el b/lisp/obsolete/pgg.el index f99d759ec4..d84dc92e53 100644 --- a/lisp/obsolete/pgg.el +++ b/lisp/obsolete/pgg.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/obsolete/rcompile.el b/lisp/obsolete/rcompile.el index dd2506841f..1ad4f5a07f 100644 --- a/lisp/obsolete/rcompile.el +++ b/lisp/obsolete/rcompile.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/s-region.el b/lisp/obsolete/s-region.el index 8a85f3c796..9898f5f47a 100644 --- a/lisp/obsolete/s-region.el +++ b/lisp/obsolete/s-region.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/sregex.el b/lisp/obsolete/sregex.el index f57befa504..9790e7ffbc 100644 --- a/lisp/obsolete/sregex.el +++ b/lisp/obsolete/sregex.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/sup-mouse.el b/lisp/obsolete/sup-mouse.el index 4aabe41951..28822e1fbc 100644 --- a/lisp/obsolete/sup-mouse.el +++ b/lisp/obsolete/sup-mouse.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/terminal.el b/lisp/obsolete/terminal.el index e5d85e69a3..4e5f369403 100644 --- a/lisp/obsolete/terminal.el +++ b/lisp/obsolete/terminal.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el index ee1c277164..cebb426a2d 100644 --- a/lisp/obsolete/tpu-edt.el +++ b/lisp/obsolete/tpu-edt.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey. diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el index 06291ce573..56ccbf09a8 100644 --- a/lisp/obsolete/tpu-extras.el +++ b/lisp/obsolete/tpu-extras.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el index bb7e28b03c..c44eba213d 100644 --- a/lisp/obsolete/tpu-mapper.el +++ b/lisp/obsolete/tpu-mapper.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/vc-arch.el b/lisp/obsolete/vc-arch.el index 92eaa62be8..d153f9add1 100644 --- a/lisp/obsolete/vc-arch.el +++ b/lisp/obsolete/vc-arch.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el index 4d70d6a5df..c6a5d236b0 100644 --- a/lisp/obsolete/vip.el +++ b/lisp/obsolete/vip.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el index 62cccf725a..c276cfcc4a 100644 --- a/lisp/obsolete/ws-mode.el +++ b/lisp/obsolete/ws-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/xesam.el b/lisp/obsolete/xesam.el index c553d0023b..62844b94cb 100644 --- a/lisp/obsolete/xesam.el +++ b/lisp/obsolete/xesam.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/obsolete/yow.el b/lisp/obsolete/yow.el index 55f19a80e5..df8302e19f 100644 --- a/lisp/obsolete/yow.el +++ b/lisp/obsolete/yow.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 2bdda68d58..86047eeecc 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-J.el b/lisp/org/ob-J.el index ff4190b265..eaccac8121 100644 --- a/lisp/org/ob-J.el +++ b/lisp/org/ob-J.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 3accade49f..ded825b1d0 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el index 9fbe35b7d8..693c5d8f60 100644 --- a/lisp/org/ob-abc.el +++ b/lisp/org/ob-abc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index 1dbf48427f..819273aece 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index 2db4eeae94..e2eec9bf7f 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index d4b7260c57..76d36cf780 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index 39561572a5..b99035b4cc 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 7b218081fa..2a1d274365 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el index 93d2b1f713..76bfc5add9 100644 --- a/lisp/org/ob-coq.el +++ b/lisp/org/ob-coq.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 527fb2204a..e18716823d 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'cl-lib) diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index 4203b1258c..b3982db391 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 89b5d2465c..2a7c755676 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index 81442bfc1c..8c8e2fbd60 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el index 0fceb5fc6b..6bb9b81b22 100644 --- a/lisp/org/ob-ebnf.el +++ b/lisp/org/ob-ebnf.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index 989561db7b..4736d895dc 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 324cf5fb27..4ce91c7853 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index f87d0f8e7d..dc9c53aade 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ob-core) diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el index 152cf727e2..bb8d9af478 100644 --- a/lisp/org/ob-forth.el +++ b/lisp/org/ob-forth.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index d059245b30..50b12fc256 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 400823b2d7..f35374758f 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el index 69993c0f6a..1e602dd0cf 100644 --- a/lisp/org/ob-groovy.el +++ b/lisp/org/ob-groovy.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Currently only supports the external execution. No session support yet. diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index ecce6dcd5d..cc78bec33d 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el index 5dd611098e..35b92ef62f 100644 --- a/lisp/org/ob-io.el +++ b/lisp/org/ob-io.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Currently only supports the external execution. No session support yet. diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el index 7e720231e4..608e2e8858 100644 --- a/lisp/org/ob-java.el +++ b/lisp/org/ob-java.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index 91be6b0735..e344b7a53c 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el index f5fb910123..170c00636c 100644 --- a/lisp/org/ob-keys.el +++ b/lisp/org/ob-keys.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index 763ffb16ff..6964fde5ac 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index c02069e283..4f10ebe08a 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index 37a7a6b57e..3320a7e55b 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 1e381d0ce2..d98098e136 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index b6f50d33ed..8a52b57e52 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'cl-lib) diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 877d895284..4fd7a32382 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Requirements: ;; for session support, lua-mode is needed. diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el index 2aa04fd2af..14190ac1be 100644 --- a/lisp/org/ob-makefile.el +++ b/lisp/org/ob-makefile.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 23cfa36d1e..e30ce8dae0 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index 0a4d835a3a..b2680aa7b6 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index 5c9dccc67c..784e0a9469 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 7997ff03a6..fd0ddf8ab7 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 90735b11fb..0f51606290 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 5683b96fca..232c2d0117 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 62df8c555f..2f462cf414 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index f577381557..a1dbe6de2a 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index e90021a52a..20dc25f648 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el index a18a53cbf1..4e09abc98b 100644 --- a/lisp/org/ob-processing.el +++ b/lisp/org/ob-processing.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index 302f8bd451..60ec5fa475 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index f8b9ea4509..323cdc7ef7 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index d055783514..d9525ea3d4 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index a9a2a9f030..769c9011f8 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el index 7d5f299ec6..d00b97c3db 100644 --- a/lisp/org/ob-scala.el +++ b/lisp/org/ob-scala.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Currently only supports the external execution. No session support yet. diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index cd8c3860e2..2782853220 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -32,7 +32,7 @@ ;;; Requirements: ;; - a working scheme implementation -;; (e.g. guile http://www.gnu.org/software/guile/guile.html) +;; (e.g. guile https://www.gnu.org/software/guile/guile.html) ;; ;; - for session based evaluation geiser is required, which is available from ;; ELPA. diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index 554f8c4385..fbf167e0e4 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el index f249d3240e..7bd0bfb77c 100644 --- a/lisp/org/ob-sed.el +++ b/lisp/org/ob-sed.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el index 3787c26a19..af64adb892 100644 --- a/lisp/org/ob-shell.el +++ b/lisp/org/ob-shell.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el index 6bf36c6437..6a4a3f18de 100644 --- a/lisp/org/ob-shen.el +++ b/lisp/org/ob-shen.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 6d39e953be..7c3ee120d7 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 8094019d5e..50e8ac1ab9 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el index 40dd0efa38..40fd8d9cce 100644 --- a/lisp/org/ob-stan.el +++ b/lisp/org/ob-stan.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index 4de8936df1..3169f3d3be 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 2dc55caf89..ed09ff563a 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ob.el b/lisp/org/ob.el index 736f58879b..c5ce0c0366 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'org-macs) diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 598461874f..a1ff76b36d 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index ce1f35df36..41b75660b3 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index a026eee4f1..1feb99c0a0 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index bf6a79ab85..2189b2050a 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index d52b947583..9c10393c00 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 43207308ba..4a438d050b 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index aa5c375cef..7d7640db58 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index ac8f36ad40..d800652cff 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 68a1166c81..26ac54eb01 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 3c431e4fdd..48c3ff0a5f 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 98eb8068a8..fe6caf209d 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;; Synopsis diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 540753d67c..b7852baf10 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index dfad89332a..3361b0e59e 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index f4fe6447a6..f370eb0607 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 05ccf0cf5b..573ffa0710 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el index 34cc4ffbb8..b0e9631e6f 100644 --- a/lisp/org/org-eshell.el +++ b/lisp/org/org-eshell.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-eww.el b/lisp/org/org-eww.el index c14ae115af..372b543f51 100644 --- a/lisp/org/org-eww.el +++ b/lisp/org/org-eww.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index cd43d37178..53538e6a85 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index 6ebe5ecf5d..0119864df9 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index b9f23f144f..e039ab7850 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index b9d098957c..ba57971771 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index 1f61565719..6ca9b79f0f 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index f07d243b8c..a508e761cb 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 4a22b15050..b34586e09e 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index 2918d4061d..360b1bcfdb 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 92537fc2cc..5889f6d2fe 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 9007bf8f95..2b9585112c 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index a3e26256f9..e4848f9f61 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 3b8f8140c9..cddc09e902 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index aae59d3c1f..e656eaa023 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index 4142ae45b2..f06fea7777 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 192ccadfde..a548930c0f 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index d6a472787e..8e61cfc32e 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 61ec5fad4c..3c2561d1fa 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Code: diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 449143a47a..a8028324bf 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index cd4b216aae..6e61a8dcc3 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 31c59a13d8..332c669a4f 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 9a3ff53aa4..da08777a44 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 6b4e21b646..60f55799c9 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-timer.el b/lisp/org/org-timer.el index 58eb4bd469..88dc1a8500 100644 --- a/lisp/org/org-timer.el +++ b/lisp/org/org-timer.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index e9bbeff37c..f396814dac 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: diff --git a/lisp/org/org.el b/lisp/org/org.el index 87758fdfdd..f8a2596ec6 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;;; Commentary: ;; diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 8dc31be99d..ad78995ddf 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index 82651d3848..bb08d0c743 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index e1956ccdcf..ecec752862 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index ec4b49585f..f1a510e98a 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox-man.el b/lisp/org/ox-man.el index d0e4976edb..fb8f7be087 100644 --- a/lisp/org/ox-man.el +++ b/lisp/org/ox-man.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index 2478cc6ab8..e2fefa345c 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 75554689aa..f70f5706db 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ox-org.el b/lisp/org/ox-org.el index a52ecc81a0..6c6a29a1f3 100644 --- a/lisp/org/ox-org.el +++ b/lisp/org/ox-org.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 508209ae44..bece11a2d1 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/org/ox-texinfo.el b/lisp/org/ox-texinfo.el index 35927d9953..f70b7c4c82 100644 --- a/lisp/org/ox-texinfo.el +++ b/lisp/org/ox-texinfo.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 7d2f3d1714..4e85066eec 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/outline.el b/lisp/outline.el index 9ace6044e0..fe1df766cb 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/paren.el b/lisp/paren.el index 5ccfa5faa9..190922ac8d 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -60,7 +60,7 @@ active, you must toggle the mode off and on again for this to take effect." (defcustom show-paren-priority 1000 "Priority of paren highlighting overlays." - :type 'integer + :type 'integer :version "21.1") (defcustom show-paren-ring-bell-on-mismatch nil diff --git a/lisp/password-cache.el b/lisp/password-cache.el index cbc248b9ec..18f30a82ff 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el index c03be64cf5..6ab962f5f0 100644 --- a/lisp/pcmpl-cvs.el +++ b/lisp/pcmpl-cvs.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index 73a0fe507f..78cc001830 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 84fb4b9e11..0e27489c91 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index ce5f053aa3..c2083c889c 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 9bcce8b885..41968bfe88 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pcmpl-x.el b/lisp/pcmpl-x.el index 7aeff54b21..1dde3245d8 100644 --- a/lisp/pcmpl-x.el +++ b/lisp/pcmpl-x.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 6e45f3898f..745a813b75 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 18c0bc8507..4f183addaa 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Usage: ;; diff --git a/lisp/play/5x5.el b/lisp/play/5x5.el index 312764b2f4..dad2048ac8 100644 --- a/lisp/play/5x5.el +++ b/lisp/play/5x5.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/animate.el b/lisp/play/animate.el index d074a741b6..80bb746133 100644 --- a/lisp/play/animate.el +++ b/lisp/play/animate.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el index d935b02e7f..e25978cdf5 100644 --- a/lisp/play/blackbox.el +++ b/lisp/play/blackbox.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/bubbles.el b/lisp/play/bubbles.el index 4c9754a689..35abbc8bb2 100644 --- a/lisp/play/bubbles.el +++ b/lisp/play/bubbles.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 88627d694f..b9605dcf9e 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el index 61a63bd28d..f68e78d160 100644 --- a/lisp/play/decipher.el +++ b/lisp/play/decipher.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el index 6bd7f69405..23d78478c5 100644 --- a/lisp/play/dissociate.el +++ b/lisp/play/dissociate.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index f90e1d044b..e1c4d2acd7 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 6acdf36d72..ed1cd5e730 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/fortune.el b/lisp/play/fortune.el index 7b60465788..0b83b62b29 100644 --- a/lisp/play/fortune.el +++ b/lisp/play/fortune.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This utility allows you to automatically cut regions to a fortune diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index 0386a89b3a..6214e07506 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index 3954c1dc1f..944205209c 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el index a2d3447ded..7c3184543b 100644 --- a/lisp/play/gomoku.el +++ b/lisp/play/gomoku.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 06b37beb55..0b572d12be 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/play/life.el b/lisp/play/life.el index c5907a9875..a5a3f1ef05 100644 --- a/lisp/play/life.el +++ b/lisp/play/life.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/morse.el b/lisp/play/morse.el index 85d9db086f..d55e0a4c9f 100644 --- a/lisp/play/morse.el +++ b/lisp/play/morse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el index 815203032f..5fc4f2d4b1 100644 --- a/lisp/play/mpuz.el +++ b/lisp/play/mpuz.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/pong.el b/lisp/play/pong.el index fb826fb65e..c5af6f15e9 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/snake.el b/lisp/play/snake.el index d5904a48f4..d6a21418ec 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 850b80566b..f1aa046cc1 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/spook.el b/lisp/play/spook.el index e6727725d6..fd2e8116c8 100644 --- a/lisp/play/spook.el +++ b/lisp/play/spook.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/tetris.el b/lisp/play/tetris.el index d20ac0ab3a..2b06d8f3ad 100644 --- a/lisp/play/tetris.el +++ b/lisp/play/tetris.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/play/zone.el b/lisp/play/zone.el index a718d07cac..254b76ca27 100644 --- a/lisp/play/zone.el +++ b/lisp/play/zone.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/plstore.el b/lisp/plstore.el index 26c53b3e61..b49e3d40fc 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary diff --git a/lisp/printing.el b/lisp/printing.el index 9970b85a8e..328cbe01e4 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -28,7 +28,7 @@ Please send all bug fixes and enhancements to ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -58,7 +58,7 @@ Please send all bug fixes and enhancements to ;; On GNU or Unix system, `printing' depends on gs and gv utilities. ;; On NT system, `printing' depends on gstools (gswin32.exe and gsview32.exe). ;; To obtain ghostscript, ghostview and GSview see the URL -;; `http://www.gnu.org/software/ghostscript/ghostscript.html'. +;; `https://www.gnu.org/software/ghostscript/ghostscript.html'. ;; ;; `printing' depends on ps-print package to generate PostScript files, to ;; spool and to despool PostScript buffer. So, `printing' provides an @@ -958,7 +958,7 @@ Please send all bug fixes and enhancements to ;; ;; * For GNU or Unix system: ;; -;; gs, gv `http://www.gnu.org/software/ghostscript/ghostscript.html' +;; gs, gv `https://www.gnu.org/software/ghostscript/ghostscript.html' ;; enscript `http://people.ssh.fi/mtr/genscript/' ;; psnup `http://www.knackered.org/angus/psutils/' ;; mpage `http://www.mesa.nl/pub/mpage/' @@ -966,7 +966,7 @@ Please send all bug fixes and enhancements to ;; * For Windows system: ;; ;; gswin32, gsview32 -;; `http://www.gnu.org/software/ghostscript/ghostscript.html' +;; `https://www.gnu.org/software/ghostscript/ghostscript.html' ;; gsprint `http://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'. ;; enscript `http://people.ssh.fi/mtr/genscript/' ;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm' @@ -2249,7 +2249,7 @@ See also `pr-path-alist'. Useful links: * GNU gv manual - `http://www.gnu.org/software/gv/manual/gv.html' + `https://www.gnu.org/software/gv/manual/gv.html' * GSview Help `http://www.cs.wisc.edu/~ghost/gsview/gsviewen.htm' diff --git a/lisp/proced.el b/lisp/proced.el index 18693f4556..f5ea10b8ad 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/profiler.el b/lisp/profiler.el index 15ff9b68ab..0eed79eff0 100644 --- a/lisp/profiler.el +++ b/lisp/profiler.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index ab3ff3aa20..05d8038e87 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This mode is a major mode for editing Ada code. This is a major diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index f1b9087504..b86982a75c 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 2b390688c2..c8f70b0e4b 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This file is now automatically loaded from ada-mode.el, and creates a submenu diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 4e196505b6..5f79afe01a 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 2d09e431f2..f84d94a3e6 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el index 2a1dad6987..f6e2d78f3a 100644 --- a/lisp/progmodes/asm-mode.el +++ b/lisp/progmodes/asm-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index 6d58faa6a6..6e591c1d65 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el index 1dd2e3757e..f4852fe5b6 100644 --- a/lisp/progmodes/bat-mode.el +++ b/lisp/progmodes/bat-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/bug-reference.el b/lisp/progmodes/bug-reference.el index 13c52a4571..7e004ce6a0 100644 --- a/lisp/progmodes/bug-reference.el +++ b/lisp/progmodes/bug-reference.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -44,7 +44,7 @@ map) "Keymap used by bug reference buttons.") -;; E.g., "http://gcc.gnu.org/PR%s" +;; E.g., "https://gcc.gnu.org/PR%s" (defvar bug-reference-url-format nil "Format used to turn a bug number into a URL. The bug number is supplied as a string, so this should have a single %s. diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index dbedb59289..4b326026b8 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1231,7 +1231,7 @@ Works with: Any syntactic symbol which has an anchor position." (save-excursion (goto-char (c-langelem-pos langelem)) (vector (current-column)))) - + (defun c-lineup-dont-change (_langelem) "Do not change the indentation of the current line. diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index 662329b5a9..488b93eb57 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index f15d28e3da..d4bce32f17 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index dec59c5809..5c8bbebf31 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index dda343d72e..bff1c9eb65 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 9ea0b2046a..d5083ed248 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -11799,7 +11799,7 @@ comment at the start of cc-engine.el for more info." (cond ((c-backward-over-enum-header) (setq placeholder (c-point 'boi))) - ((consp (setq placeholder + ((consp (setq placeholder (c-looking-at-or-maybe-in-bracelist containing-sexp lim))) (setq tmpsymbol (and (cdr placeholder) 'topmost-intro-cont)) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 95246f9b16..5aefdea330 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-guess.el b/lisp/progmodes/cc-guess.el index c8cd6fbe40..00d8bf0817 100644 --- a/lisp/progmodes/cc-guess.el +++ b/lisp/progmodes/cc-guess.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 8a4adf1f7f..ef6b88c372 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index 126b419128..6746651f18 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 663a51ca72..354dee82df 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index b1c94c3bc6..1a8d90bacd 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index 2ae90ce423..6818b5e0b7 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 5bc7b66063..10881cda52 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el index cafd5acb37..883515e8fc 100644 --- a/lisp/progmodes/cmacexp.el +++ b/lisp/progmodes/cmacexp.el @@ -27,7 +27,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 8c84398792..b3d090382d 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c69eca2241..abd77bd973 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Corrections made by Ilya Zakharevich ilyaz@cpan.org @@ -701,24 +701,7 @@ This way enabling/disabling of menu items is more correct." ;;; Short extra-docs. (defvar cperl-tips 'please-ignore-this-line - "Get maybe newer version of this package from - http://ilyaz.org/software/emacs -Subdirectory `cperl-mode' may contain yet newer development releases and/or -patches to related files. - -For best results apply to an older Emacs the patches from - ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches -\(this upgrades syntax-parsing abilities of Emacsen v19.34 and -v20.2 up to the level of Emacs v20.3 - a must for a good Perl -mode.) As of beginning of 2003, XEmacs may provide a similar ability. - -Get support packages choose-color.el (or font-lock-extra.el before -19.30), imenu-go.el from the same place. \(Look for other files there -too... ;-). Get a patch for imenu.el in 19.29. Note that for 19.30 and -later you should use choose-color.el *instead* of font-lock-extra.el -\(and you will not get smart highlighting in C :-(). - -Note that to enable Compile choices in the menu you need to install + "Note that to enable Compile choices in the menu you need to install mode-compile.el. If your Emacs does not default to `cperl-mode' on Perl files, and you diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el index e35a76e38c..8aaebdde5b 100644 --- a/lisp/progmodes/cpp.el +++ b/lisp/progmodes/cpp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index 1c6905a38f..4b28d5a82a 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el index eb0850e4ec..6681af5585 100644 --- a/lisp/progmodes/dcl-mode.el +++ b/lisp/progmodes/dcl-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index a3780eb70f..f73efe4539 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index a257d391bf..7d426f9491 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 2bea9547a1..545e2107c2 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 84c67df63f..048a0a198e 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index 8847c40150..c50bcb87d9 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index 31dfd95e94..7d5d0d641d 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index 3aa02a8e0f..d7b2070876 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index a8229df4ae..a813d42356 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . (defconst ebnf-version "4.4" "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 0b5d7aa11b..661c55dc18 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0bf8857960..2f8e081a29 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 222dea1a2a..619c2ed687 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index ebdb516de1..00c898d261 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index 49e072c65b..6421ba60dc 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index af16e522c3..df1a0750cf 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el index 69f0c77a71..bf5218c41d 100644 --- a/lisp/progmodes/flymake-ui.el +++ b/lisp/progmodes/flymake-ui.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 6ae2280a35..059bce95ee 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index b15da92a5c..b73ee2525f 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index cc9205c0d8..7723f70092 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Credits: diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el index f476ac0a56..699ef2eee8 100644 --- a/lisp/progmodes/glasses.el +++ b/lisp/progmodes/glasses.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 466b524c79..01bdb04714 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e9ca7eade3..3ef1d90ab5 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el index b34ea1c4ae..3974483325 100644 --- a/lisp/progmodes/hideif.el +++ b/lisp/progmodes/hideif.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 5328526abd..f3abf373d4 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el index 92a89fef70..a164b703f1 100644 --- a/lisp/progmodes/icon.el +++ b/lisp/progmodes/icon.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index d2758ccd62..a7e49b6ea4 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -148,9 +148,9 @@ an up-to-date completion list." (not (equal start idlwave-current-tags-completion-pos))) (idlwave-prepare-structure-tag-completion var)) (setq idlwave-current-tags-completion-pos start) - (setq idlwave-completion-help-info + (setq idlwave-completion-help-info (list 'idlwave-complete-structure-tag-help)) - (idlwave-complete-in-buffer 'structtag 'structtag + (idlwave-complete-in-buffer 'structtag 'structtag idlwave-current-struct-tags nil "Select a structure tag" "structure tag") t) ; we did the completion: return t to skip other completions @@ -169,7 +169,7 @@ an up-to-date completion list." (if (derived-mode-p 'idlwave-shell-mode) ;; OK, we are in the shell, do it dynamically (progn - (message "preparing shell tags") + (message "preparing shell tags") ;; The following call puts the tags into `idlwave-current-struct-tags' (idlwave-complete-structure-tag-query-shell var) ;; initialize @@ -191,7 +191,7 @@ an up-to-date completion list." ;; Find possible definitions of the structure. (while (idlwave-find-structure-definition var nil 'all) (let ((tags (idlwave-struct-tags))) - (when tags + (when tags ;; initialize (setq idlwave-sint-structtags nil idlwave-current-tags-buffer (current-buffer) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index e82ed06164..244e2b3843 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index e7497e8e4f..39d24d4f9d 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 2fda49d91f..c53e5e5989 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index f070000c86..9231e11890 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el index 7de3a796ae..e398c3ed64 100644 --- a/lisp/progmodes/inf-lisp.el +++ b/lisp/progmodes/inf-lisp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cd315fb33c..2bbacf7bae 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 7a666e9529..980ef9014c 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el index b48654ff41..ebb66fa05a 100644 --- a/lisp/progmodes/m4-mode.el +++ b/lisp/progmodes/m4-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 5cda7bb219..4c926f4de9 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/mantemp.el b/lisp/progmodes/mantemp.el index 7a3c0fb035..93119b1e8d 100644 --- a/lisp/progmodes/mantemp.el +++ b/lisp/progmodes/mantemp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 3377226388..a47ae28a4a 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index f884de1fcc..6d2d64af96 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; Major mode for the mix asm language. @@ -30,7 +30,7 @@ ;; For optimal use, also use GNU MDK. Compiling needs mixasm, running ;; and debugging needs mixvm and mixvm.el from GNU MDK. You can get ;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and -;; `ftp://ftp.gnu.org/pub/gnu/mdk'. +;; `https://ftp.gnu.org/pub/gnu/mdk'. ;; ;; To use this mode, place the following in your init file: ;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'. diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el index ac9ba630c4..7e91201784 100644 --- a/lisp/progmodes/octave.el +++ b/lisp/progmodes/octave.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -37,7 +37,7 @@ (defgroup octave nil "Editing Octave code." :link '(custom-manual "(octave-mode)Top") - :link '(url-link "http://www.gnu.org/s/octave") + :link '(url-link "https://www.gnu.org/s/octave") :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces) :group 'languages) @@ -612,7 +612,7 @@ Key bindings: (defcustom inferior-octave-prompt ;; For Octave >= 3.8, default is always 'octave', see - ;; http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + ;; https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 "\\(?:^octave\\(?:.bin\\|.exe\\)?\\(?:-[.0-9]+\\)?\\(?::[0-9]+\\)?\\|^debug\\|^\\)>+ " "Regexp to match prompts for the inferior Octave process." :type 'regexp) @@ -839,7 +839,7 @@ startup file, `~/.emacs-octave'." (inferior-octave-send-list-and-digest (list "more off;\n" (unless (equal inferior-octave-output-string ">> ") - ;; See http://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 + ;; See https://hg.savannah.gnu.org/hgweb/octave/rev/708173343c50 "PS1 ('octave> ');\n") (when (and inferior-octave-startup-file (file-exists-p inferior-octave-startup-file)) @@ -867,7 +867,7 @@ startup file, `~/.emacs-octave'." (defun inferior-octave-completion-at-point () "Return the data to complete the Octave symbol at point." - ;; http://debbugs.gnu.org/14300 + ;; https://debbugs.gnu.org/14300 (unless (string-match-p "/" (or (comint--match-partial-filename) "")) (let ((beg (save-excursion (skip-syntax-backward "w_" (comint-line-beginning-position)) diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el index 6a61564b44..12353c4faf 100644 --- a/lisp/progmodes/opascal.el +++ b/lisp/progmodes/opascal.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el index a7d0624a74..5f893b87c2 100644 --- a/lisp/progmodes/pascal.el +++ b/lisp/progmodes/pascal.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 5e199fb0c3..2f9a4c3db5 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index eddaa89ef9..f727e458b2 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index ed1d564752..9dc0da4ad5 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index f2b487dd3b..13cd6be9f7 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -26,7 +26,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Original author: Masanobu UMEDA ;; Parts of this file was taken from a modified version of the original diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 7e2b7fdf79..69ea3a70f5 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -28,7 +28,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 444167f536..f3513ced4b 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -80,7 +80,7 @@ ;; Using the "console" subcommand to start IPython in server-client ;; mode is known to fail intermittently due a bug on IPython itself -;; (see URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27'). +;; (see URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=18052#27'). ;; There seems to be a race condition in the IPython server (A.K.A ;; kernel) when code is sent while it is still initializing, sometimes ;; causing the shell to get stalled. With that said, if an IPython @@ -97,7 +97,7 @@ ;; Missing or delayed output used to happen due to differences between ;; Operating Systems' pipe buffering (e.g. CPython 3.3.4 in Windows 7. -;; See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To +;; See URL `https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17304'). To ;; avoid this, the `python-shell-unbuffered' defaults to non-nil and ;; controls whether `python-shell-calculate-process-environment' ;; should set the "PYTHONUNBUFFERED" environment variable on startup: diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index 6f431ecd30..0024957c39 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 0dcf9b47b8..bb75595cb4 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index ea2e98424f..0bda8bc275 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index 505a2ea43c..6f98d68d04 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 48e21605a3..b8ce326f17 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -6,7 +6,7 @@ ;; Maintainer: Michael Mauger ;; Version: 3.6 ;; Keywords: comm languages processes -;; URL: http://savannah.gnu.org/projects/emacs/ +;; URL: https://savannah.gnu.org/projects/emacs/ ;; This file is part of GNU Emacs. @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/subword.el b/lisp/progmodes/subword.el index ede2f42073..6428b56f9d 100644 --- a/lisp/progmodes/subword.el +++ b/lisp/progmodes/subword.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index de0cd50911..dbb71efdfb 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; BEFORE USE: ;; diff --git a/lisp/progmodes/vera-mode.el b/lisp/progmodes/vera-mode.el index 066360023d..05d1a5f5f3 100644 --- a/lisp/progmodes/vera-mode.el +++ b/lisp/progmodes/vera-mode.el @@ -32,7 +32,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 6e79b1a63d..a6e3ae5455 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -32,7 +32,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 06ffd54d2d..3f2d7e11ec 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -32,7 +32,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Commentary: @@ -17897,7 +17897,7 @@ references: [3] European Space Agency. \"VHDL Modelling Guidelines\". - ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps} + https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' to visually support naming conventions.") diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 41513340e1..adfe7b3bf1 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 35a5c8862f..623c9c4e07 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/progmodes/xscheme.el b/lisp/progmodes/xscheme.el index bdfe30af50..4939649b99 100644 --- a/lisp/progmodes/xscheme.el +++ b/lisp/progmodes/xscheme.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index f49cbd7c58..04e69a307f 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -27,7 +27,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ps-def.el b/lisp/ps-def.el index ea51c2a09b..ea77b6ba53 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 0a590105b2..393de9ff7a 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 7476ab3bb1..b50363812e 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -35,7 +35,7 @@ Please send all bug fixes and enhancements to ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index f86e526938..15f5c7c814 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/recentf.el b/lisp/recentf.el index 462ccb6db5..d78d7ce71d 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/rect.el b/lisp/rect.el index a85101fddf..12e62b6a99 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/register.el b/lisp/register.el index e395963f56..913380763c 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/registry.el b/lisp/registry.el index 27664dc09e..17dc23d68e 100644 --- a/lisp/registry.el +++ b/lisp/registry.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/repeat.el b/lisp/repeat.el index c55a50a834..f75d9d0d66 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/replace.el b/lisp/replace.el index 09972b40db..a5548f461d 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/reposition.el b/lisp/reposition.el index ce24d29e5f..833b65ac52 100644 --- a/lisp/reposition.el +++ b/lisp/reposition.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/reveal.el b/lisp/reveal.el index 66f5bc4755..1b6cd335d7 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index f5df7f80f9..66204125d5 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/rot13.el b/lisp/rot13.el index 20a0dbed46..886085b826 100644 --- a/lisp/rot13.el +++ b/lisp/rot13.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/rtree.el b/lisp/rtree.el index b4c9d48b83..9db03c474d 100644 --- a/lisp/rtree.el +++ b/lisp/rtree.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 16277973d6..bfe205923e 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/savehist.el b/lisp/savehist.el index 9a3c5cfc4d..c1f17f7661 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 603ab65d71..54599c7e11 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/sb-image.el b/lisp/sb-image.el index b94978a8df..6faa66d152 100644 --- a/lisp/sb-image.el +++ b/lisp/sb-image.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index 59efe8c11b..90365fae3f 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This mode allows multiple buffers to be 'locked' so that scrolling diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 5835274044..8f02f2f3e9 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 50868e7257..837189c212 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/select.el b/lisp/select.el index 579c5c7e2e..d950d70593 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/server.el b/lisp/server.el index 209bfaaf70..8aafa1c257 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -23,7 +23,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/ses.el b/lisp/ses.el index 8c5ff2136f..9221476e7a 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el index 21d0f0a40b..53718ab082 100644 --- a/lisp/shadowfile.el +++ b/lisp/shadowfile.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/shell.el b/lisp/shell.el index ea7f0beebb..9c83762924 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/simple.el b/lisp/simple.el index ff0aa066b5..1ffe181067 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/skeleton.el b/lisp/skeleton.el index dbfa87e207..d182bdff30 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/sort.el b/lisp/sort.el index 88a784fbb8..17f2cb0167 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/soundex.el b/lisp/soundex.el index a83bab8a91..0903b80abe 100644 --- a/lisp/soundex.el +++ b/lisp/soundex.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/speedbar.el b/lisp/speedbar.el index 3113471183..c66cc89dda 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -25,7 +25,7 @@ this version is not backward compatible to 0.14 or earlier.") ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/strokes.el b/lisp/strokes.el index a70c3f58f4..33a2ea6b24 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/subr.el b/lisp/subr.el index 52d4e190e7..79ae1f4830 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Beware: while this file has tag `utf-8', before it's compiled, it gets ;; loaded as "raw-text", so non-ASCII chars won't work right during bootstrap. diff --git a/lisp/svg.el b/lisp/svg.el index 8310eba629..6a0c49b469 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el index 2ed2fcb466..75e8804513 100644 --- a/lisp/t-mouse.el +++ b/lisp/t-mouse.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tabify.el b/lisp/tabify.el index 75ff61d327..93a0fc27d1 100644 --- a/lisp/tabify.el +++ b/lisp/tabify.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/talk.el b/lisp/talk.el index f35f9344f8..a471a50061 100644 --- a/lisp/talk.el +++ b/lisp/talk.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index b0d3177694..21fccc4fcc 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tempo.el b/lisp/tempo.el index e4c50038fd..3470d48e24 100644 --- a/lisp/tempo.el +++ b/lisp/tempo.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term.el b/lisp/term.el index 12a37cafbe..c748c45020 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; Marck 13 2001 ;; Fixes for CJK support by Yong Lu . diff --git a/lisp/term/AT386.el b/lisp/term/AT386.el index ac027747b7..62a6c58caf 100644 --- a/lisp/term/AT386.el +++ b/lisp/term/AT386.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/README b/lisp/term/README index 9cb844b761..25b9e5db0c 100644 --- a/lisp/term/README +++ b/lisp/term/README @@ -262,4 +262,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index cce84588a5..2cf1e84768 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/internal.el b/lisp/term/internal.el index 00a908a459..f16189e058 100644 --- a/lisp/term/internal.el +++ b/lisp/term/internal.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/iris-ansi.el b/lisp/term/iris-ansi.el index d3ddb19c0f..24a5642b0f 100644 --- a/lisp/term/iris-ansi.el +++ b/lisp/term/iris-ansi.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/news.el b/lisp/term/news.el index 241db33849..1c23f1cfce 100644 --- a/lisp/term/news.el +++ b/lisp/term/news.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index cfce83f892..68b659bf75 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index b6f2acc297..0355350da7 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/rxvt.el b/lisp/term/rxvt.el index d80bb78804..d88b12b799 100644 --- a/lisp/term/rxvt.el +++ b/lisp/term/rxvt.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/sun.el b/lisp/term/sun.el index 88e63d2c9e..64c67ae812 100644 --- a/lisp/term/sun.el +++ b/lisp/term/sun.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 9cfe30a463..3b86aa7c9b 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el index 862cd7978c..abcd149acd 100644 --- a/lisp/term/tvi970.el +++ b/lisp/term/tvi970.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -73,7 +73,7 @@ ("\e5" [S-send]) ;; Not an X keysym )) (define-key map (car key-binding) (nth 1 key-binding))) - + ;; The numeric keypad keys. (dotimes (i 10) diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el index bc171381cc..44bee803aa 100644 --- a/lisp/term/vt100.el +++ b/lisp/term/vt100.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index be895a040d..bd16145756 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/w32console.el b/lisp/term/w32console.el index f8b8b3c1b4..b6e04669c3 100644 --- a/lisp/term/w32console.el +++ b/lisp/term/w32console.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el index a6b2e7cc43..f6abc79c5e 100644 --- a/lisp/term/wyse50.el +++ b/lisp/term/wyse50.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index dd42dda106..b769444671 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index e6d224dd3d..4f79703833 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -610,7 +610,7 @@ Return the pasted text as a string." ;; Set up colors, for those versions of xterm that support it. (defvar xterm-standard-colors ;; The names in the comments taken from XTerm-col.ad in the xterm - ;; distribution, see ftp://dickey.his.com/xterm/. RGB values are + ;; distribution, see https://invisible-island.net/xterm/. RGB values are ;; from rgb.txt. '(("black" 0 ( 0 0 0)) ; black ("red" 1 (205 0 0)) ; red3 diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index cdc2af4a7a..10e788145a 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -27,7 +27,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 2f3c17b3b2..d6bb636a9b 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el index 393bbd1c3a..bd36b9738d 100644 --- a/lisp/textmodes/bibtex-style.el +++ b/lisp/textmodes/bibtex-style.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index 2128e50797..b6b12e6a9c 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -25,7 +25,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index d03ee5eb31..33dc3722aa 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 44ba870662..dde9e6a8d9 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index 72eb66b571..df03beaa9a 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 5319db7c16..d90c207575 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index ee523ed5f5..96023265b0 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index ecf729d15b..dc6da4aab2 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -231,7 +231,7 @@ Ispell's ultimate default dictionary." "Non-nil means check even inside TeX math environment. TeX math environments are discovered by `texmathp', implemented inside AUCTeX package. That package may be found at -URL `http://www.gnu.org/software/auctex/'" +URL `https://www.gnu.org/software/auctex/'" :group 'flyspell :type 'boolean) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 87a3b7aaa1..0c0a51e7df 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el index b38f259429..b665f917d3 100644 --- a/lisp/textmodes/less-css-mode.el +++ b/lisp/textmodes/less-css-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el index 9edc759c2d..34fdb96122 100644 --- a/lisp/textmodes/makeinfo.el +++ b/lisp/textmodes/makeinfo.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/mhtml-mode.el b/lisp/textmodes/mhtml-mode.el index 2f2257d96b..b6cd1572fb 100644 --- a/lisp/textmodes/mhtml-mode.el +++ b/lisp/textmodes/mhtml-mode.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index cea0c604ba..ce4c155f52 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el index 8542b951b3..d744bd2cf0 100644 --- a/lisp/textmodes/page-ext.el +++ b/lisp/textmodes/page-ext.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 936896c3bd..fa2a7d1c9a 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index f0671f489f..645d3ff1a2 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el index 09d0a2f0a9..0fb120ec80 100644 --- a/lisp/textmodes/picture.el +++ b/lisp/textmodes/picture.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/po.el b/lisp/textmodes/po.el index 822596c57c..648eef56cf 100644 --- a/lisp/textmodes/po.el +++ b/lisp/textmodes/po.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el index 6b72126081..62c299b86d 100644 --- a/lisp/textmodes/refbib.el +++ b/lisp/textmodes/refbib.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el index 74dec30473..ee18221148 100644 --- a/lisp/textmodes/refer.el +++ b/lisp/textmodes/refer.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/refill.el b/lisp/textmodes/refill.el index f65c9ade67..e005b5806f 100644 --- a/lisp/textmodes/refill.el +++ b/lisp/textmodes/refill.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 1e0a564048..ac57ce735a 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 7f1887cbf4..9ff2d0a176 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index 16bc621f88..894f08b15d 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 91d2b48562..d07a52816e 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 6544029ef0..120370a149 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index af2810d72e..67a3dd26b7 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index dd183548d0..c2c5ca3de0 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index a4533adec0..65720f4ecd 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index 4f7c738a13..c7a598c920 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index 03da584e96..528232b525 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -264,7 +264,7 @@ distribution. Mixed-case symbols are convenience aliases.") "LaTeX label and citation support." :tag "RefTeX" :link '(url-link :tag "Home Page" - "http://www.gnu.org/software/auctex/reftex.html") + "https://www.gnu.org/software/auctex/reftex.html") :link '(emacs-commentary-link :tag "Commentary in reftex.el" "reftex.el") :link '(custom-manual "(reftex)Top") :prefix "reftex-" diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index d46bd0dacd..d9393ff25f 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -36,13 +36,13 @@ ;; ;; The documentation in various formats is also available at ;; -;; http://www.gnu.org/software/auctex/manual/reftex.index.html +;; https://www.gnu.org/software/auctex/manual/reftex.index.html ;; ;; RefTeX is bundled with Emacs and available as a plug-in package for ;; XEmacs 21.x. If you need to install it yourself, you can find a ;; distribution at ;; -;; http://www.gnu.org/software/auctex/reftex.html +;; https://www.gnu.org/software/auctex/reftex.html ;; ;; RefTeX was written by Carsten Dominik with ;; contributions from Stephen Eglen. It is currently maintained by @@ -2369,7 +2369,7 @@ information about your RefTeX version and configuration." what in fact did happen. Check if the bug is reproducible with an up-to-date version of -RefTeX available from http://www.gnu.org/software/auctex/. +RefTeX available from https://www.gnu.org/software/auctex/. If the bug is triggered by a specific \(La)TeX file, you should try to produce a minimal sample file showing the problem and include it diff --git a/lisp/textmodes/remember.el b/lisp/textmodes/remember.el index 388e49cfdc..b20ee8fee8 100644 --- a/lisp/textmodes/remember.el +++ b/lisp/textmodes/remember.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 490ea23109..5534294738 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 78fbbb5936..7ae3036f8c 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index 5e967b535c..d408d206be 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ba6d696de9..5c4d540f7a 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el index 1d2a9e52ab..647ae1b430 100644 --- a/lisp/textmodes/texinfmt.el +++ b/lisp/textmodes/texinfmt.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index f962dec9f0..be8bcc55fe 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Todo: diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el index aa5346d01f..46977e1411 100644 --- a/lisp/textmodes/texnfo-upd.el +++ b/lisp/textmodes/texnfo-upd.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 7d63556dcc..1661ebe8c8 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/tildify.el b/lisp/textmodes/tildify.el index e4920b70c1..0d7b15dfc6 100644 --- a/lisp/textmodes/tildify.el +++ b/lisp/textmodes/tildify.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el index c6203fdf9e..293a106515 100644 --- a/lisp/textmodes/two-column.el +++ b/lisp/textmodes/two-column.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el index f018260b7e..9f7a6eb47b 100644 --- a/lisp/textmodes/underline.el +++ b/lisp/textmodes/underline.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 7c3d73e52b..13f761e69e 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/thumbs.el b/lisp/thumbs.el index d0b5e22414..e8ef05242e 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index fa7621bcd4..959f0cad64 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/time.el b/lisp/time.el index 6a46ea68ea..5c0eac0c20 100644 --- a/lisp/time.el +++ b/lisp/time.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/timezone.el b/lisp/timezone.el index 023cc68c3c..762147b08b 100644 --- a/lisp/timezone.el +++ b/lisp/timezone.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tmm.el b/lisp/tmm.el index 8755971d7c..ca6a37d62b 100644 --- a/lisp/tmm.el +++ b/lisp/tmm.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 2386fe6177..ee01a6998b 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tooltip.el b/lisp/tooltip.el index c011f1b01b..18ddd25703 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/tree-widget.el b/lisp/tree-widget.el index 6baf4c4721..130d8af07e 100644 --- a/lisp/tree-widget.el +++ b/lisp/tree-widget.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 785dbdfd18..7823f76a79 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/type-break.el b/lisp/type-break.el index 8cb81d496e..faf44b3b87 100644 --- a/lisp/type-break.el +++ b/lisp/type-break.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/uniquify.el b/lisp/uniquify.el index c6a50edc2c..aa1fcd99cb 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el index c98e076ffa..f0860e570a 100644 --- a/lisp/url/url-about.el +++ b/lisp/url/url-about.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 2885d4e12e..65c718ea12 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index a7247dfe10..1cffc06d7c 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-cid.el b/lisp/url/url-cid.el index 218ec0d654..ce160c6677 100644 --- a/lisp/url/url-cid.el +++ b/lisp/url/url-cid.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 0edc93c964..453d4fe5b6 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-dav.el b/lisp/url/url-dav.el index 59b836ca6d..ba20d67546 100644 --- a/lisp/url/url-dav.el +++ b/lisp/url/url-dav.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; DAV is in RFC 2518. diff --git a/lisp/url/url-dired.el b/lisp/url/url-dired.el index f7ed13c45b..53df2bf7bb 100644 --- a/lisp/url/url-dired.el +++ b/lisp/url/url-dired.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-domsuf.el b/lisp/url/url-domsuf.el index b24f24531a..e0ebba46fb 100644 --- a/lisp/url/url-domsuf.el +++ b/lisp/url/url-domsuf.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-expand.el b/lisp/url/url-expand.el index 9ceaa025fb..04f06c367e 100644 --- a/lisp/url/url-expand.el +++ b/lisp/url/url-expand.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: @@ -60,7 +60,7 @@ "Convert URL to a fully specified URL, and canonicalize it. Second arg DEFAULT is a URL to start with if URL is relative. If DEFAULT is nil or missing, the current buffer's URL is used. -Path components that are `.' are removed, and +Path components that are `.' are removed, and path components followed by `..' are removed, along with the `..' itself." (if (and url (not (string-match "^#" url))) ;; Need to nuke newlines and spaces in the URL, or we open diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el index 1dda1d3325..0252896b74 100644 --- a/lisp/url/url-file.el +++ b/lisp/url/url-file.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-ftp.el b/lisp/url/url-ftp.el index da2fbde49c..baae0a7ec4 100644 --- a/lisp/url/url-ftp.el +++ b/lisp/url/url-ftp.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-future.el b/lisp/url/url-future.el index 5394eb0e5e..abf3004102 100644 --- a/lisp/url/url-future.el +++ b/lisp/url/url-future.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 716b7c0a6e..c1c08259e3 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-handlers.el b/lisp/url/url-handlers.el index ba3062308e..55a478ad03 100644 --- a/lisp/url/url-handlers.el +++ b/lisp/url/url-handlers.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -341,7 +341,7 @@ if it had been inserted from a file named URL." (unless buffer (signal 'file-error (list url "No Data"))) (with-current-buffer buffer ;; XXX: This is HTTP/S specific and should be moved to url-http - ;; instead. See http://debbugs.gnu.org/17549. + ;; instead. See https://debbugs.gnu.org/17549. (when (bound-and-true-p url-http-response-status) ;; Don't signal an error if VISIT is non-nil, because ;; 'insert-file-contents' doesn't. This is required to @@ -354,7 +354,7 @@ if it had been inserted from a file named URL." (< url-http-response-status 300))) (let ((desc (nth 2 (assq url-http-response-status url-http-codes)))) (kill-buffer buffer) - ;; Signal file-error per http://debbugs.gnu.org/16733. + ;; Signal file-error per https://debbugs.gnu.org/16733. (signal 'file-error (list url desc)))))) (url-insert-buffer-contents buffer url visit beg end replace))) diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index 8657d19da8..fc1b499103 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 06d32861b2..9e8c58b1cd 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-imap.el b/lisp/url/url-imap.el index b8fe4ed5ff..6384ba60fc 100644 --- a/lisp/url/url-imap.el +++ b/lisp/url/url-imap.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 1d0a46ec2c..5a268aa332 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index d9a18e554f..c23a55f353 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-mailto.el b/lisp/url/url-mailto.el index 8c49546aef..c83a1d6573 100644 --- a/lisp/url/url-mailto.el +++ b/lisp/url/url-mailto.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -102,7 +102,7 @@ (goto-char (point-min)) (or (search-forward (concat "\n" mail-header-separator "\n") nil t) (goto-char (point-max))) - (insert (mapconcat + (insert (mapconcat #'(lambda (string) (replace-regexp-in-string "\r\n" "\n" string)) (cdar args) "\n"))) diff --git a/lisp/url/url-methods.el b/lisp/url/url-methods.el index 9f41f35cb8..00b2572421 100644 --- a/lisp/url/url-methods.el +++ b/lisp/url/url-methods.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-misc.el b/lisp/url/url-misc.el index 3515febba2..a5422bbd60 100644 --- a/lisp/url/url-misc.el +++ b/lisp/url/url-misc.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-news.el b/lisp/url/url-news.el index 5130b0c93b..c6e056298f 100644 --- a/lisp/url/url-news.el +++ b/lisp/url/url-news.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-nfs.el b/lisp/url/url-nfs.el index 898d304be6..d8e68fce03 100644 --- a/lisp/url/url-nfs.el +++ b/lisp/url/url-nfs.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-ns.el b/lisp/url/url-ns.el index ada716df60..dcbdf6242b 100644 --- a/lisp/url/url-ns.el +++ b/lisp/url/url-ns.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index ef8e17dd13..4f6ab6bd95 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-privacy.el b/lisp/url/url-privacy.el index 90dfb27513..ab9a6a6b35 100644 --- a/lisp/url/url-privacy.el +++ b/lisp/url/url-privacy.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-proxy.el b/lisp/url/url-proxy.el index 790cb472b0..706cb689e4 100644 --- a/lisp/url/url-proxy.el +++ b/lisp/url/url-proxy.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index dd1699bd08..06a77404b5 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-tramp.el b/lisp/url/url-tramp.el index 50bfa7c499..c28cf6c23a 100644 --- a/lisp/url/url-tramp.el +++ b/lisp/url/url-tramp.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index a3c9655ebd..1d9e386bbc 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index f08779f695..14c5652d6c 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/lisp/url/url.el b/lisp/url/url.el index a6145d3f5f..9a6b732ca9 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/userlock.el b/lisp/userlock.el index a8eb24bd10..1d45b3a4ad 100644 --- a/lisp/userlock.el +++ b/lisp/userlock.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index 91c69202dd..392147b14d 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/compare-w.el b/lisp/vc/compare-w.el index 11e84ae797..f5571c6d11 100644 --- a/lisp/vc/compare-w.el +++ b/lisp/vc/compare-w.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index c170809f05..770791a3c0 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 1d4af54db9..1e835f6f37 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/diff.el b/lisp/vc/diff.el index 7fdd103732..a267908cec 100644 --- a/lisp/vc/diff.el +++ b/lisp/vc/diff.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index b957bdce4f..f36d018004 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el index 339d3a513b..3df0dc7254 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el index 37f8ef55a2..6a65f0d970 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 59d97c3cea..21d040d1e5 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index d91d04467e..39cf44d67d 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 5bf94a5635..4ed6661dee 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 6c8e925d2b..d80db5c04c 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index bcf446a64c..3430d046c0 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el index efd8e93c4b..134b41d41c 100644 --- a/lisp/vc/ediff-vers.el +++ b/lisp/vc/ediff-vers.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 31dcf3b69f..c2b76780e9 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index 4751bb6ddc..d0f8e63dcb 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -29,7 +29,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index cd8ba19f6d..44e7cd78ee 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index e8efc1e6e0..52f56ed990 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index 72caafc4fb..9575b5f7ca 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 8dd513c81f..239a2268aa 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index 2315938a32..f0bb8943f2 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index de45141ddc..9b62780a32 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/pcvs.el b/lisp/vc/pcvs.el index 3ab3423668..4e74d5f6f8 100644 --- a/lisp/vc/pcvs.el +++ b/lisp/vc/pcvs.el @@ -27,7 +27,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index f94f8a6d4d..112a9bc524 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1094,7 +1094,7 @@ used to replace chars to try and eliminate some spurious differences." ;; also and more importantly because otherwise it ;; may happen that diff doesn't behave like ;; smerge-refine-weight-hack expects it to. - ;; See http://thread.gmane.org/gmane.emacs.devel/82685, aka https://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00401.html + ;; See http://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00401.html "-awd" "-ad") file1 file2)) ;; Process diff's output. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index 12df680ce0..a6c0e5a72d 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index d0e9f7744b..51b104cbcd 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index bab835c84a..36cb2e5fcb 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 4aa185186c..f951c67498 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 0363aab840..41c44e2c24 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Credits: diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index c71030aba1..479003e65a 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Credits: diff --git a/lisp/vc/vc-filewise.el b/lisp/vc/vc-filewise.el index 16f833cc5b..87a2e33264 100644 --- a/lisp/vc/vc-filewise.el +++ b/lisp/vc/vc-filewise.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 71cf57ab32..095f184ddf 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1555,7 +1555,7 @@ The difference to vc-do-command is that this function always invokes (or coding-system-for-write vc-git-commits-coding-system)) (process-environment (cons "GIT_DIR" process-environment))) (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program - ;; http://debbugs.gnu.org/16897 + ;; https://debbugs.gnu.org/16897 (unless (and (not (cdr-safe file-or-list)) (let ((file (or (car-safe file-or-list) file-or-list))) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 4be529624a..7a04a54377 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 2c2534a034..4c94280faf 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index ac95da08f1..eed4bd09df 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index afeb5ef23d..9dffc144c6 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index fd27db381d..f873fbfe1d 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 0e47cc1512..0a219ff94a 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index f1e8985c16..f0987bf667 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 9379bcf74d..b80f0e6949 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Credits: diff --git a/lisp/vcursor.el b/lisp/vcursor.el index 22727bc8d6..0d7a5ff885 100644 --- a/lisp/vcursor.el +++ b/lisp/vcursor.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/version.el b/lisp/version.el index ea6f1b4694..1792a81f71 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/view.el b/lisp/view.el index fb478e1778..2d26a11a81 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vt-control.el b/lisp/vt-control.el index 8755420d18..7ea68817c2 100644 --- a/lisp/vt-control.el +++ b/lisp/vt-control.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el index c86a826ddb..a6f43fbf6b 100644 --- a/lisp/vt100-led.el +++ b/lisp/vt100-led.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 93551de440..1ba6403bea 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el index 50f62559a4..3309db3412 100644 --- a/lisp/w32-vars.el +++ b/lisp/w32-vars.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/wdired.el b/lisp/wdired.el index 179b51b711..b8de02dd37 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 4198b9bd0e..14247646d4 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index f105de244a..d8054e348e 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 6687bec31f..f071c402c0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Wishlist items (from widget.texi): diff --git a/lisp/widget.el b/lisp/widget.el index 30d28180ab..baa9140b26 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/lisp/windmove.el b/lisp/windmove.el index 0797ef8b9d..14656c98d1 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;; -------------------------------------------------------------------- diff --git a/lisp/window.el b/lisp/window.el index 7aea9ae739..5ba9a305f9 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/winner.el b/lisp/winner.el index 7b0483338b..61ea4d40e7 100644 --- a/lisp/winner.el +++ b/lisp/winner.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/woman.el b/lisp/woman.el index 6620ce4a2b..111086e362 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -22,7 +22,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 80ec4101bd..acbdcb9ee5 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/xdg.el b/lisp/xdg.el index 183d050cc6..e94fa8ec92 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/xml.el b/lisp/xml.el index 88dc70bc41..3688088693 100644 --- a/lisp/xml.el +++ b/lisp/xml.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index acb30187a8..772a72d5c5 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/lisp/xwidget.el b/lisp/xwidget.el index c908f1a5b0..5e37209cc2 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;; ;; -------------------------------------------------------------------- diff --git a/lwlib/Makefile.in b/lwlib/Makefile.in index ee7a2040e8..148002aaae 100644 --- a/lwlib/Makefile.in +++ b/lwlib/Makefile.in @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # This was taken from the output of Imake using Lucid's Imakefile. diff --git a/lwlib/deps.mk b/lwlib/deps.mk index 525c9f1230..5bdf1af778 100644 --- a/lwlib/deps.mk +++ b/lwlib/deps.mk @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . ### Commentary: diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index ec33e78829..ce007ae8b0 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lwlib/lwlib-Xlw.c b/lwlib/lwlib-Xlw.c index 10ed3267d6..0d58a030ac 100644 --- a/lwlib/lwlib-Xlw.c +++ b/lwlib/lwlib-Xlw.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lwlib/lwlib-Xm.c b/lwlib/lwlib-Xm.c index b18429067d..2ac543cad7 100644 --- a/lwlib/lwlib-Xm.c +++ b/lwlib/lwlib-Xm.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lwlib/lwlib-Xm.h b/lwlib/lwlib-Xm.h index 043ebc7c0d..09b1920440 100644 --- a/lwlib/lwlib-Xm.h +++ b/lwlib/lwlib-Xm.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef LWLIB_XM_H #define LWLIB_XM_H diff --git a/lwlib/lwlib-int.h b/lwlib/lwlib-int.h index 5b739971e2..ae195a39a8 100644 --- a/lwlib/lwlib-int.h +++ b/lwlib/lwlib-int.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef LWLIB_INTERNAL_H diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c index 3c7a7a6bf7..6f33e510f7 100644 --- a/lwlib/lwlib-utils.c +++ b/lwlib/lwlib-utils.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lwlib/lwlib-widget.h b/lwlib/lwlib-widget.h index 6a88d2a18c..6863b90c9a 100644 --- a/lwlib/lwlib-widget.h +++ b/lwlib/lwlib-widget.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* This part is separate from lwlib.h because it does not need X, and thus can be used by non-X code in Emacs proper. */ diff --git a/lwlib/lwlib.c b/lwlib/lwlib.c index fffb17f7c3..30fa046cb7 100644 --- a/lwlib/lwlib.c +++ b/lwlib/lwlib.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/lwlib/lwlib.h b/lwlib/lwlib.h index f88536982e..e28d0e8356 100644 --- a/lwlib/lwlib.h +++ b/lwlib/lwlib.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef LWLIB_H diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 1ce4aead93..cfd20ba649 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Created by devin@lucid.com */ diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h index a6aed48633..7c27839625 100644 --- a/lwlib/xlwmenu.h +++ b/lwlib/xlwmenu.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef _XlwMenu_h #define _XlwMenu_h diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h index a89934cefe..e7be866be7 100644 --- a/lwlib/xlwmenuP.h +++ b/lwlib/xlwmenuP.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef _XlwMenuP_h #define _XlwMenuP_h diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4 index ec0860be90..34224d7705 100644 --- a/m4/sys_types_h.m4 +++ b/m4/sys_types_h.m4 @@ -40,7 +40,7 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS], m4_version_prereq([2.70], [], [ # This is taken from the following Autoconf patch: -# http://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98 +# https://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98 m4_undefine([AC_HEADER_MAJOR]) AC_DEFUN([AC_HEADER_MAJOR], diff --git a/make-dist b/make-dist index b4667843ce..934f83ea08 100755 --- a/make-dist +++ b/make-dist @@ -17,7 +17,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/modules/modhelp.py b/modules/modhelp.py index ab2ce5c8ef..78fadda412 100755 --- a/modules/modhelp.py +++ b/modules/modhelp.py @@ -17,7 +17,7 @@ # 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 . +# along with GNU Emacs. If not, see . import os import string diff --git a/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html b/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html index 9a9e2f3c69..df79ec941f 100644 --- a/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html +++ b/nextstep/Cocoa/Emacs.base/Contents/Resources/Credits.html @@ -1 +1 @@ -http://www.gnu.org/software/emacs +https://www.gnu.org/software/emacs diff --git a/nextstep/INSTALL b/nextstep/INSTALL index b7e84e018e..326e02a550 100644 --- a/nextstep/INSTALL +++ b/nextstep/INSTALL @@ -65,4 +65,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/nextstep/Makefile.in b/nextstep/Makefile.in index ad1abb0bf5..5ddf484fe8 100644 --- a/nextstep/Makefile.in +++ b/nextstep/Makefile.in @@ -15,7 +15,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ### Commentary: diff --git a/nextstep/README b/nextstep/README index 94993d831f..03d69b16b2 100644 --- a/nextstep/README +++ b/nextstep/README @@ -120,4 +120,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/nextstep/templates/Info.plist.in b/nextstep/templates/Info.plist.in index b1dae4e669..5d2eb7def3 100644 --- a/nextstep/templates/Info.plist.in +++ b/nextstep/templates/Info.plist.in @@ -15,7 +15,7 @@ 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 . +along with GNU Emacs. If not, see . --> diff --git a/nt/README b/nt/README index 09d6820d7f..19ffd50f90 100644 --- a/nt/README +++ b/nt/README @@ -9,9 +9,9 @@ subprocesses, windowing features (fonts, colors, scroll bars, multiple frames, etc.), and networking support. - Precompiled distributions are also available; ftp to + Precompiled distributions are also available; see: - ftp://ftp.gnu.org/gnu/emacs/windows/ + https://ftp.gnu.org/gnu/emacs/windows/ for the latest precompiled distributions. diff --git a/nt/README.W32 b/nt/README.W32 index 1141e8a1b7..a670687ef2 100644 --- a/nt/README.W32 +++ b/nt/README.W32 @@ -8,7 +8,7 @@ See the end of the file for license conditions. can find the precompiled distribution on the ftp.gnu.org server and its mirrors: - ftp://ftp.gnu.org/gnu/emacs/windows/ + https://ftp.gnu.org/gnu/emacs/windows/ This server contains other distributions, including the full Emacs source distribution, as well as older releases of Emacs for Windows. diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c index 876cb3d06b..c27005fd9e 100644 --- a/oldXMenu/Activate.c +++ b/oldXMenu/Activate.c @@ -16,7 +16,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* * XMenu: MIT Project Athena, X Window system menu package diff --git a/oldXMenu/Create.c b/oldXMenu/Create.c index a091368536..83e6c8e38c 100644 --- a/oldXMenu/Create.c +++ b/oldXMenu/Create.c @@ -16,7 +16,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* diff --git a/oldXMenu/FindSel.c b/oldXMenu/FindSel.c index 7440b3dd9c..37a87a819a 100644 --- a/oldXMenu/FindSel.c +++ b/oldXMenu/FindSel.c @@ -16,7 +16,7 @@ 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 this program. If not, see . +along with this program. If not, see . */ /* diff --git a/oldXMenu/Internal.c b/oldXMenu/Internal.c index bc4ed22329..913904474c 100644 --- a/oldXMenu/Internal.c +++ b/oldXMenu/Internal.c @@ -16,7 +16,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* diff --git a/oldXMenu/Makefile.in b/oldXMenu/Makefile.in index 7a5c998592..59a6c7465b 100644 --- a/oldXMenu/Makefile.in +++ b/oldXMenu/Makefile.in @@ -28,7 +28,7 @@ ## GNU General Public License for more details. ## You should have received a copy of the GNU General Public License -## along with this program. If not, see . +## along with this program. If not, see . ### Commentary: diff --git a/oldXMenu/deps.mk b/oldXMenu/deps.mk index bbd98ca7c2..acb42e491a 100644 --- a/oldXMenu/deps.mk +++ b/oldXMenu/deps.mk @@ -28,7 +28,7 @@ ## GNU General Public License for more details. ## You should have received a copy of the GNU General Public License -## along with this program. If not, see . +## along with this program. If not, see . ### Commentary: diff --git a/oldXMenu/insque.c b/oldXMenu/insque.c index 2906f9c040..0c6afc6f62 100644 --- a/oldXMenu/insque.c +++ b/oldXMenu/insque.c @@ -12,7 +12,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* This file implements the emacs_insque and emacs_remque functions, clones of the insque and remque functions of BSD. They and all diff --git a/src/.gdbinit b/src/.gdbinit index 21cdca5b2c..60f6348715 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -13,7 +13,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Force loading of symbols, enough to give us VALBITS etc. set $dummy = main + 8 diff --git a/src/Makefile.in b/src/Makefile.in index a98ad9c5eb..0e55ad4bb2 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -16,7 +16,7 @@ # 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 . +# along with GNU Emacs. If not, see . # Note that this file is edited by msdos/sed1v2.inp for MSDOS. That diff --git a/src/README b/src/README index fef2ff4e9e..4790c04141 100644 --- a/src/README +++ b/src/README @@ -27,4 +27,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/src/alloc.c b/src/alloc.c index 300f5e420d..87e9ef0059 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/atimer.c b/src/atimer.c index 5feb1f6777..0abd6c19c3 100644 --- a/src/atimer.c +++ b/src/atimer.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/atimer.h b/src/atimer.h index 30a5856ffd..fb85193d82 100644 --- a/src/atimer.h +++ b/src/atimer.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_ATIMER_H #define EMACS_ATIMER_H diff --git a/src/bidi.c b/src/bidi.c index 763797488b..fd73b54837 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Written by Eli Zaretskii . diff --git a/src/blockinput.h b/src/blockinput.h index d57c5bae2a..1ca3b47c96 100644 --- a/src/blockinput.h +++ b/src/blockinput.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_BLOCKINPUT_H #define EMACS_BLOCKINPUT_H diff --git a/src/buffer.c b/src/buffer.c index f2689b61fd..bc28ac7d1a 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/buffer.h b/src/buffer.h index 46ca6aa738..ac7c5a5467 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_BUFFER_H #define EMACS_BUFFER_H diff --git a/src/bytecode.c b/src/bytecode.c index a473dfb9c8..50c7abe289 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/callint.c b/src/callint.c index 96436116c8..105ec071d0 100644 --- a/src/callint.c +++ b/src/callint.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/callproc.c b/src/callproc.c index b93d361a94..9375ce5312 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/casefiddle.c b/src/casefiddle.c index 443d62b625..8f564edeb9 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/casetab.c b/src/casetab.c index 6108bb680b..924bf9a527 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/category.c b/src/category.c index b633f65532..eced906584 100644 --- a/src/category.c +++ b/src/category.c @@ -22,7 +22,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Here we handle three objects: category, category set, and category diff --git a/src/category.h b/src/category.h index 247f9093d0..c4feedd358 100644 --- a/src/category.h +++ b/src/category.h @@ -20,7 +20,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CATEGORY_H #define EMACS_CATEGORY_H diff --git a/src/ccl.c b/src/ccl.c index b2caf413f7..dc7afc5ef6 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -21,7 +21,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include @@ -730,7 +730,7 @@ while (0) #endif /* Use "&" rather than "&&" to suppress a bogus GCC warning; see - . */ + . */ #define ASCENDING_ORDER(lo, med, hi) (((lo) <= (med)) & ((med) <= (hi))) #define GET_CCL_RANGE(var, ccl_prog, ic, lo, hi) \ diff --git a/src/ccl.h b/src/ccl.h index 10860f509d..8eb9d7eb2e 100644 --- a/src/ccl.h +++ b/src/ccl.h @@ -20,7 +20,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CCL_H diff --git a/src/character.c b/src/character.c index 1c6020ee46..c8ffa2b2cd 100644 --- a/src/character.c +++ b/src/character.c @@ -20,7 +20,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* At first, see the document in `character.h' to understand the code in this file. */ diff --git a/src/character.h b/src/character.h index b073a0dd1e..c716885d46 100644 --- a/src/character.h +++ b/src/character.h @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CHARACTER_H #define EMACS_CHARACTER_H diff --git a/src/charset.c b/src/charset.c index 6ce2f902c8..ab207eaa1b 100644 --- a/src/charset.c +++ b/src/charset.c @@ -24,7 +24,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/charset.h b/src/charset.h index a26d64343d..2b6875ce3f 100644 --- a/src/charset.h +++ b/src/charset.h @@ -22,7 +22,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CHARSET_H #define EMACS_CHARSET_H diff --git a/src/chartab.c b/src/chartab.c index 8392c0c07d..065ae4f9f2 100644 --- a/src/chartab.c +++ b/src/chartab.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/cm.c b/src/cm.c index 9a90f37445..f3f41549b2 100644 --- a/src/cm.c +++ b/src/cm.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/cm.h b/src/cm.h index 83ef512c99..1002672db7 100644 --- a/src/cm.h +++ b/src/cm.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CM_H #define EMACS_CM_H diff --git a/src/cmds.c b/src/cmds.c index 6f2db8696e..e4c0c86691 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/coding.c b/src/coding.c index 50ad206be6..d790ad08ea 100644 --- a/src/coding.c +++ b/src/coding.c @@ -21,7 +21,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /*** TABLE OF CONTENTS *** diff --git a/src/coding.h b/src/coding.h index 8ed851d99f..66d125b07e 100644 --- a/src/coding.h +++ b/src/coding.h @@ -21,7 +21,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_CODING_H #define EMACS_CODING_H diff --git a/src/commands.h b/src/commands.h index 03e1b73e98..5dc1100294 100644 --- a/src/commands.h +++ b/src/commands.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_COMMANDS_H #define EMACS_COMMANDS_H diff --git a/src/composite.c b/src/composite.c index 05a296329a..c01e2e3b95 100644 --- a/src/composite.c +++ b/src/composite.c @@ -20,7 +20,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/composite.h b/src/composite.h index dc1e7ce345..7f0cc1cd35 100644 --- a/src/composite.h +++ b/src/composite.h @@ -20,7 +20,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_COMPOSITE_H #define EMACS_COMPOSITE_H diff --git a/src/conf_post.h b/src/conf_post.h index e1d6a9397d..096a677997 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Put the code here rather than in configure.ac using AH_BOTTOM. This way, the code does not get processed by autoheader. For diff --git a/src/data.c b/src/data.c index c9818b6b20..feca0a6f37 100644 --- a/src/data.c +++ b/src/data.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/dbusbind.c b/src/dbusbind.c index 0d9d3e514f..4a7068416f 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/decompress.c b/src/decompress.c index a53a66df18..12b1f6ca09 100644 --- a/src/decompress.c +++ b/src/decompress.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/deps.mk b/src/deps.mk index b56d880da8..a94d198b84 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -16,7 +16,7 @@ ## 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 . +## along with GNU Emacs. If not, see . ## Commentary: ## diff --git a/src/dired.c b/src/dired.c index 128493aff2..28d1cffb44 100644 --- a/src/dired.c +++ b/src/dired.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/dispextern.h b/src/dispextern.h index 1df769a8f9..2f55d8cbc8 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* New redisplay written by Gerd Moellmann . */ diff --git a/src/dispnew.c b/src/dispnew.c index 93ef6a55a2..2d1df54698 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/disptab.h b/src/disptab.h index cdfb080dff..592a1fa018 100644 --- a/src/disptab.h +++ b/src/disptab.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Access the slots of a display-table, according to their purpose. */ diff --git a/src/doc.c b/src/doc.c index 345e18b918..3286c12675 100644 --- a/src/doc.c +++ b/src/doc.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include @@ -538,7 +538,7 @@ the same file name is found in the `doc-directory'. */) char const *dirname; ptrdiff_t dirlen; /* Preloaded defcustoms using custom-initialize-delay are added to - this list, but kept unbound. See http://debbugs.gnu.org/11565 */ + this list, but kept unbound. See https://debbugs.gnu.org/11565 */ Lisp_Object delayed_init = find_symbol_value (intern ("custom-delayed-init-variables")); diff --git a/src/doprnt.c b/src/doprnt.c index 418601acb0..89d7e99deb 100644 --- a/src/doprnt.c +++ b/src/doprnt.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* If you think about replacing this with some similar standard C function of the printf family (such as vsnprintf), please note that this function diff --git a/src/dynlib.c b/src/dynlib.c index 47ba5e3d91..a6d70484fc 100644 --- a/src/dynlib.c +++ b/src/dynlib.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Assume modules are enabled on modern systems... *Yes*, the diff --git a/src/dynlib.h b/src/dynlib.h index 1d53b8e5b2..5669995624 100644 --- a/src/dynlib.h +++ b/src/dynlib.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef DYNLIB_H #define DYNLIB_H diff --git a/src/editfns.c b/src/editfns.c index d54c9c1aba..b03eb947de 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/emacs-icon.h b/src/emacs-icon.h index b5ba89e15f..f126458e9d 100644 --- a/src/emacs-icon.h +++ b/src/emacs-icon.h @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Note that the GTK port uses gdk to display the icon, so Emacs need not have XPM support compiled in. */ diff --git a/src/emacs-module.c b/src/emacs-module.c index ad6c8fb010..e5833a1d1f 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in index 40b6448d27..d83cd43014 100644 --- a/src/emacs-module.h.in +++ b/src/emacs-module.h.in @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_MODULE_H #define EMACS_MODULE_H diff --git a/src/emacs.c b/src/emacs.c index 668711a5ab..1ad8af70a7 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #define INLINE EXTERN_INLINE #include diff --git a/src/emacsgtkfixed.c b/src/emacsgtkfixed.c index 75cb3c1c72..1a00e0f680 100644 --- a/src/emacsgtkfixed.c +++ b/src/emacsgtkfixed.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/emacsgtkfixed.h b/src/emacsgtkfixed.h index 776ac453c0..8f2acd6bba 100644 --- a/src/emacsgtkfixed.h +++ b/src/emacsgtkfixed.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACSGTKFIXED_H #define EMACSGTKFIXED_H diff --git a/src/epaths.in b/src/epaths.in index c491d3b72e..8f77b0a14f 100644 --- a/src/epaths.in +++ b/src/epaths.in @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Together with PATH_SITELOADSEARCH, this gives the default value of @@ -75,4 +75,3 @@ along with GNU Emacs. If not, see . */ /* Where Emacs should look for the application default file. */ #define PATH_X_DEFAULTS "/usr/lib/X11/%L/%T/%N%C%S:/usr/lib/X11/%l/%T/%N%C%S:/usr/lib/X11/%T/%N%C%S:/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S" - diff --git a/src/eval.c b/src/eval.c index a6612b93e2..62e219631d 100644 --- a/src/eval.c +++ b/src/eval.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/fileio.c b/src/fileio.c index 3195348a8c..adb3534532 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include @@ -2046,7 +2046,7 @@ permissions. */) { /* Set the modified context back to the file. */ bool fail = fsetfilecon (ofd, con) != 0; - /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ + /* See https://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) report_file_error ("Doing fsetfilecon", newname); @@ -2943,7 +2943,7 @@ or if Emacs was not compiled with SELinux support. */) fail = (lsetfilecon (SSDATA (encoded_absname), context_str (parsed_con)) != 0); - /* See http://debbugs.gnu.org/11245 for ENOTSUP. */ + /* See https://debbugs.gnu.org/11245 for ENOTSUP. */ if (fail && errno != ENOTSUP) report_file_error ("Doing lsetfilecon", absname); diff --git a/src/filelock.c b/src/filelock.c index fd4f0aa864..a8bc17c37b 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -19,7 +19,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/firstfile.c b/src/firstfile.c index c952e38aa6..43f45f2bef 100644 --- a/src/firstfile.c +++ b/src/firstfile.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/floatfns.c b/src/floatfns.c index 47553f27e8..47e94b8c86 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* C89 requires only the following math.h functions, and Emacs omits diff --git a/src/fns.c b/src/fns.c index ef9a1758d6..13d235965e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/font.c b/src/font.c index a5e5b6a5b9..51625b49fa 100644 --- a/src/font.c +++ b/src/font.c @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/font.h b/src/font.h index 53e3fc21a3..8f2e27f0ed 100644 --- a/src/font.h +++ b/src/font.h @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_FONT_H #define EMACS_FONT_H diff --git a/src/fontset.c b/src/fontset.c index 74018060b8..35586ad5c7 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -22,7 +22,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/fontset.h b/src/fontset.h index 8bf9f754fb..cd6709dac2 100644 --- a/src/fontset.h +++ b/src/fontset.h @@ -21,7 +21,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_FONTSET_H #define EMACS_FONTSET_H diff --git a/src/frame.c b/src/frame.c index 6e0c51b2f5..39e5cc9c85 100644 --- a/src/frame.c +++ b/src/frame.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include @@ -1913,7 +1913,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* Look for another visible frame on the same terminal. Do not call next_frame here because it may loop forever. - See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */ + See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15025. */ FOR_EACH_FRAME (tail, frame1) if (!EQ (frame, frame1) && (FRAME_TERMINAL (XFRAME (frame)) diff --git a/src/frame.h b/src/frame.h index 4b7e448b54..d1c21da4d2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_FRAME_H #define EMACS_FRAME_H diff --git a/src/fringe.c b/src/fringe.c index 5d3108a6c7..087ef33434 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/ftcrfont.c b/src/ftcrfont.c index 9b592e6a74..ad68ce8ceb 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/ftfont.c b/src/ftfont.c index 5600bde646..35f5923376 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/ftfont.h b/src/ftfont.h index 90abb45295..4201b2c2d6 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_FTFONT_H diff --git a/src/ftxfont.c b/src/ftxfont.c index 8c829bb8f9..3b27da6743 100644 --- a/src/ftxfont.c +++ b/src/ftxfont.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/getpagesize.h b/src/getpagesize.h index 75b25b8898..951973033d 100644 --- a/src/getpagesize.h +++ b/src/getpagesize.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef HAVE_GETPAGESIZE diff --git a/src/gfilenotify.c b/src/gfilenotify.c index fa4854c664..13a3eae772 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/gmalloc.c b/src/gmalloc.c index baaff58050..2bda95ebd3 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c @@ -14,7 +14,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -308,7 +308,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -965,7 +965,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1275,7 +1275,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1445,7 +1445,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1483,7 +1483,7 @@ 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 the GNU C Library. If not, see . */ +along with the GNU C Library. If not, see . */ /* uClibc defines __GNU_LIBRARY__, but it is not completely compatible. */ @@ -1530,7 +1530,7 @@ 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 this library. If not, see . */ +License along with this library. If not, see . */ void * aligned_alloc (size_t alignment, size_t size) @@ -1662,7 +1662,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1847,7 +1847,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ diff --git a/src/gnutls.c b/src/gnutls.c index 188f995979..d7a1399f10 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include @@ -554,7 +554,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) { # ifdef _AIX /* This is taken from the GnuTLS system_errno function circa 2016; - see . */ + see . */ case 0: errno = EAGAIN; /* Fall through. */ @@ -1355,7 +1355,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist) c_hostname = SSDATA (hostname); /* Now verify the peer, following - http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html. + https://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html. The peer should present at least one certificate in the chain; do a check of the certificate's hostname with gnutls_x509_crt_check_hostname against :hostname. */ diff --git a/src/gnutls.h b/src/gnutls.h index 9323cd1aef..00fa55b6c0 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_GNUTLS_DEFINED #define EMACS_GNUTLS_DEFINED diff --git a/src/gtkutil.c b/src/gtkutil.c index a2e322b1da..0203a5d5c1 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/gtkutil.h b/src/gtkutil.h index f0f2981418..f71f4bb0ed 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef GTKUTIL_H #define GTKUTIL_H diff --git a/src/image.c b/src/image.c index 7f5cf1a966..3dac7086cb 100644 --- a/src/image.c +++ b/src/image.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include @@ -7148,7 +7148,7 @@ tiff_size_of_memory (thandle_t data) /* GCC 3.x on x86 Windows targets has a bug that triggers an internal compiler error compiling tiff_handler, see Bugzilla bug #17406 - (http://gcc.gnu.org/bugzilla/show_bug.cgi?id=17406). Declaring + (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=17406). Declaring this function as external works around that problem. */ # if defined (__MINGW32__) && __GNUC__ == 3 # define MINGW_STATIC diff --git a/src/indent.c b/src/indent.c index d76ac028d5..26507b5eb5 100644 --- a/src/indent.c +++ b/src/indent.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/indent.h b/src/indent.h index 42ae1260bc..27a3c58388 100644 --- a/src/indent.h +++ b/src/indent.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_INDENT_H #define EMACS_INDENT_H diff --git a/src/inotify.c b/src/inotify.c index 3d5d3d2621..c0fc1db157 100644 --- a/src/inotify.c +++ b/src/inotify.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/insdel.c b/src/insdel.c index 0a2e07a343..5dfc62843a 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/intervals.c b/src/intervals.c index e65c22977e..e711212d74 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* NOTES: diff --git a/src/intervals.h b/src/intervals.h index 9140e0c17a..7dec6e5c76 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_INTERVALS_H #define EMACS_INTERVALS_H diff --git a/src/keyboard.c b/src/keyboard.c index 97069a24ac..4db50be855 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/keyboard.h b/src/keyboard.h index 2219c01135..a2a5f8f21d 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_KEYBOARD_H #define EMACS_KEYBOARD_H diff --git a/src/keymap.c b/src/keymap.c index db9aa7cbf3..ccf8ce7917 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Old BUGS: - [M-C-a] != [?\M-\C-a] diff --git a/src/keymap.h b/src/keymap.h index af0affbc84..2a1945a80a 100644 --- a/src/keymap.h +++ b/src/keymap.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef KEYMAP_H #define KEYMAP_H diff --git a/src/kqueue.c b/src/kqueue.c index 30922ef28b..221b0032d8 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/lastfile.c b/src/lastfile.c index f146602b3a..2901f148e1 100644 --- a/src/lastfile.c +++ b/src/lastfile.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* How this works: diff --git a/src/lcms.c b/src/lcms.c index 4c3a8b529d..10c79ae24a 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/lisp.h b/src/lisp.h index 19594e7830..40e84ec7ec 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_LISP_H #define EMACS_LISP_H diff --git a/src/lread.c b/src/lread.c index dbaadce4b4..6bc93b1481 100644 --- a/src/lread.c +++ b/src/lread.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Tell globals.h to define tables needed by init_obarray. */ #define DEFINE_SYMBOLS diff --git a/src/macfont.h b/src/macfont.h index 909336cdba..5ac604b0be 100644 --- a/src/macfont.h +++ b/src/macfont.h @@ -14,7 +14,7 @@ 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 . +along with GNU Emacs. If not, see . Original author: YAMAMOTO Mitsuharu */ diff --git a/src/macfont.m b/src/macfont.m index 59891353cd..97879506ba 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -14,7 +14,7 @@ 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 . +along with GNU Emacs. If not, see . Original author: YAMAMOTO Mitsuharu */ diff --git a/src/macros.c b/src/macros.c index f0ffda3f44..b32d73068a 100644 --- a/src/macros.c +++ b/src/macros.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/macros.h b/src/macros.h index 31aece434d..dde3eb0c3f 100644 --- a/src/macros.h +++ b/src/macros.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_MACROS_H #define EMACS_MACROS_H diff --git a/src/marker.c b/src/marker.c index f0c357fec0..2f7e649e9a 100644 --- a/src/marker.c +++ b/src/marker.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/menu.c b/src/menu.c index 99a2ce8f7e..d569b4b29b 100644 --- a/src/menu.c +++ b/src/menu.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/menu.h b/src/menu.h index 2bb79ee82c..1469cc87d9 100644 --- a/src/menu.h +++ b/src/menu.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef MENU_H #define MENU_H diff --git a/src/minibuf.c b/src/minibuf.c index 010152930b..a2f3324f99 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/nsfns.m b/src/nsfns.m index b00441eb79..ba36362968 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Originally by Carl Edman diff --git a/src/nsfont.m b/src/nsfont.m index 1bfc3df146..bcddd724c0 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -15,7 +15,7 @@ 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 . +along with GNU Emacs. If not, see . Author: Adrian Robert (arobert@cogsci.ucsd.edu) */ @@ -301,7 +301,7 @@ static void ns_glyph_metrics (struct nsfont_info *font_info, int i, off = 0, tot = 0; /* Work around what appears to be a GNUstep bug. - See . */ + See . */ if (! (bytes1 && bytes2)) return NO; diff --git a/src/nsgui.h b/src/nsgui.h index a06eecf688..e20f3e35e1 100644 --- a/src/nsgui.h +++ b/src/nsgui.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef __NSGUI_H__ #define __NSGUI_H__ diff --git a/src/nsimage.m b/src/nsimage.m index ea2f1ec54a..9d45b063af 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Originally by Carl Edman diff --git a/src/nsmenu.m b/src/nsmenu.m index 93e06707c0..6ef7b60dc2 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* By Adrian Robert, based on code from original nsmenu.m (Carl Edman, diff --git a/src/nsselect.m b/src/nsselect.m index 8b38daeb6c..067c7788e8 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Originally by Carl Edman diff --git a/src/nsterm.h b/src/nsterm.h index 65b7a0347a..de96e0dbcb 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include "dispextern.h" diff --git a/src/nsterm.m b/src/nsterm.m index 001e4576e8..2751533533 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Originally by Carl Edman @@ -6076,7 +6076,7 @@ flag set (this is probably a bug in the OS). /* GNUstep uses incompatible keycodes, even for those that are supposed to be hardware independent. Just check for delete. Keypad delete does not have keysym 0xFFFF. - See http://savannah.gnu.org/bugs/?25395 + See https://savannah.gnu.org/bugs/?25395 */ || (fnKeysym == 0xFFFF && code == 127) #endif diff --git a/src/print.c b/src/print.c index 12edf01589..f280616af8 100644 --- a/src/print.c +++ b/src/print.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/process.c b/src/process.c index c45a3f63ce..b941b5c1f9 100644 --- a/src/process.c +++ b/src/process.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include @@ -142,7 +142,7 @@ extern int sys_select (int, fd_set *, fd_set *, fd_set *, #endif /* Work around GCC 4.3.0 bug with strict overflow checking; see - . + . This bug appears to be fixed in GCC 5.1, so don't work around it there. */ #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0) # pragma GCC diagnostic ignored "-Wstrict-overflow" diff --git a/src/process.h b/src/process.h index 2c174cc3ea..5a044f669f 100644 --- a/src/process.h +++ b/src/process.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_PROCESS_H #define EMACS_PROCESS_H diff --git a/src/profiler.c b/src/profiler.c index 6dc0d8ce72..d9d7d0b1c7 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include "lisp.h" diff --git a/src/puresize.h b/src/puresize.h index b90b697042..0824437bdf 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_PURESIZE_H #define EMACS_PURESIZE_H diff --git a/src/ralloc.c b/src/ralloc.c index 8a3d2b797f..59a15e08ad 100644 --- a/src/ralloc.c +++ b/src/ralloc.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* NOTES: diff --git a/src/regex.c b/src/regex.c index 0dbb47309e..330f2f78a8 100644 --- a/src/regex.c +++ b/src/regex.c @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* TODO: - structure the opcode space into opcode+flag. diff --git a/src/regex.h b/src/regex.h index 5e3a79763e..9fa8356011 100644 --- a/src/regex.h +++ b/src/regex.h @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _REGEX_H #define _REGEX_H 1 diff --git a/src/region-cache.c b/src/region-cache.c index 36c8759366..a00b28ea22 100644 --- a/src/region-cache.c +++ b/src/region-cache.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/region-cache.h b/src/region-cache.h index 6327e2dc08..483ee36831 100644 --- a/src/region-cache.h +++ b/src/region-cache.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_REGION_CACHE_H #define EMACS_REGION_CACHE_H diff --git a/src/scroll.c b/src/scroll.c index 482a026192..7004dcd9ae 100644 --- a/src/scroll.c +++ b/src/scroll.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/search.c b/src/search.c index 19e789dfa8..0cb1ec41f5 100644 --- a/src/search.c +++ b/src/search.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/sheap.c b/src/sheap.c index f7028b0cf7..09c1342bac 100644 --- a/src/sheap.c +++ b/src/sheap.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/sheap.h b/src/sheap.h index 023db8c0fc..f18eb2f1ce 100644 --- a/src/sheap.h +++ b/src/sheap.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include "lisp.h" diff --git a/src/sound.c b/src/sound.c index 75c27a97f4..7a7f03d303 100644 --- a/src/sound.c +++ b/src/sound.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Written by Gerd Moellmann . Tested with Luigi's driver on FreeBSD 2.2.7 with a SoundBlaster 16. */ diff --git a/src/syntax.c b/src/syntax.c index dcaca22f0e..80603b4f8b 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/syntax.h b/src/syntax.h index f0bb9569cc..2a7ba54e60 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_SYNTAX_H #define EMACS_SYNTAX_H diff --git a/src/sysdep.c b/src/sysdep.c index f5050e60f4..318d4eb380 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/sysselect.h b/src/sysselect.h index 2ddea665b3..8295aeb842 100644 --- a/src/sysselect.h +++ b/src/sysselect.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef SYSSELECT_H #define SYSSELECT_H 1 diff --git a/src/syssignal.h b/src/syssignal.h index 8b815a29a3..61e1c5f60e 100644 --- a/src/syssignal.h +++ b/src/syssignal.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSSIGNAL_H #define EMACS_SYSSIGNAL_H diff --git a/src/sysstdio.h b/src/sysstdio.h index 7fbcefcdad..87d62afc3d 100644 --- a/src/sysstdio.h +++ b/src/sysstdio.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSSTDIO_H #define EMACS_SYSSTDIO_H diff --git a/src/systhread.c b/src/systhread.c index aee12a9b48..ee89a1ed3f 100644 --- a/src/systhread.c +++ b/src/systhread.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/systhread.h b/src/systhread.h index c7999c0651..443dc55c6a 100644 --- a/src/systhread.h +++ b/src/systhread.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef SYSTHREAD_H #define SYSTHREAD_H diff --git a/src/systime.h b/src/systime.h index d79eb21396..f9f1db35eb 100644 --- a/src/systime.h +++ b/src/systime.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSTIME_H #define EMACS_SYSTIME_H diff --git a/src/systty.h b/src/systty.h index 9f2c61e0d6..a5ffc7b1d7 100644 --- a/src/systty.h +++ b/src/systty.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_SYSTTY_H #define EMACS_SYSTTY_H diff --git a/src/syswait.h b/src/syswait.h index 055562ae48..939c16f4fb 100644 --- a/src/syswait.h +++ b/src/syswait.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Define the structure that the wait system call stores. On many systems, there is a structure defined for this. diff --git a/src/term.c b/src/term.c index c1d7b0483e..a2ae8c2c6f 100644 --- a/src/term.c +++ b/src/term.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* New redisplay, TTY faces by Gerd Moellmann . */ diff --git a/src/termcap.c b/src/termcap.c index a0e558d9ca..6942c33dae 100644 --- a/src/termcap.c +++ b/src/termcap.c @@ -13,7 +13,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* Emacs config.h may rename various library functions such as malloc. */ #include diff --git a/src/termchar.h b/src/termchar.h index cf061a9780..3e1695d075 100644 --- a/src/termchar.h +++ b/src/termchar.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_TERMCHAR_H #define EMACS_TERMCHAR_H diff --git a/src/termhooks.h b/src/termhooks.h index 14ec397346..97c128ba4e 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_TERMHOOKS_H #define EMACS_TERMHOOKS_H diff --git a/src/terminal.c b/src/terminal.c index 367f2ac719..0edaad65c7 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/terminfo.c b/src/terminfo.c index 1a0c0133dd..046d00acee 100644 --- a/src/terminfo.c +++ b/src/terminfo.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include "tparam.h" diff --git a/src/termopts.h b/src/termopts.h index a78c5f03af..e1c5f2b7b3 100644 --- a/src/termopts.h +++ b/src/termopts.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_TERMOPTS_H #define EMACS_TERMOPTS_H diff --git a/src/textprop.c b/src/textprop.c index 225ff28e57..513780c300 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/thread.c b/src/thread.c index 1f7ced386d..42d7791ad0 100644 --- a/src/thread.c +++ b/src/thread.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/thread.h b/src/thread.h index 52b16f1ba8..7fce8674f0 100644 --- a/src/thread.h +++ b/src/thread.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef THREAD_H #define THREAD_H diff --git a/src/tparam.c b/src/tparam.c index 92fa5b19df..ff145729cd 100644 --- a/src/tparam.c +++ b/src/tparam.c @@ -13,7 +13,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* Emacs config.h may rename various library functions such as malloc. */ #include diff --git a/src/tparam.h b/src/tparam.h index 02136b6ca5..7ae2a10c2f 100644 --- a/src/tparam.h +++ b/src/tparam.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_TPARAM_H #define EMACS_TPARAM_H diff --git a/src/undo.c b/src/undo.c index a4ae40cbc4..d9a56872dc 100644 --- a/src/undo.c +++ b/src/undo.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/unexaix.c b/src/unexaix.c index 75a79c66d0..7698af0f01 100644 --- a/src/unexaix.c +++ b/src/unexaix.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* In other words, you are welcome to use, share and improve this program. diff --git a/src/unexcoff.c b/src/unexcoff.c index 9852c14553..1a42c84a9b 100644 --- a/src/unexcoff.c +++ b/src/unexcoff.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* diff --git a/src/unexcw.c b/src/unexcw.c index 8e5d7e89f1..55206ccffa 100644 --- a/src/unexcw.c +++ b/src/unexcw.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include "unexec.h" diff --git a/src/unexelf.c b/src/unexelf.c index 5129784ade..1cdcfeb44e 100644 --- a/src/unexelf.c +++ b/src/unexelf.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* In other words, you are welcome to use, share and improve this program. diff --git a/src/unexmacosx.c b/src/unexmacosx.c index 3b1efa3ca3..7fb5750cef 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Contributed by Andrew Choi (akochoi@mac.com). */ diff --git a/src/unexw32.c b/src/unexw32.c index 5259b2a52b..73d2305626 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Geoff Voelker (voelker@cs.washington.edu) 8-12-94 diff --git a/src/vm-limit.c b/src/vm-limit.c index bb38b445b1..703238bf6c 100644 --- a/src/vm-limit.c +++ b/src/vm-limit.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include /* for 'environ', on AIX */ diff --git a/src/widget.c b/src/widget.c index 585039d58c..d5f720e7a5 100644 --- a/src/widget.c +++ b/src/widget.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Emacs 19 face widget ported by Fred Pierresteguy */ diff --git a/src/widget.h b/src/widget.h index 97dd6ab61d..07cc665b35 100644 --- a/src/widget.h +++ b/src/widget.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Emacs 19 face widget ported by Fred Pierresteguy */ diff --git a/src/widgetprv.h b/src/widgetprv.h index 309aed779d..ac49e8c802 100644 --- a/src/widgetprv.h +++ b/src/widgetprv.h @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Emacs 19 face widget ported by Fred Pierresteguy */ diff --git a/src/window.c b/src/window.c index 18adb62538..ba86d73911 100644 --- a/src/window.c +++ b/src/window.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/window.h b/src/window.h index e9040f816d..df7c23f824 100644 --- a/src/window.h +++ b/src/window.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef WINDOW_H_INCLUDED #define WINDOW_H_INCLUDED diff --git a/src/xdisp.c b/src/xdisp.c index 5e8188cacb..8ca9037a00 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* New redisplay written by Gerd Moellmann . diff --git a/src/xfaces.c b/src/xfaces.c index 32a5bd5f60..012de4e7af 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* New face implementation by Gerd Moellmann . */ diff --git a/src/xfns.c b/src/xfns.c index 40f06e2d9f..69955fe9a8 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/xfont.c b/src/xfont.c index 85fccf0daf..3891c8b7b9 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include @@ -877,7 +877,7 @@ xfont_close (struct font *font) the logically different X connection after the previous display connection was closed. That's why we also check whether font's ID matches the one recorded in x_display_info for this display. - See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16069. */ + See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16069. */ if (xfi->xfont && ((xdi = x_display_info_for_display (xfi->display)) && xfi->x_display_id == xdi->x_id)) diff --git a/src/xftfont.c b/src/xftfont.c index 137d5baf14..ff8a59f3bf 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -17,7 +17,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/src/xgselect.c b/src/xgselect.c index 26a2d27e84..885563cc90 100644 --- a/src/xgselect.c +++ b/src/xgselect.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xgselect.h b/src/xgselect.h index 5baf8a8f03..a4280cc021 100644 --- a/src/xgselect.h +++ b/src/xgselect.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef XGSELECT_H #define XGSELECT_H diff --git a/src/xmenu.c b/src/xmenu.c index 64df151b28..3935307519 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* X pop-up deck-of-cards menu facility for GNU Emacs. * diff --git a/src/xml.c b/src/xml.c index 7953491cc2..d087a34a5e 100644 --- a/src/xml.c +++ b/src/xml.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xrdb.c b/src/xrdb.c index 5611a33b28..15a01475b7 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -18,7 +18,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xselect.c b/src/xselect.c index 2249828fb4..7fbb23339d 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -14,7 +14,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* Rewritten by jwz */ diff --git a/src/xsettings.c b/src/xsettings.c index 4d56ad10dd..f73b791d51 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xsettings.h b/src/xsettings.h index ba2a31082b..27717aae6e 100644 --- a/src/xsettings.h +++ b/src/xsettings.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef XSETTINGS_H #define XSETTINGS_H diff --git a/src/xsmfns.c b/src/xsmfns.c index d3b4d4d66a..2cb4f3eca5 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xterm.c b/src/xterm.c index 0b949330eb..0b321909c8 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ /* New display code by Gerd Moellmann . */ /* Xt features made by Fred Pierresteguy. */ @@ -8005,7 +8005,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, { #ifdef USE_GTK /* This seems to be needed for GTK 2.6 and later, see - http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */ + https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */ x_clear_area (f, event->xexpose.x, event->xexpose.y, event->xexpose.width, event->xexpose.height); @@ -12268,7 +12268,7 @@ static void x_setup_pointer_blanking (struct x_display_info *dpyinfo) { /* FIXME: the brave tester should set EMACS_XFIXES because we're suspecting - X server bug, see http://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */ + X server bug, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */ if (egetenv ("EMACS_XFIXES") && x_probe_xfixes_extension (dpyinfo->display)) dpyinfo->toggle_visible_pointer = xfixes_toggle_visible_pointer; else diff --git a/src/xterm.h b/src/xterm.h index b16d3023f0..6274630706 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef XTERM_H #define XTERM_H diff --git a/src/xwidget.c b/src/xwidget.c index e6de5da8e6..a0c9e03477 100644 --- a/src/xwidget.c +++ b/src/xwidget.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/src/xwidget.h b/src/xwidget.h index d43b401796..22a8eb3a55 100644 --- a/src/xwidget.h +++ b/src/xwidget.h @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef XWIDGET_H_INCLUDED #define XWIDGET_H_INCLUDED diff --git a/test/Makefile.in b/test/Makefile.in index e32920fb8b..17ab36f5af 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -15,7 +15,7 @@ # 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 . +# along with GNU Emacs. If not, see . ### Commentary: diff --git a/test/README b/test/README index fca2016682..aced1a4414 100644 --- a/test/README +++ b/test/README @@ -61,4 +61,4 @@ 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 . +along with GNU Emacs. If not, see . diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c index 42e1c2bd4a..4193f21b30 100644 --- a/test/data/emacs-module/mod-test.c +++ b/test/data/emacs-module/mod-test.c @@ -15,7 +15,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include #include diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index beca972aad..f455da718e 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/abbrev-tests.el b/test/lisp/abbrev-tests.el index 1ffcd6ac0d..1f1a7fb6bb 100644 --- a/test/lisp/abbrev-tests.el +++ b/test/lisp/abbrev-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 8c8465d366..63e5579b39 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 689fed3f3f..9b6b5687ca 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 41bd8c90c2..07effa7fbc 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el index c6f103321c..55dbb341aa 100644 --- a/test/lisp/autorevert-tests.el +++ b/test/lisp/autorevert-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/buff-menu-tests.el b/test/lisp/buff-menu-tests.el index 21ffb2ebf3..82b34d35d6 100644 --- a/test/lisp/buff-menu-tests.el +++ b/test/lisp/buff-menu-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -26,7 +26,7 @@ (require 'ert) (ert-deftest buff-menu-24962 () - "Test for http://debbugs.gnu.org/24962 ." + "Test for https://debbugs.gnu.org/24962 ." (let* ((file (make-temp-file "foo")) (buf (find-file file))) (unwind-protect diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index e4b43357a0..727ab049a5 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -87,7 +87,7 @@ An existing calc stack is reused, otherwise a new one is created." '(* -100 (var cm var-cm))))) (ert-deftest test-calc-23889 () - "Test for http://debbugs.gnu.org/23889 and 25652." + "Test for https://debbugs.gnu.org/23889 and 25652." (skip-unless (>= math-bignum-digit-length 9)) (dolist (mode '(deg rad)) (let ((calc-angle-mode mode)) @@ -135,5 +135,5 @@ An existing calc stack is reused, otherwise a new one is created." ;;; calc-tests.el ends here ;; Local Variables: -;; bug-reference-url-format: "http://debbugs.gnu.org/%s" +;; bug-reference-url-format: "https://debbugs.gnu.org/%s" ;; End: diff --git a/test/lisp/calendar/icalendar-tests.el b/test/lisp/calendar/icalendar-tests.el index 3e09002980..80a79db75c 100644 --- a/test/lisp/calendar/icalendar-tests.el +++ b/test/lisp/calendar/icalendar-tests.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/calendar/parse-time-tests.el b/test/lisp/calendar/parse-time-tests.el index 26b4e9e44d..0ad0b36438 100644 --- a/test/lisp/calendar/parse-time-tests.el +++ b/test/lisp/calendar/parse-time-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 4763d27a85..66ddbbcc96 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/char-fold-tests.el b/test/lisp/char-fold-tests.el index 00bc3c83d0..83d6fa79b1 100644 --- a/test/lisp/char-fold-tests.el +++ b/test/lisp/char-fold-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el index 0ea7fdbb1e..bc942c3b59 100644 --- a/test/lisp/color-tests.el +++ b/test/lisp/color-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el index 3205c9e4cd..06a39ebc39 100644 --- a/test/lisp/comint-tests.el +++ b/test/lisp/comint-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el index 5baa31558e..ca1d00ab35 100644 --- a/test/lisp/dabbrev-tests.el +++ b/test/lisp/dabbrev-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/descr-text-tests.el b/test/lisp/descr-text-tests.el index df0f845316..538464aad7 100644 --- a/test/lisp/descr-text-tests.el +++ b/test/lisp/descr-text-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index 9e02af272b..d41feb1592 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) @@ -23,7 +23,7 @@ (ert-deftest dired-test-bug27496 () - "Test for http://debbugs.gnu.org/27496 ." + "Test for https://debbugs.gnu.org/27496 ." (skip-unless (executable-find shell-file-name)) (let* ((foo (make-temp-file "foo")) (files (list foo))) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 1f6e060832..99006eca3e 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) @@ -32,7 +32,7 @@ 'dired-jump)))) (ert-deftest dired-test-bug22694 () - "Test for http://debbugs.gnu.org/22694 ." + "Test for https://debbugs.gnu.org/22694 ." (let* ((dir (expand-file-name "bug22694" default-directory)) (file "test") (full-name (expand-file-name file dir)) @@ -56,7 +56,7 @@ (defvar dired-dwim-target) (ert-deftest dired-test-bug25609 () - "Test for http://debbugs.gnu.org/25609 ." + "Test for https://debbugs.gnu.org/25609 ." (let* ((from (make-temp-file "foo" 'dir)) ;; Make sure we have long file-names in 'from' and 'to', not ;; their 8+3 short aliases, because the latter will confuse @@ -109,7 +109,7 @@ (advice-remove 'completing-read "advice-completing-read")))) ;; (ert-deftest dired-test-bug27243 () -;; "Test for http://debbugs.gnu.org/27243 ." +;; "Test for https://debbugs.gnu.org/27243 ." ;; (let ((test-dir (make-temp-file "test-dir-" t)) ;; (dired-auto-revert-buffer t) buffers) ;; (with-current-buffer (find-file-noselect test-dir) @@ -254,7 +254,7 @@ (delete-directory test-dir t)))) (ert-deftest dired-test-bug7131 () - "Test for http://debbugs.gnu.org/7131 ." + "Test for https://debbugs.gnu.org/7131 ." (let* ((dir (expand-file-name "lisp" source-directory)) (buf (dired dir))) (unwind-protect @@ -270,7 +270,7 @@ (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest dired-test-bug27631 () - "Test for http://debbugs.gnu.org/27631 ." + "Test for https://debbugs.gnu.org/27631 ." ;; For dired using 'ls' emulation we test for this bug in ;; ls-lisp-tests.el and em-ls-tests.el. (skip-unless (and (not (featurep 'ls-lisp)) @@ -293,7 +293,7 @@ (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest dired-test-bug27899 () - "Test for http://debbugs.gnu.org/27899 ." + "Test for https://debbugs.gnu.org/27899 ." (let* ((dir (expand-file-name "src" source-directory)) (buf (dired (list dir "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c"))) (orig dired-hide-details-mode)) @@ -309,7 +309,7 @@ (dired-hide-details-mode orig)))) (ert-deftest dired-test-bug27968 () - "Test for http://debbugs.gnu.org/27968 ." + "Test for https://debbugs.gnu.org/27968 ." (let* ((top-dir (make-temp-file "top-dir" t)) (subdir (expand-file-name "subdir" top-dir)) (header-len-fn (lambda () @@ -379,7 +379,7 @@ (kill-buffer (current-buffer)))))) (ert-deftest dired-test-bug27940 () - "Test for http://debbugs.gnu.org/27940 ." + "Test for https://debbugs.gnu.org/27940 ." ;; If just empty dirs we shouldn't be prompted. (dired-test-with-temp-dirs 'just-empty-dirs diff --git a/test/lisp/dired-x-tests.el b/test/lisp/dired-x-tests.el index e8352a4eca..a64cff1e27 100644 --- a/test/lisp/dired-x-tests.el +++ b/test/lisp/dired-x-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) @@ -23,7 +23,7 @@ (ert-deftest dired-test-bug25942 () - "Test for http://debbugs.gnu.org/25942 ." + "Test for https://debbugs.gnu.org/25942 ." (let* ((dirs (list "Public" "Music")) (files (list ".bashrc" "bar.c" "foo.c" "c" ".c")) (all-but-c diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 24d4b93245..f44fe3bdab 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index c6ffccc079..fc69919fbe 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/benchmark-tests.el b/test/lisp/emacs-lisp/benchmark-tests.el index 14426aeec4..e1b67f1ed1 100644 --- a/test/lisp/emacs-lisp/benchmark-tests.el +++ b/test/lisp/emacs-lisp/benchmark-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index ab70b3009e..30d2a4753c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -21,7 +21,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el index 69985506f7..d832a86228 100644 --- a/test/lisp/emacs-lisp/checkdoc-tests.el +++ b/test/lisp/emacs-lisp/checkdoc-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index 5b2371e7b9..c37caa1aab 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Code: diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 31f65413c8..9b2b04bcca 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 7763d062a0..13c9af9bd6 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 16cb4fb40c..575f170af6 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el index 6448a1b37f..a5dd5abf46 100644 --- a/test/lisp/emacs-lisp/cl-print-tests.el +++ b/test/lisp/emacs-lisp/cl-print-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 61e3d72033..8c0d55663c 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -27,7 +27,7 @@ (require 'cl-seq) (ert-deftest cl-union-test-00 () - "Test for http://debbugs.gnu.org/22729 ." + "Test for https://debbugs.gnu.org/22729 ." (let ((str1 "foo") (str2 (make-string 3 ?o))) ;; Emacs may make two string literals eql when reading. @@ -293,7 +293,7 @@ Body are forms defining the test." (should (= 3 (cl-search (nthcdr 2 list) list2))))) (ert-deftest cl-seq-test-bug24264 () - "Test for http://debbugs.gnu.org/24264 ." + "Test for https://debbugs.gnu.org/24264 ." (let ((list (append (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index 3df2157cc8..818b3e76a1 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index da4cc5f51f..e2cff3fbca 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; @@ -104,7 +104,7 @@ This is usually a symbol that starts with `:'." ;;; Slot Writers ;; -;; Replica of the test in eieio-tests.el - +;; Replica of the test in eieio-tests.el - (defclass persist-:printer (eieio-persistent) ((slot1 :initarg :slot1 @@ -164,7 +164,7 @@ persistent class.") "persist wos 1" :pnp (persist-not-persistent "pnp 1" :slot1 3) :file (concat default-directory "test-ps3.pt")))) - + (persist-test-save-and-compare persist-wos) (delete-file (oref persist-wos file)))) @@ -187,11 +187,11 @@ persistent class.") (ert-deftest eieio-test-non-persistent-as-slot-child () (let ((persist-woss - (persistent-with-objs-slot-subs + (persistent-with-objs-slot-subs "persist woss 1" :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3) :file (concat default-directory "test-ps4.pt")))) - + (persist-test-save-and-compare persist-woss) (delete-file (oref persist-woss file)))) @@ -206,13 +206,13 @@ persistent class.") (ert-deftest eieio-test-slot-with-list-of-objects () (let ((persist-wols - (persistent-with-objs-list-slot + (persistent-with-objs-list-slot "persist wols 1" :pnp (list (persist-not-persistent "pnp 1" :slot1 3) (persist-not-persistent "pnp 2" :slot1 4) (persist-not-persistent "pnp 3" :slot1 5)) :file (concat default-directory "test-ps5.pt")))) - + (persist-test-save-and-compare persist-wols) (delete-file (oref persist-wols file)))) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 1a6ab9da08..fbdb9896a4 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 2fbc188dcb..b620a66284 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -17,7 +17,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/ert-x-tests.el b/test/lisp/emacs-lisp/ert-x-tests.el index 4615d08e30..0cc89ac997 100644 --- a/test/lisp/emacs-lisp/ert-x-tests.el +++ b/test/lisp/emacs-lisp/ert-x-tests.el @@ -18,7 +18,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 1a567ac70f..4cc6c841da 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el index f19af024b5..93f7082713 100644 --- a/test/lisp/emacs-lisp/gv-tests.el +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/let-alist-tests.el b/test/lisp/emacs-lisp/let-alist-tests.el index d04645709e..edcfe8a529 100644 --- a/test/lisp/emacs-lisp/let-alist-tests.el +++ b/test/lisp/emacs-lisp/let-alist-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/lisp-mode-tests.el b/test/lisp/emacs-lisp/lisp-mode-tests.el index cc196beea2..6bc916f6c3 100644 --- a/test/lisp/emacs-lisp/lisp-mode-tests.el +++ b/test/lisp/emacs-lisp/lisp-mode-tests.el @@ -13,7 +13,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/lisp-tests.el b/test/lisp/emacs-lisp/lisp-tests.el index ddbf378683..ae1302bdce 100644 --- a/test/lisp/emacs-lisp/lisp-tests.el +++ b/test/lisp/emacs-lisp/lisp-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index fc0a6a57c7..0a888d88b7 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index b228da6cdb..5cee61ee67 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/package-tests.el b/test/lisp/emacs-lisp/package-tests.el index 62fdc751fb..33209d3d99 100644 --- a/test/lisp/emacs-lisp/package-tests.el +++ b/test/lisp/emacs-lisp/package-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index ef0b2f6b24..3bd14ed4b4 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/pp-tests.el b/test/lisp/emacs-lisp/pp-tests.el index b9ed79c774..aed2d3770f 100644 --- a/test/lisp/emacs-lisp/pp-tests.el +++ b/test/lisp/emacs-lisp/pp-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/regexp-opt-tests.el b/test/lisp/emacs-lisp/regexp-opt-tests.el index 9262631705..4beb7bfa1c 100644 --- a/test/lisp/emacs-lisp/regexp-opt-tests.el +++ b/test/lisp/emacs-lisp/regexp-opt-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/ring-tests.el b/test/lisp/emacs-lisp/ring-tests.el index c869f9dc87..00bcf8401c 100644 --- a/test/lisp/emacs-lisp/ring-tests.el +++ b/test/lisp/emacs-lisp/ring-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 8f353b7e86..d9ebb76961 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/seq-tests.el b/test/lisp/emacs-lisp/seq-tests.el index 495cf1e543..5aa794a43b 100644 --- a/test/lisp/emacs-lisp/seq-tests.el +++ b/test/lisp/emacs-lisp/seq-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 111dc38f29..2c6740a96c 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/tabulated-list-test.el b/test/lisp/emacs-lisp/tabulated-list-test.el index b3a09ee375..30a4f8f61b 100644 --- a/test/lisp/emacs-lisp/tabulated-list-test.el +++ b/test/lisp/emacs-lisp/tabulated-list-test.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index c9a5a6daac..edb539f4c2 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -17,7 +17,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/testcover-tests.el b/test/lisp/emacs-lisp/testcover-tests.el index d31379c3aa..0f0ee9a509 100644 --- a/test/lisp/emacs-lisp/testcover-tests.el +++ b/test/lisp/emacs-lisp/testcover-tests.el @@ -17,7 +17,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/emacs-lisp/thunk-tests.el b/test/lisp/emacs-lisp/thunk-tests.el index 89bf1f5011..973a14b818 100644 --- a/test/lisp/emacs-lisp/thunk-tests.el +++ b/test/lisp/emacs-lisp/thunk-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emacs-lisp/timer-tests.el b/test/lisp/emacs-lisp/timer-tests.el index b12a365ff3..916625cac3 100644 --- a/test/lisp/emacs-lisp/timer-tests.el +++ b/test/lisp/emacs-lisp/timer-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/emulation/viper-tests.el b/test/lisp/emulation/viper-tests.el index 67ce5b6fbb..938d5ed6ec 100644 --- a/test/lisp/emulation/viper-tests.el +++ b/test/lisp/emulation/viper-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/epg-tests.el b/test/lisp/epg-tests.el index 36db478801..cdb5f366ac 100644 --- a/test/lisp/epg-tests.el +++ b/test/lisp/epg-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el index da119ed4b1..6e36ed4071 100644 --- a/test/lisp/erc/erc-track-tests.el +++ b/test/lisp/erc/erc-track-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el index 8e7b91d979..35d6171400 100644 --- a/test/lisp/eshell/em-ls-tests.el +++ b/test/lisp/eshell/em-ls-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -28,7 +28,7 @@ (require 'em-ls) (ert-deftest em-ls-test-bug27631 () - "Test for http://debbugs.gnu.org/27631 ." + "Test for https://debbugs.gnu.org/27631 ." (let* ((dir (make-temp-file "bug27631" 'dir)) (dir1 (expand-file-name "dir1" dir)) (dir2 (expand-file-name "dir2" dir)) @@ -50,7 +50,7 @@ (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest em-ls-test-bug27817 () - "Test for http://debbugs.gnu.org/27817 ." + "Test for https://debbugs.gnu.org/27817 ." (let ((orig eshell-ls-use-in-dired) (dired-use-ls-dired 'unspecified) buf insert-directory-program) @@ -62,7 +62,7 @@ (and (buffer-live-p buf) (kill-buffer))))) (ert-deftest em-ls-test-bug27843 () - "Test for http://debbugs.gnu.org/27843 ." + "Test for https://debbugs.gnu.org/27843 ." (let ((orig eshell-ls-use-in-dired) (dired-use-ls-dired 'unspecified) buf insert-directory-program) @@ -76,7 +76,7 @@ (and (buffer-live-p buf) (kill-buffer))))) (ert-deftest em-ls-test-bug27844 () - "Test for http://debbugs.gnu.org/27844 ." + "Test for https://debbugs.gnu.org/27844 ." (let ((orig eshell-ls-use-in-dired) (dired-use-ls-dired 'unspecified) buf insert-directory-program) diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index 363ef525e1..4e0d6dc762 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/faces-tests.el b/test/lisp/faces-tests.el index 2b3456d47f..056af68af9 100644 --- a/test/lisp/faces-tests.el +++ b/test/lisp/faces-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 3456d31fda..17840e8724 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index c6806cdb58..ef216c3f34 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: @@ -153,7 +153,7 @@ form.") "Test file for bug#18141.") (ert-deftest files-test-bug-18141 () - "Test for http://debbugs.gnu.org/18141 ." + "Test for https://debbugs.gnu.org/18141 ." (skip-unless (executable-find "gzip")) (let ((tempfile (make-temp-file "files-test-bug-18141" nil ".gz"))) (unwind-protect @@ -184,7 +184,7 @@ form.") (ert-deftest files-test-bug-21454 () - "Test for http://debbugs.gnu.org/21454 ." + "Test for https://debbugs.gnu.org/21454 ." :expected-result :failed (let ((input-result '(("/foo/bar//baz/:/bar/foo/baz//" nil ("/foo/bar/baz/" "/bar/foo/baz/")) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 21d0087ebc..21cb01c350 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el index 47c49b38c4..c2a41d717c 100644 --- a/test/lisp/gnus/gnus-tests.el +++ b/test/lisp/gnus/gnus-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/gnus/message-tests.el b/test/lisp/gnus/message-tests.el index 4036725142..f905ba3e26 100644 --- a/test/lisp/gnus/message-tests.el +++ b/test/lisp/gnus/message-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/help-fns-tests.el b/test/lisp/help-fns-tests.el index 0ab6c3cae7..98e6b335b9 100644 --- a/test/lisp/help-fns-tests.el +++ b/test/lisp/help-fns-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -40,7 +40,7 @@ Return first line of the output of (describe-function-1 FUNC)." (match-string-no-properties 1 string))) (ert-deftest help-fns-test-bug17410 () - "Test for http://debbugs.gnu.org/17410 ." + "Test for https://debbugs.gnu.org/17410 ." (let ((regexp "autoloaded Lisp macro") (result (help-fns-tests--describe-function 'help-fns-test--macro))) (should (string-match regexp result)))) @@ -76,7 +76,7 @@ Return first line of the output of (describe-function-1 FUNC)." (should (string-match regexp result)))) (ert-deftest help-fns-test-bug23887 () - "Test for http://debbugs.gnu.org/23887 ." + "Test for https://debbugs.gnu.org/23887 ." (let ((regexp "an alias for .re-search-forward. in .subr\.el") (result (help-fns-tests--describe-function 'search-forward-regexp))) (should (string-match regexp result)))) diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el index 9e2401979b..dfe583453e 100644 --- a/test/lisp/hi-lock-tests.el +++ b/test/lisp/hi-lock-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: @@ -24,7 +24,7 @@ (require 'hi-lock) (ert-deftest hi-lock-bug26666 () - "Test for http://debbugs.gnu.org/26666 ." + "Test for https://debbugs.gnu.org/26666 ." (let ((faces hi-lock-face-defaults)) (with-temp-buffer (insert "a A b B\n") diff --git a/test/lisp/htmlfontify-tests.el b/test/lisp/htmlfontify-tests.el index 4a1d566e96..0ad775d74a 100644 --- a/test/lisp/htmlfontify-tests.el +++ b/test/lisp/htmlfontify-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index af75aa0ec7..d65acf6071 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) @@ -43,7 +43,7 @@ 'ibuffer-mark-unsaved-buffers)))) (ert-deftest ibuffer-test-Bug24997 () - "Test for http://debbugs.gnu.org/24997 ." + "Test for https://debbugs.gnu.org/24997 ." (ibuffer) (let ((orig ibuffer-filtering-qualifiers)) (unwind-protect @@ -58,7 +58,7 @@ (ibuffer-update nil t)))) (ert-deftest ibuffer-test-Bug25000 () - "Test for http://debbugs.gnu.org/25000 ." + "Test for https://debbugs.gnu.org/25000 ." (let ((case-fold-search t) (buf1 (generate-new-buffer "ibuffer-test-Bug25000-buf1")) (buf2 (generate-new-buffer "ibuffer-test-Bug25000-buf2"))) @@ -104,7 +104,7 @@ (should (equal (cdr (assoc "test3" ibuffer-saved-filters)) test3)))) (ert-deftest ibuffer-test-Bug25058 () - "Test for http://debbugs.gnu.org/25058 ." + "Test for https://debbugs.gnu.org/25058 ." (ibuffer) (let ((orig-filters ibuffer-saved-filter-groups) (tmp-filters '(("saved-filters" @@ -137,7 +137,7 @@ (ert-deftest ibuffer-test-Bug25042 () - "Test for http://debbugs.gnu.org/25042 ." + "Test for https://debbugs.gnu.org/25042 ." (ibuffer) (let ((filters ibuffer-filtering-qualifiers)) (unwind-protect diff --git a/test/lisp/ido-tests.el b/test/lisp/ido-tests.el index df11096931..a325f49c58 100644 --- a/test/lisp/ido-tests.el +++ b/test/lisp/ido-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/imenu-tests.el b/test/lisp/imenu-tests.el index 9309094713..aedc90e84b 100644 --- a/test/lisp/imenu-tests.el +++ b/test/lisp/imenu-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el index 9ae07c33fd..0a2038a644 100644 --- a/test/lisp/info-xref-tests.el +++ b/test/lisp/info-xref-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/international/mule-tests.el b/test/lisp/international/mule-tests.el index d745333243..4265cec14a 100644 --- a/test/lisp/international/mule-tests.el +++ b/test/lisp/international/mule-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/international/mule-util-tests.el b/test/lisp/international/mule-util-tests.el index 356ee33232..01f40a227c 100644 --- a/test/lisp/international/mule-util-tests.el +++ b/test/lisp/international/mule-util-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/international/ucs-normalize-tests.el b/test/lisp/international/ucs-normalize-tests.el index 02a4bba7a5..94bf77633e 100644 --- a/test/lisp/international/ucs-normalize-tests.el +++ b/test/lisp/international/ucs-normalize-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/isearch-tests.el b/test/lisp/isearch-tests.el index e5cae8237e..b2981c0cc0 100644 --- a/test/lisp/isearch-tests.el +++ b/test/lisp/isearch-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el index 22d1e015db..5847eac699 100644 --- a/test/lisp/jit-lock-tests.el +++ b/test/lisp/jit-lock-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 1d13ccf074..fe5f466bd7 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/kmacro-tests.el b/test/lisp/kmacro-tests.el index 04a4271734..a691ec8454 100644 --- a/test/lisp/kmacro-tests.el +++ b/test/lisp/kmacro-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el index 1698e0967d..8e419d59bf 100644 --- a/test/lisp/ls-lisp-tests.el +++ b/test/lisp/ls-lisp-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -28,14 +28,14 @@ (require 'ls-lisp) (ert-deftest ls-lisp-unload () - "Test for http://debbugs.gnu.org/xxxxx ." + "Test for https://debbugs.gnu.org/xxxxx ." (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) (unload-feature 'ls-lisp 'force) (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) (require 'ls-lisp)) (ert-deftest ls-lisp-test-bug27762 () - "Test for http://debbugs.gnu.org/27762 ." + "Test for https://debbugs.gnu.org/27762 ." (let* ((dir source-directory) (default-directory dir) (files (mapcar (lambda (f) (concat "src/" f)) @@ -57,7 +57,7 @@ (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest ls-lisp-test-bug27631 () - "Test for http://debbugs.gnu.org/27631 ." + "Test for https://debbugs.gnu.org/27631 ." (let* ((dir (make-temp-file "bug27631" 'dir)) (dir1 (expand-file-name "dir1" dir)) (dir2 (expand-file-name "dir2" dir)) @@ -76,7 +76,7 @@ (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest ls-lisp-test-bug27693 () - "Test for http://debbugs.gnu.org/27693 ." + "Test for https://debbugs.gnu.org/27693 ." (let ((dir (expand-file-name "lisp" source-directory)) (size "") ls-lisp-use-insert-directory-program buf) diff --git a/test/lisp/mail/rmail-tests.el b/test/lisp/mail/rmail-tests.el index 6cf9053bc0..b0b8676422 100644 --- a/test/lisp/mail/rmail-tests.el +++ b/test/lisp/mail/rmail-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el index b9f47f50c2..9294994892 100644 --- a/test/lisp/man-tests.el +++ b/test/lisp/man-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/md4-tests.el b/test/lisp/md4-tests.el index 169ed83448..42b13c9d2a 100644 --- a/test/lisp/md4-tests.el +++ b/test/lisp/md4-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 7c5fcb4838..c27b338f7f 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el index a8eca28365..f8c91004ec 100644 --- a/test/lisp/mouse-tests.el +++ b/test/lisp/mouse-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 0a59e3b42d..cdae9cce45 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Code: diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el index 9dbb6c05b9..fd0b5decb8 100644 --- a/test/lisp/net/gnutls-tests.el +++ b/test/lisp/net/gnutls-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index 9e32931ff7..cbeb61acfe 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 9ee3a281c3..e0ecfca4a8 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/newsticker-tests.el b/test/lisp/net/newsticker-tests.el index 56064f781d..def7c2aebc 100644 --- a/test/lisp/net/newsticker-tests.el +++ b/test/lisp/net/newsticker-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el index b06364e3b3..3f69b60a3b 100644 --- a/test/lisp/net/puny-tests.el +++ b/test/lisp/net/puny-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/net/sasl-scram-rfc-tests.el b/test/lisp/net/sasl-scram-rfc-tests.el index 96cec77c56..4fb6f6cfef 100644 --- a/test/lisp/net/sasl-scram-rfc-tests.el +++ b/test/lisp/net/sasl-scram-rfc-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/shr-tests.el b/test/lisp/net/shr-tests.el index c82338af73..3a30141668 100644 --- a/test/lisp/net/shr-tests.el +++ b/test/lisp/net/shr-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8d30570a0c..e8515302c0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el index 4908b88324..dca7c85678 100644 --- a/test/lisp/obarray-tests.el +++ b/test/lisp/obarray-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/bat-mode-tests.el b/test/lisp/progmodes/bat-mode-tests.el index 565718eea4..71660ca437 100644 --- a/test/lisp/progmodes/bat-mode-tests.el +++ b/test/lisp/progmodes/bat-mode-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/cc-mode-tests.el b/test/lisp/progmodes/cc-mode-tests.el index 10f424f528..402bf47dfa 100644 --- a/test/lisp/progmodes/cc-mode-tests.el +++ b/test/lisp/progmodes/cc-mode-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/compile-tests.el b/test/lisp/progmodes/compile-tests.el index 5c8c9c2a81..2de52daeea 100644 --- a/test/lisp/progmodes/compile-tests.el +++ b/test/lisp/progmodes/compile-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index 675aa31a79..a6c64edeb7 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index 845f3fe76a..f839331761 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el index 533a67149e..0c03a190ca 100644 --- a/test/lisp/progmodes/f90-tests.el +++ b/test/lisp/progmodes/f90-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -71,7 +71,7 @@ end program progname (should (string-equal (buffer-string) f90-test-indent)))) (ert-deftest f90-test-bug3729 () - "Test for http://debbugs.gnu.org/3729 ." + "Test for https://debbugs.gnu.org/3729 ." :expected-result :failed (with-temp-buffer (f90-mode) @@ -90,7 +90,7 @@ end subroutine test") (should (= 0 (current-indentation))))) (ert-deftest f90-test-bug3730 () - "Test for http://debbugs.gnu.org/3730 ." + "Test for https://debbugs.gnu.org/3730 ." (with-temp-buffer (f90-mode) (insert "a" ) @@ -104,7 +104,7 @@ end subroutine test") ;; TODO bug#5593 (ert-deftest f90-test-bug8691 () - "Test for http://debbugs.gnu.org/8691 ." + "Test for https://debbugs.gnu.org/8691 ." (with-temp-buffer (f90-mode) (insert "module modname @@ -119,13 +119,13 @@ end module modname") ;; TODO bug#8812 (ert-deftest f90-test-bug8820 () - "Test for http://debbugs.gnu.org/8820 ." + "Test for https://debbugs.gnu.org/8820 ." (with-temp-buffer (f90-mode) (should (eq (char-syntax ?%) (string-to-char "."))))) (ert-deftest f90-test-bug9553a () - "Test for http://debbugs.gnu.org/9553 ." + "Test for https://debbugs.gnu.org/9553 ." (with-temp-buffer (f90-mode) (insert "!!!") @@ -136,7 +136,7 @@ end module modname") (should (equal "!!! a" (buffer-substring (point) (+ 5 (point))))))) (ert-deftest f90-test-bug9553b () - "Test for http://debbugs.gnu.org/9553 ." + "Test for https://debbugs.gnu.org/9553 ." (with-temp-buffer (f90-mode) (insert "!!!") @@ -147,7 +147,7 @@ end module modname") (should (equal "!!! a" (buffer-substring (point) (+ 5 (point))))))) (ert-deftest f90-test-bug9690 () - "Test for http://debbugs.gnu.org/9690 ." + "Test for https://debbugs.gnu.org/9690 ." (with-temp-buffer (f90-mode) (insert "#include \"foo.h\"") @@ -155,7 +155,7 @@ end module modname") (should (= 0 (current-indentation))))) (ert-deftest f90-test-bug13138 () - "Test for http://debbugs.gnu.org/13138 ." + "Test for https://debbugs.gnu.org/13138 ." (with-temp-buffer (f90-mode) (insert "program prog @@ -174,7 +174,7 @@ end program prog") (should (= 0 (current-indentation))))) (ert-deftest f90-test-bug-19809 () - "Test for http://debbugs.gnu.org/19809 ." + "Test for https://debbugs.gnu.org/19809 ." (with-temp-buffer (f90-mode) ;; The Fortran standard says that continued strings should have @@ -189,7 +189,7 @@ end program prog") (should (= (point) (point-max))))) (ert-deftest f90-test-bug20680 () - "Test for http://debbugs.gnu.org/20680 ." + "Test for https://debbugs.gnu.org/20680 ." (with-temp-buffer (f90-mode) (insert "module modname @@ -202,7 +202,7 @@ end module modname") (should (= 2 (current-indentation))))) (ert-deftest f90-test-bug20680b () - "Test for http://debbugs.gnu.org/20680 ." + "Test for https://debbugs.gnu.org/20680 ." (with-temp-buffer (f90-mode) (insert "module modname @@ -215,7 +215,7 @@ end module modname") (should (= 2 (current-indentation))))) (ert-deftest f90-test-bug20969 () - "Test for http://debbugs.gnu.org/20969 ." + "Test for https://debbugs.gnu.org/20969 ." (with-temp-buffer (f90-mode) (insert "module modname @@ -228,7 +228,7 @@ end module modname") (should (= 2 (current-indentation))))) (ert-deftest f90-test-bug20969b () - "Test for http://debbugs.gnu.org/20969 ." + "Test for https://debbugs.gnu.org/20969 ." (with-temp-buffer (f90-mode) (insert "module modname @@ -241,7 +241,7 @@ end module modname") (should (= 2 (current-indentation))))) (ert-deftest f90-test-bug21794 () - "Test for http://debbugs.gnu.org/21794 ." + "Test for https://debbugs.gnu.org/21794 ." (with-temp-buffer (f90-mode) (insert "program prog @@ -256,7 +256,7 @@ end program prog") (should (= 5 (current-indentation))))) (ert-deftest f90-test-bug25039 () - "Test for http://debbugs.gnu.org/25039 ." + "Test for https://debbugs.gnu.org/25039 ." (with-temp-buffer (f90-mode) (insert "program prog diff --git a/test/lisp/progmodes/flymake-tests.el b/test/lisp/progmodes/flymake-tests.el index 9bf6e7aa17..b04346fd97 100644 --- a/test/lisp/progmodes/flymake-tests.el +++ b/test/lisp/progmodes/flymake-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -41,7 +41,7 @@ (setq-local flymake-warning-predicate predicate) (goto-char (point-min)) (flymake-mode 1) - ;; Weirdness here... http://debbugs.gnu.org/17647#25 + ;; Weirdness here... https://debbugs.gnu.org/17647#25 (while (and flymake-is-running (< (setq i (1+ i)) 10)) (sleep-for (+ 0.5 flymake-no-changes-timeout))) (flymake-goto-next-error) diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 4e27913930..35143b1ec7 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 57e40ff640..a59885637e 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/ruby-mode-tests.el b/test/lisp/progmodes/ruby-mode-tests.el index f04483f6d7..aa177e31b4 100644 --- a/test/lisp/progmodes/ruby-mode-tests.el +++ b/test/lisp/progmodes/ruby-mode-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index f75005f737..ad22906ecf 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/progmodes/subword-tests.el b/test/lisp/progmodes/subword-tests.el index 39512efdbe..66fe1472e4 100644 --- a/test/lisp/progmodes/subword-tests.el +++ b/test/lisp/progmodes/subword-tests.el @@ -16,7 +16,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: @@ -58,12 +58,12 @@ (insert line) ;; Test forward motion. - + (goto-char (point-min)) (let ((stops (make-string (length fwrd) ?\ ))) (while (progn (aset stops (1- (point)) ?\*) - (not (eobp))) + (not (eobp))) (forward-word)) (should (equal stops fwrd))) @@ -73,7 +73,7 @@ (let ((stops (make-string (length bkwd) ?\ ))) (while (progn (aset stops (1- (point)) ?\*) - (not (bobp))) + (not (bobp))) (backward-word)) (should (equal stops bkwd)))))) diff --git a/test/lisp/progmodes/xref-tests.el b/test/lisp/progmodes/xref-tests.el index b7f0f0526c..465aab5112 100644 --- a/test/lisp/progmodes/xref-tests.el +++ b/test/lisp/progmodes/xref-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/ps-print-tests.el b/test/lisp/ps-print-tests.el index e1df37b645..0eb65aab61 100644 --- a/test/lisp/ps-print-tests.el +++ b/test/lisp/ps-print-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el index 2e31602b12..fd6d1edea2 100644 --- a/test/lisp/register-tests.el +++ b/test/lisp/register-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -28,7 +28,7 @@ (require 'cl-lib) (ert-deftest register-test-bug27634 () - "Test for http://debbugs.gnu.org/27634 ." + "Test for https://debbugs.gnu.org/27634 ." (dolist (event (list ?\C-g 'escape ?\C-\[)) (cl-letf (((symbol-function 'read-key) #'ignore) (last-input-event event) diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index a8bc5407f4..b98406d8ef 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/rot13-tests.el b/test/lisp/rot13-tests.el index 70fe34510d..1eae3976ef 100644 --- a/test/lisp/rot13-tests.el +++ b/test/lisp/rot13-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 8fff6f7352..3194b26156 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/shell-tests.el b/test/lisp/shell-tests.el index 6eb9cdcdd1..c51150069a 100644 --- a/test/lisp/shell-tests.el +++ b/test/lisp/shell-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 7cb7107ced..90a627f261 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/sort-tests.el b/test/lisp/sort-tests.el index f6cbe90d5b..a53b8e5380 100644 --- a/test/lisp/sort-tests.el +++ b/test/lisp/sort-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/lisp/soundex-tests.el b/test/lisp/soundex-tests.el index d1bc99d811..59bdfa4e01 100644 --- a/test/lisp/soundex-tests.el +++ b/test/lisp/soundex-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index a59f0ca90e..ac9e2df603 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -293,7 +293,7 @@ cf. Bug#25477." :type 'wrong-type-argument)) (ert-deftest subr-tests-bug22027 () - "Test for http://debbugs.gnu.org/22027 ." + "Test for https://debbugs.gnu.org/22027 ." (let ((default "foo") res) (cl-letf (((symbol-function 'read-string) (lambda (_prompt _init _hist def) def))) diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el index 76ec058e61..e005c2d8cc 100644 --- a/test/lisp/tar-mode-tests.el +++ b/test/lisp/tar-mode-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el index 68946a01c0..f93fdbbc5a 100644 --- a/test/lisp/textmodes/css-mode-tests.el +++ b/test/lisp/textmodes/css-mode-tests.el @@ -18,7 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/lisp/textmodes/dns-mode-tests.el b/test/lisp/textmodes/dns-mode-tests.el index 34e86201d8..f71f9040df 100644 --- a/test/lisp/textmodes/dns-mode-tests.el +++ b/test/lisp/textmodes/dns-mode-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/textmodes/mhtml-mode-tests.el b/test/lisp/textmodes/mhtml-mode-tests.el index 020ad03c18..df49f6780f 100644 --- a/test/lisp/textmodes/mhtml-mode-tests.el +++ b/test/lisp/textmodes/mhtml-mode-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/textmodes/reftex-tests.el b/test/lisp/textmodes/reftex-tests.el index 55db66c58d..0b67b2eb5b 100644 --- a/test/lisp/textmodes/reftex-tests.el +++ b/test/lisp/textmodes/reftex-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/textmodes/sgml-mode-tests.el b/test/lisp/textmodes/sgml-mode-tests.el index e1aa3e8857..4281ab8558 100644 --- a/test/lisp/textmodes/sgml-mode-tests.el +++ b/test/lisp/textmodes/sgml-mode-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/textmodes/tildify-tests.el b/test/lisp/textmodes/tildify-tests.el index f958fbc547..30038296a2 100644 --- a/test/lisp/textmodes/tildify-tests.el +++ b/test/lisp/textmodes/tildify-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el index 30636db083..e7aeb6e616 100644 --- a/test/lisp/url/url-auth-tests.el +++ b/test/lisp/url/url-auth-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/url/url-expand-tests.el b/test/lisp/url/url-expand-tests.el index 2debbdeb75..d147bddb3d 100644 --- a/test/lisp/url/url-expand-tests.el +++ b/test/lisp/url/url-expand-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/url/url-future-tests.el b/test/lisp/url/url-future-tests.el index 64d045219b..e7bcbd696a 100644 --- a/test/lisp/url/url-future-tests.el +++ b/test/lisp/url/url-future-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el index fd8abb0a5e..56be313b77 100644 --- a/test/lisp/url/url-parse-tests.el +++ b/test/lisp/url/url-parse-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/url/url-util-tests.el b/test/lisp/url/url-util-tests.el index c3375890c0..0d9ad9074d 100644 --- a/test/lisp/url/url-util-tests.el +++ b/test/lisp/url/url-util-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el index 3e7bc7fdf0..746c21644a 100644 --- a/test/lisp/vc/add-log-tests.el +++ b/test/lisp/vc/add-log-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el index 807a411fa5..d27ea66813 100644 --- a/test/lisp/vc/diff-mode-tests.el +++ b/test/lisp/vc/diff-mode-tests.el @@ -16,7 +16,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: @@ -89,7 +89,7 @@ index 8858f0d..86e8ea5 100644 wrongheadedness -xylophonists youthfulness --- +-- 2.11.0 ") @@ -186,7 +186,7 @@ youthfulness (diff-apply-hunk) (diff-apply-hunk) (diff-apply-hunk)) - + (should (equal (with-current-buffer buf (buffer-string)) fil_after)) (should (equal (with-current-buffer buf2 (buffer-string)) diff --git a/test/lisp/vc/ediff-diff-tests.el b/test/lisp/vc/ediff-diff-tests.el index 566f592f84..09aa106027 100644 --- a/test/lisp/vc/ediff-diff-tests.el +++ b/test/lisp/vc/ediff-diff-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index 6fbc1b0a8b..368d00ae4c 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Code: @@ -23,7 +23,7 @@ (require 'ediff-ptch) (ert-deftest ediff-ptch-test-bug25010 () - "Test for http://debbugs.gnu.org/25010 ." + "Test for https://debbugs.gnu.org/25010 ." (with-temp-buffer (insert "diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 6a07f80..6e8e947 100644 @@ -40,7 +40,7 @@ index 6a07f80..6e8e947 100644 (ert-deftest ediff-ptch-test-bug26084 () - "Test for http://debbugs.gnu.org/26084 ." + "Test for https://debbugs.gnu.org/26084 ." (skip-unless (executable-find "git")) (skip-unless (executable-find ediff-patch-program)) (let* ((tmpdir (make-temp-file "ediff-ptch-test" t)) diff --git a/test/lisp/vc/vc-bzr-tests.el b/test/lisp/vc/vc-bzr-tests.el index fc7d8f8283..e751f56286 100644 --- a/test/lisp/vc/vc-bzr-tests.el +++ b/test/lisp/vc/vc-bzr-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -29,7 +29,7 @@ (require 'vc-dir) (ert-deftest vc-bzr-test-bug9726 () - "Test for http://debbugs.gnu.org/9726 ." + "Test for https://debbugs.gnu.org/9726 ." (skip-unless (executable-find vc-bzr-program)) ;; Bzr wants to access HOME, e.g. to write ~/.bzr.log. ;; This is a problem on hydra, where HOME is non-existent. @@ -71,7 +71,7 @@ ;; Not specific to bzr. (ert-deftest vc-bzr-test-bug9781 () - "Test for http://debbugs.gnu.org/9781 ." + "Test for https://debbugs.gnu.org/9781 ." (skip-unless (executable-find vc-bzr-program)) (let* ((homedir (make-temp-file "vc-bzr-test" t)) (bzrdir (expand-file-name "bzr" homedir)) diff --git a/test/lisp/vc/vc-hg-tests.el b/test/lisp/vc/vc-hg-tests.el index 284e06a205..96fc41e997 100644 --- a/test/lisp/vc/vc-hg-tests.el +++ b/test/lisp/vc/vc-hg-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 1104085a2e..b970be8909 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: diff --git a/test/lisp/whitespace-tests.el b/test/lisp/whitespace-tests.el index 1e455352f2..ba99ddcdec 100644 --- a/test/lisp/whitespace-tests.el +++ b/test/lisp/whitespace-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index 2630e1e824..e3c9a743e4 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el index 16945b0f92..ba693490e2 100644 --- a/test/lisp/xml-tests.el +++ b/test/lisp/xml-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/xt-mouse-tests.el b/test/lisp/xt-mouse-tests.el index c0e97f5747..53844a6e99 100644 --- a/test/lisp/xt-mouse-tests.el +++ b/test/lisp/xt-mouse-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/biditest.el b/test/manual/biditest.el index c315749e18..667e537d99 100644 --- a/test/manual/biditest.el +++ b/test/manual/biditest.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/cedet/cedet-utests.el b/test/manual/cedet/cedet-utests.el index b8396b822b..19a144f2ab 100644 --- a/test/manual/cedet/cedet-utests.el +++ b/test/manual/cedet/cedet-utests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/manual/cedet/ede-tests.el b/test/manual/cedet/ede-tests.el index fdad01c1ff..e24bdf7f9f 100644 --- a/test/manual/cedet/ede-tests.el +++ b/test/manual/cedet/ede-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/cedet/semantic-ia-utest.el b/test/manual/cedet/semantic-ia-utest.el index cf89daf149..7861fd7394 100644 --- a/test/manual/cedet/semantic-ia-utest.el +++ b/test/manual/cedet/semantic-ia-utest.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/manual/cedet/semantic-tests.el b/test/manual/cedet/semantic-tests.el index bfcba7e677..3a19328ac7 100644 --- a/test/manual/cedet/semantic-tests.el +++ b/test/manual/cedet/semantic-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/cedet/semantic-utest-c.el b/test/manual/cedet/semantic-utest-c.el index 26ce400927..6adfb1f214 100644 --- a/test/manual/cedet/semantic-utest-c.el +++ b/test/manual/cedet/semantic-utest-c.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/manual/cedet/semantic-utest.el b/test/manual/cedet/semantic-utest.el index f735e55241..6d499eeba4 100644 --- a/test/manual/cedet/semantic-utest.el +++ b/test/manual/cedet/semantic-utest.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; diff --git a/test/manual/cedet/srecode-tests.el b/test/manual/cedet/srecode-tests.el index 36256a7059..5d387a2d0c 100644 --- a/test/manual/cedet/srecode-tests.el +++ b/test/manual/cedet/srecode-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/cedet/tests/test.c b/test/manual/cedet/tests/test.c index a46486927a..c5958c4cba 100644 --- a/test/manual/cedet/tests/test.c +++ b/test/manual/cedet/tests/test.c @@ -17,7 +17,7 @@ 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 . + along with GNU Emacs. If not, see . */ /* Attempt to include as many aspects of the C language as possible. @@ -54,7 +54,7 @@ struct { int slot31; char slot32; float slot33; -} var_of_anonymous_struct; +} var_of_anonymous_struct; typedef struct mystruct1 typedef_of_mystruct1; typedef struct mystruct1 *typedef_of_pointer_mystruct1; @@ -80,7 +80,7 @@ struct { int slot61; char slot72; float slot83; -} var_of_anonymous_union; +} var_of_anonymous_union; typedef union myunion1 typedef_of_myunion1; typedef union myunion1 *typedef_of_pointer_myunion1; @@ -235,8 +235,7 @@ int funk3(arg_51, arg_53) int funk4_fixme(arg_61, arg_62) int arg_61, arg_62; { - + } /* End of C tests */ - diff --git a/test/manual/cedet/tests/test.el b/test/manual/cedet/tests/test.el index a0efd40acc..299bea0bd5 100644 --- a/test/manual/cedet/tests/test.el +++ b/test/manual/cedet/tests/test.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Require ;; diff --git a/test/manual/cedet/tests/test.make b/test/manual/cedet/tests/test.make index 46421da54d..ff169576f7 100644 --- a/test/manual/cedet/tests/test.make +++ b/test/manual/cedet/tests/test.make @@ -17,7 +17,7 @@ # 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 . +# along with GNU Emacs. If not, see . top= ede_FILES=Project.ede Makefile @@ -42,7 +42,7 @@ all: example semantic Languages tools senator semantic.info test ${B}: foo bar @echo ${A} -example: +example: @ init: $(init_LISP) diff --git a/test/manual/cedet/tests/testdoublens.cpp b/test/manual/cedet/tests/testdoublens.cpp index e9a6ba5267..c9a2f99f54 100644 --- a/test/manual/cedet/tests/testdoublens.cpp +++ b/test/manual/cedet/tests/testdoublens.cpp @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . #include "testdoublens.hpp" @@ -163,4 +163,3 @@ namespace d { } // namespace f } // namespace d - diff --git a/test/manual/cedet/tests/testdoublens.hpp b/test/manual/cedet/tests/testdoublens.hpp index 556f068d58..59eec74166 100644 --- a/test/manual/cedet/tests/testdoublens.hpp +++ b/test/manual/cedet/tests/testdoublens.hpp @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . namespace Name1 { namespace Name2 { @@ -34,7 +34,7 @@ namespace Name1 { void publishStuff(int a, int b); void sendStuff(int a, int b); - + Mumble* pMumble; }; @@ -67,4 +67,3 @@ namespace a { } // namespace b } // namespace a - diff --git a/test/manual/cedet/tests/testjavacomp.java b/test/manual/cedet/tests/testjavacomp.java index c32a17ca24..743aaca854 100644 --- a/test/manual/cedet/tests/testjavacomp.java +++ b/test/manual/cedet/tests/testjavacomp.java @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . package tests.testjavacomp; diff --git a/test/manual/cedet/tests/testpolymorph.cpp b/test/manual/cedet/tests/testpolymorph.cpp index 27aa08b155..86bc75c6f2 100644 --- a/test/manual/cedet/tests/testpolymorph.cpp +++ b/test/manual/cedet/tests/testpolymorph.cpp @@ -17,7 +17,7 @@ * 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 . + * along with GNU Emacs. If not, see . */ #include diff --git a/test/manual/cedet/tests/testspp.c b/test/manual/cedet/tests/testspp.c index 02eab53afb..dc8f4a54ba 100644 --- a/test/manual/cedet/tests/testspp.c +++ b/test/manual/cedet/tests/testspp.c @@ -17,7 +17,7 @@ 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 . + along with GNU Emacs. If not, see . */ int some_fcn (){} @@ -99,4 +99,3 @@ int no_show_moose_elif_2() {} #else int show_moose_elif_else() {} #endif - diff --git a/test/manual/cedet/tests/testsppreplace.c b/test/manual/cedet/tests/testsppreplace.c index 56ef320f75..5c63a09a36 100644 --- a/test/manual/cedet/tests/testsppreplace.c +++ b/test/manual/cedet/tests/testsppreplace.c @@ -16,7 +16,7 @@ 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 . + along with GNU Emacs. If not, see . */ /* TEST: The EMU keyword doesn't screw up the function defn. */ @@ -151,4 +151,3 @@ int STARTMACRO () { /* END */ - diff --git a/test/manual/cedet/tests/testsppreplaced.c b/test/manual/cedet/tests/testsppreplaced.c index 3ba90aa4dd..f60be8bcfb 100644 --- a/test/manual/cedet/tests/testsppreplaced.c +++ b/test/manual/cedet/tests/testsppreplaced.c @@ -16,7 +16,7 @@ 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 . + along with GNU Emacs. If not, see . */ /* What the SPP replace file would looklike with MACROS replaced: */ diff --git a/test/manual/cedet/tests/testsubclass.cpp b/test/manual/cedet/tests/testsubclass.cpp index e74ca43124..df8399e8d1 100644 --- a/test/manual/cedet/tests/testsubclass.cpp +++ b/test/manual/cedet/tests/testsubclass.cpp @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . //#include #include "testsubclass.hh" @@ -246,4 +246,3 @@ bool sneaky::bugalope::testAccess() //^9^ // #14# ( "fBugPrivate" "fBugProtected" "fBugPublic" "fQuadPublic" "testAccess" ) ; } - diff --git a/test/manual/cedet/tests/testsubclass.hh b/test/manual/cedet/tests/testsubclass.hh index 6f199c20bd..fe07b6fcb0 100644 --- a/test/manual/cedet/tests/testsubclass.hh +++ b/test/manual/cedet/tests/testsubclass.hh @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . //#include // #include @@ -40,7 +40,7 @@ namespace animal { enum moose_enum { NAME1, NAME2, NAME3 }; - + protected: @@ -50,7 +50,7 @@ namespace animal { private: int fFeet; // Usually 2 or 4. bool fIsPrivateBool; - + }; // moose int two_prototypes(); @@ -188,4 +188,3 @@ namespace sneaky { }; #endif - diff --git a/test/manual/cedet/tests/testtypedefs.cpp b/test/manual/cedet/tests/testtypedefs.cpp index e6c91f736b..5bc79fc885 100644 --- a/test/manual/cedet/tests/testtypedefs.cpp +++ b/test/manual/cedet/tests/testtypedefs.cpp @@ -17,7 +17,7 @@ // 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 . +// along with GNU Emacs. If not, see . // Thanks Ming-Wei Chang for these examples. @@ -78,4 +78,3 @@ int main() // #4# ("otherFunc") return 0; } - diff --git a/test/manual/cedet/tests/testvarnames.c b/test/manual/cedet/tests/testvarnames.c index dbc4afb46b..a328f97a74 100644 --- a/test/manual/cedet/tests/testvarnames.c +++ b/test/manual/cedet/tests/testvarnames.c @@ -18,7 +18,7 @@ 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 . + along with GNU Emacs. If not, see . */ struct independent { diff --git a/test/manual/etags/c-src/emacs/src/gmalloc.c b/test/manual/etags/c-src/emacs/src/gmalloc.c index 79b2040e32..3f8cad83ae 100644 --- a/test/manual/etags/c-src/emacs/src/gmalloc.c +++ b/test/manual/etags/c-src/emacs/src/gmalloc.c @@ -14,7 +14,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -339,7 +339,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -991,7 +991,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1297,7 +1297,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1467,7 +1467,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1505,7 +1505,7 @@ 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 the GNU C Library. If not, see . */ +along with the GNU C Library. If not, see . */ /* uClibc defines __GNU_LIBRARY__, but it is not completely compatible. */ @@ -1549,7 +1549,7 @@ 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 this library. If not, see . */ +License along with this library. If not, see . */ void *(*__memalign_hook) (size_t size, size_t alignment); @@ -1686,7 +1686,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ @@ -1775,7 +1775,7 @@ hybrid_aligned_alloc (size_t alignment, size_t size) #endif } #endif - + void * hybrid_realloc (void *ptr, size_t size) { @@ -1835,7 +1835,7 @@ 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 this library. If not, see . +License along with this library. If not, see . The author may be reached (Email) at the address mike@ai.mit.edu, or (US mail) as Mike Haertel c/o Free Software Foundation. */ diff --git a/test/manual/etags/c-src/emacs/src/keyboard.c b/test/manual/etags/c-src/emacs/src/keyboard.c index 5a651497d7..960e5c7132 100644 --- a/test/manual/etags/c-src/emacs/src/keyboard.c +++ b/test/manual/etags/c-src/emacs/src/keyboard.c @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #include diff --git a/test/manual/etags/c-src/emacs/src/lisp.h b/test/manual/etags/c-src/emacs/src/lisp.h index 688589624f..c4b78fc628 100644 --- a/test/manual/etags/c-src/emacs/src/lisp.h +++ b/test/manual/etags/c-src/emacs/src/lisp.h @@ -16,7 +16,7 @@ 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 . */ +along with GNU Emacs. If not, see . */ #ifndef EMACS_LISP_H #define EMACS_LISP_H diff --git a/test/manual/etags/c-src/emacs/src/regex.h b/test/manual/etags/c-src/emacs/src/regex.h index 2ed6238730..595b9bb092 100644 --- a/test/manual/etags/c-src/emacs/src/regex.h +++ b/test/manual/etags/c-src/emacs/src/regex.h @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _REGEX_H #define _REGEX_H 1 diff --git a/test/manual/etags/c-src/etags.c b/test/manual/etags/c-src/etags.c index e8321f05ff..b412ef5e64 100644 --- a/test/manual/etags/c-src/etags.c +++ b/test/manual/etags/c-src/etags.c @@ -44,7 +44,7 @@ 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 this program. If not, see . */ +along with this program. If not, see . */ /* NB To comply with the above BSD license, copyright information is diff --git a/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el index 955859803d..090645c789 100644 --- a/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el +++ b/test/manual/etags/el-src/emacs/lisp/progmodes/etags.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/manual/etags/html-src/software.html b/test/manual/etags/html-src/software.html index f1abba7cb4..7a85b9ab5e 100644 --- a/test/manual/etags/html-src/software.html +++ b/test/manual/etags/html-src/software.html @@ -122,7 +122,7 @@

    HREF="ftp://fly.cnuce.cnr.it/pub/software/octave/leasqr/">published it. Since then, the original authors Richard I. Shrager, A.Jutan, Ray Muzic, and Sean Brennan agreed to put it under the GPL. Matthias Jueschke tested +HREF="https://www.gnu.org/licenses/gpl.html">GPL. Matthias Jueschke tested the program using a non-linear optimization test suite, and was satisfied with the results. @@ -148,7 +148,7 @@
    Etags
    -

    On behalf of the Free +

    On behalf of the Free Software Foundation (FSF) I currently volunteer to maintain etags, a program that can be compiled either as a replacement of the classic ctags Unix program or as etags, diff --git a/test/manual/etags/html-src/softwarelibero.html b/test/manual/etags/html-src/softwarelibero.html index b374273c96..6d75a1f092 100644 --- a/test/manual/etags/html-src/softwarelibero.html +++ b/test/manual/etags/html-src/softwarelibero.html @@ -27,7 +27,7 @@

    Fu Richard M. Stallman, nei primi anni Ottanta, a formalizzare per la prima volta il concetto di software libero. La definizione + href="https://www.it.gnu.org/philosophy/free-sw.it.html">definizione di Stallman, che da subito assurse al ruolo di definizione per eccellenza di software libero, assume la forma di quattro principi di libertà: @@ -55,7 +55,7 @@

    detto software libero (in inglese free software). Nel 1984 Richard M. Stallman diede vita al + HREF="https://www.it.gnu.org/gnu/thegnuproject.it.html">diede vita al progetto GNU, con lo scopo di tradurre in pratica il concetto di software libero, e creò la Free Software Foundation per dare supporto logistico, legale ed economico al progetto GNU. @@ -97,7 +97,7 @@

    Con un gioco di parole, il nome dato a questo tipo di protezione è permesso d'autore (in inglese copyleft): + HREF="https://www.it.gnu.org/copyleft/copyleft.html">copyleft): è il criterio che prevede che le modifiche ad un programma possano essere distribuite solo con la stessa licenza del programma originale. Le licenze proprietarie usano le norme sul diritto d'autore (copyright @@ -108,7 +108,7 @@

    La GNU GPL non è unica nel suo genere. Diverse altre + HREF="https://www.it.gnu.org/licenses/license-list.it.html">altre licenze garantiscono le quattro libertà e si possono pertanto qualificare come licenze per il software libero. Fra queste, merita una speciale menzione per la sua diffusione la

    La rilevanza + HREF="https://www.it.gnu.org/philosophy/software-libre-commercial-viability.it.html">rilevanza economica del software libero è ancora molto ridotta, ma è in fortissima crescita ormai da alcuni anni, e tutto consente di supporre che tale crescita . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index cb14819d34..aba5ca5170 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/print-tests.el b/test/src/print-tests.el index b3ffc23e12..b8f6c797da 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -15,7 +15,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Code: diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 04dc903f3a..b26f939190 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -13,7 +13,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see . +;; along with this program. If not, see . ;;; Commentary: diff --git a/test/src/regex-tests.el b/test/src/regex-tests.el index 1364bf6848..b1f1ea71ce 100644 --- a/test/src/regex-tests.el +++ b/test/src/regex-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index 6edde0b137..67e7ec3251 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el index d4c8925b5d..1dcfa8ea29 100644 --- a/test/src/textprop-tests.el +++ b/test/src/textprop-tests.el @@ -18,7 +18,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 849b2e3dd1..10b2f0761d 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -15,7 +15,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index 0cf7fc9f59..3ff75ae68d 100644 --- a/test/src/undo-tests.el +++ b/test/src/undo-tests.el @@ -15,7 +15,7 @@ ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see `http://www.gnu.org/licenses/'. +;; along with this program. If not, see `https://www.gnu.org/licenses/'. ;;; Commentary: @@ -200,7 +200,7 @@ '(error "Unrecognized entry in undo list \"bogus\"")))) (buffer-string)))))) -;; http://debbugs.gnu.org/14824 +;; https://debbugs.gnu.org/14824 (ert-deftest undo-test-buffer-modified () "Test undoing marks buffer unmodified." (with-temp-buffer @@ -326,7 +326,7 @@ undo-make-selective-list." (insert "This sentence corrupted?") (undo-boundary) ;; Same as recipe at - ;; http://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411 + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16411 (insert "aaa") (undo-boundary) (undo) diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el index 1550887f77..557e6da452 100644 --- a/test/src/xml-tests.el +++ b/test/src/xml-tests.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: commit 5da53a01912c2f5d46f5df4ef8cc13a34b5017d4 Author: Paul Eggert Date: Wed Sep 13 15:46:16 2017 -0700 Prefer HTTPS to HTTP for gnu.org This patch just changes code files; a followup companion patch (much larger) will affect the commentary. This part is separated out to make it easier to review. * .dir-locals.el (change-log-mode): * lisp/org/org-info.el (org-info-other-documents) (org-info-map-html-url): * lisp/org/ox-html.el (org-html-creator-string): * lisp/startup.el (fancy-startup-text, fancy-about-text) (fancy-splash-head): * test/lisp/ffap-tests.el (ffap-other-window--bug-25352): * test/lisp/thingatpt-tests.el (thing-at-point-test-data): Use HTTPS instead of HTTP. diff --git a/.dir-locals.el b/.dir-locals.el index 8a4a348ebd..a3705f4d93 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,7 +8,7 @@ (log-edit-setup-add-author . t))) (change-log-mode . ((add-log-time-zone-rule . t) (fill-column . 74) - (bug-reference-url-format . "http://debbugs.gnu.org/%s") + (bug-reference-url-format . "https://debbugs.gnu.org/%s") (mode . bug-reference))) (diff-mode . ((mode . whitespace))) (emacs-lisp-mode . ((indent-tabs-mode . nil)))) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index 79b9bcc3d9..088e0c7aa7 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: @@ -92,11 +92,11 @@ "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper" "widget" "wisent" "woman") "List of emacs documents available. -Taken from ") +Taken from ") (defconst org-info-other-documents - '(("libc" . "http://www.gnu.org/software/libc/manual/html_mono/libc.html") - ("make" . "http://www.gnu.org/software/make/manual/make.html")) + '(("libc" . "https://www.gnu.org/software/libc/manual/html_mono/libc.html") + ("make" . "https://www.gnu.org/software/make/manual/make.html")) "Alist of documents generated from Texinfo source. When converting info links to HTML, links to any one of these manuals are converted to use these URL.") @@ -108,7 +108,7 @@ the official page for that document, e.g., use \"gnu.org\" for all Emacs related documents. Otherwise, append \".html\" extension to FILENAME. See `org-info-emacs-documents' and `org-info-other-documents' for details." (cond ((member filename org-info-emacs-documents) - (format "http://www.gnu.org/software/emacs/manual/html_mono/%s.html" + (format "https://www.gnu.org/software/emacs/manual/html_mono/%s.html" filename)) ((cdr (assoc filename org-info-other-documents))) (t (concat filename ".html")))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index aeb38ebc10..aec4efc4ca 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -19,7 +19,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1318,7 +1318,7 @@ like that: \"%%\"." :type 'string) (defcustom org-html-creator-string - (format "Emacs %s (Org mode %s)" + (format "Emacs %s (Org mode %s)" emacs-version (if (fboundp 'org-version) (org-version) "unknown version")) "Information about the creator of the HTML document. diff --git a/lisp/startup.el b/lisp/startup.el index 0fbba1bea2..7cf6fee425 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -20,7 +20,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -1463,18 +1463,18 @@ If this is nil, no message will be displayed." `((:face (variable-pitch font-lock-comment-face) "Welcome to " :link ("GNU Emacs" - ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) - "Browse http://www.gnu.org/software/emacs/") + ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/")) + "Browse https://www.gnu.org/software/emacs/") ", one component of the " :link ,(lambda () (if (eq system-type 'gnu/linux) `("GNU/Linux" - ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) - "Browse http://www.gnu.org/gnu/linux-and-gnu.html") + ,(lambda (_button) (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")) + "Browse https://www.gnu.org/gnu/linux-and-gnu.html") `("GNU" ,(lambda (_button) - (browse-url "http://www.gnu.org/gnu/thegnuproject.html")) - "Browse http://www.gnu.org/gnu/thegnuproject.html"))) + (browse-url "https://www.gnu.org/gnu/thegnuproject.html")) + "Browse https://www.gnu.org/gnu/thegnuproject.html"))) " operating system.\n\n" :face variable-pitch :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) @@ -1506,8 +1506,8 @@ If this is nil, no message will be displayed." "\n" :link ("Emacs Guided Tour" ,(lambda (_button) - (browse-url "http://www.gnu.org/software/emacs/tour/")) - "Browse http://www.gnu.org/software/emacs/tour/") + (browse-url "https://www.gnu.org/software/emacs/tour/")) + "Browse https://www.gnu.org/software/emacs/tour/") "\tOverview of Emacs features at gnu.org\n" :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual))) "\tView the Emacs manual using Info\n" @@ -1529,16 +1529,16 @@ Each element in the list should be a list of strings or pairs `((:face (variable-pitch font-lock-comment-face) "This is " :link ("GNU Emacs" - ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) - "Browse http://www.gnu.org/software/emacs/") + ,(lambda (_button) (browse-url "https://www.gnu.org/software/emacs/")) + "Browse https://www.gnu.org/software/emacs/") ", one component of the " :link ,(lambda () (if (eq system-type 'gnu/linux) `("GNU/Linux" ,(lambda (_button) - (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) - "Browse http://www.gnu.org/gnu/linux-and-gnu.html") + (browse-url "https://www.gnu.org/gnu/linux-and-gnu.html")) + "Browse https://www.gnu.org/gnu/linux-and-gnu.html") `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project."))) " operating system.\n" @@ -1597,8 +1597,8 @@ Each element in the list should be a list of strings or pairs "\n" :link ("Emacs Guided Tour" ,(lambda (_button) - (browse-url "http://www.gnu.org/software/emacs/tour/")) - "Browse http://www.gnu.org/software/emacs/tour/") + (browse-url "https://www.gnu.org/software/emacs/tour/")) + "Browse https://www.gnu.org/software/emacs/tour/") "\tSee an overview of Emacs features at gnu.org")) "A list of texts to show in the middle part of the About screen. Each element in the list should be a list of strings or pairs @@ -1706,8 +1706,8 @@ a face or button specification." ;; Insert the image with a help-echo and a link. (make-button (prog1 (point) (insert-image img)) (point) 'face 'default - 'help-echo "mouse-2, RET: Browse http://www.gnu.org/" - 'action (lambda (_button) (browse-url "http://www.gnu.org/")) + 'help-echo "mouse-2, RET: Browse https://www.gnu.org/" + 'action (lambda (_button) (browse-url "https://www.gnu.org/")) 'follow-link t) (insert "\n\n"))))) diff --git a/test/lisp/ffap-tests.el b/test/lisp/ffap-tests.el index 1862c6c327..0b90d64036 100644 --- a/test/lisp/ffap-tests.el +++ b/test/lisp/ffap-tests.el @@ -17,7 +17,7 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -28,7 +28,7 @@ (require 'ffap) (ert-deftest ffap-tests-25243 () - "Test for http://debbugs.gnu.org/25243 ." + "Test for https://debbugs.gnu.org/25243 ." (let ((file (make-temp-file "test-Bug#25243"))) (unwind-protect (with-temp-file file @@ -72,12 +72,12 @@ Host = example.com\n") left alone when opening a URL in an external browser." (cl-letf* ((old (current-window-configuration)) ((symbol-function 'ffap-prompter) - (lambda () "http://www.gnu.org")) + (lambda () "https://www.gnu.org")) (urls nil) (ffap-url-fetcher (lambda (url) (push url urls) nil))) (should-not (ffap-other-window)) (should (equal (current-window-configuration) old)) - (should (equal urls '("http://www.gnu.org"))))) + (should (equal urls '("https://www.gnu.org"))))) (provide 'ffap-tests) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index 128534264e..aeee3b52de 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -15,23 +15,23 @@ ;; 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 . +;; along with GNU Emacs. If not, see . ;;; Code: (require 'ert) (defvar thing-at-point-test-data - '(("http://1.gnu.org" 1 url "http://1.gnu.org") - ("http://2.gnu.org" 6 url "http://2.gnu.org") - ("http://3.gnu.org" 19 url "http://3.gnu.org") + '(("https://1.gnu.org" 1 url "https://1.gnu.org") + ("https://2.gnu.org" 6 url "https://2.gnu.org") + ("https://3.gnu.org" 19 url "https://3.gnu.org") ("https://4.gnu.org" 1 url "https://4.gnu.org") ("A geo URI (geo:3.14159,-2.71828)." 12 url "geo:3.14159,-2.71828") - ("Visit http://5.gnu.org now." 5 url nil) - ("Visit http://6.gnu.org now." 7 url "http://6.gnu.org") - ("Visit http://7.gnu.org now." 22 url "http://7.gnu.org") - ("Visit http://8.gnu.org now." 22 url "http://8.gnu.org") - ("Visit http://9.gnu.org now." 24 url nil) + ("Visit https://5.gnu.org now." 5 url nil) + ("Visit https://6.gnu.org now." 7 url "https://6.gnu.org") + ("Visit https://7.gnu.org now." 22 url "https://7.gnu.org") + ("Visit https://8.gnu.org now." 22 url "https://8.gnu.org") + ("Visit https://9.gnu.org now." 25 url nil) ;; Invalid URIs ("<<<<" 2 url nil) ("<>" 1 url nil) @@ -48,13 +48,13 @@ ("Url: ..." 30 url "foo://2.example.com") ("Url: ..." 20 url "foo://www.gnu.org/a bc") ;; Hack used by thing-at-point: drop punctuation at end of URI. - ("Go to http://www.gnu.org, for details" 7 url "http://www.gnu.org") - ("Go to http://www.gnu.org." 24 url "http://www.gnu.org") + ("Go to https://www.gnu.org, for details" 7 url "https://www.gnu.org") + ("Go to https://www.gnu.org." 24 url "https://www.gnu.org") ;; Standard URI delimiters - ("Go to \"http://10.gnu.org\"." 8 url "http://10.gnu.org") - ("Go to \"http://11.gnu.org/\"." 26 url "http://11.gnu.org/") - ("Go to now." 8 url "http://12.gnu.org") - ("Go to now." 24 url "http://13.gnu.org") + ("Go to \"https://10.gnu.org\"." 8 url "https://10.gnu.org") + ("Go to \"https://11.gnu.org/\"." 26 url "https://11.gnu.org/") + ("Go to now." 8 url "https://12.gnu.org") + ("Go to now." 24 url "https://13.gnu.org") ;; Parenthesis handling (non-standard) ("http://example.com/a(b)c" 21 url "http://example.com/a(b)c") ("http://example.com/a(b)" 21 url "http://example.com/a(b)") @@ -87,7 +87,7 @@ position to retrieve THING.") ;; These tests reflect the actual behavior of ;; `thing-at-point-bounds-of-list-at-point'. (ert-deftest thing-at-point-bug24627 () - "Test for http://debbugs.gnu.org/24627 ." + "Test for https://debbugs.gnu.org/24627 ." (let ((string-result '(("(a \"b\" c)" . (a "b" c)) (";(a \"b\" c)") ("(a \"b\" c\n)" . (a "b" c)) commit e7d6c622090dd2f4c77fbd04aba89c30a75514dd Author: Simen Heggestøyl Date: Thu Sep 7 20:40:12 2017 +0200 Add tests for color.el * lisp/color.el (color-name-to-rgb, color-complement): Clarify in docstrings that RGB triplets should use four digits per component. (color-rgb-to-hsl): Break line to avoid "Hidden behind deeper element" warning. * test/lisp/color-tests.el: New file. diff --git a/lisp/color.el b/lisp/color.el index 22b6808c87..e22b3cf0f6 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -42,7 +42,7 @@ (defun color-name-to-rgb (color &optional frame) "Convert COLOR string to a list of normalized RGB components. COLOR should be a color name (e.g. \"white\") or an RGB triplet -string (e.g. \"#ff12ec\"). +string (e.g. \"#ffff1122eecc\"). Normally the return value is a list of three floating-point numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. @@ -68,7 +68,8 @@ or 2; use the latter if you need a 24-bit specification of a color." (defun color-complement (color-name) "Return the color that is the complement of COLOR-NAME. COLOR-NAME should be a string naming a color (e.g. \"white\"), or -a string specifying a color's RGB components (e.g. \"#ff12ec\")." +a string specifying a color's RGB +components (e.g. \"#ffff1212ecec\")." (let ((color (color-name-to-rgb color-name))) (list (- 1.0 (nth 0 color)) (- 1.0 (nth 1 color)) @@ -178,7 +179,8 @@ each element is between 0.0 and 1.0, inclusive." ((= r max) (- bc gc)) ((= g max) (+ 2.0 rc (- bc))) (t (+ 4.0 gc (- rc)))) - 6.0) 1.0))) + 6.0) + 1.0))) (list h s l))))) (defun color-srgb-to-xyz (red green blue) diff --git a/test/lisp/color-tests.el b/test/lisp/color-tests.el new file mode 100644 index 0000000000..0ea7fdbb1e --- /dev/null +++ b/test/lisp/color-tests.el @@ -0,0 +1,251 @@ +;;; color-tests.el --- Tests for color.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl +;; Keywords: + +;; 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: + +;; + +;;; Code: + +(require 'cl-lib) +(require 'color) +(require 'ert) +(require 'seq) + +(defun color-tests--approx-equal (color1 color2) + "Return t if COLOR1 and COLOR2 are approximately equal." + (seq-every-p + (lambda (x) (< (abs x) 0.00001)) + (cl-mapcar #'- color1 color2))) + +(ert-deftest color-tests-name-to-rgb () + (should (equal (color-name-to-rgb "black") '(0.0 0.0 0.0))) + (should (equal (color-name-to-rgb "white") '(1.0 1.0 1.0))) + (should (equal (color-name-to-rgb "red") '(1.0 0.0 0.0))) + (should (equal (color-name-to-rgb "green") '(0.0 1.0 0.0))) + (should (equal (color-name-to-rgb "blue") '(0.0 0.0 1.0))) + (should (equal (color-name-to-rgb "#000000000000") '(0.0 0.0 0.0))) + (should (equal (color-name-to-rgb "#ffffffffffff") '(1.0 1.0 1.0))) + (should (equal (color-name-to-rgb "#ffff00000000") '(1.0 0.0 0.0))) + (should (equal (color-name-to-rgb "#0000ffff0000") '(0.0 1.0 0.0))) + (should (equal (color-name-to-rgb "#00000000ffff") '(0.0 0.0 1.0)))) + +(ert-deftest color-tests-rgb-to-hex () + (should (equal (color-rgb-to-hex 0 0 0) "#000000000000")) + (should (equal (color-rgb-to-hex 0 0 0 2) "#000000")) + (should (equal (color-rgb-to-hex 1 0 0) "#ffff00000000")) + (should (equal (color-rgb-to-hex 1 0 0 2) "#ff0000")) + (should (equal (color-rgb-to-hex 0.1 0.2 0.3) "#199933334ccc")) + (should (equal (color-rgb-to-hex 0.1 0.2 0.3 2) "#19334c"))) + +(ert-deftest color-tests-complement () + (should (equal (color-complement "white") '(0.0 0.0 0.0))) + (should (equal (color-complement "#ffffffffffff") '(0.0 0.0 0.0))) + (should (equal (color-complement "red") '(0.0 1.0 1.0)))) + +(ert-deftest color-tests-gradient () + (should-not (color-gradient '(0 0 0) '(255 255 255) 0)) + (should + (equal (color-gradient '(0 0 0) '(255 255 255) 1) + '((127.5 127.5 127.5)))) + (should + (equal (color-gradient '(0 0 0) '(255 255 255) 2) + '((85.0 85.0 85.0) (170.0 170.0 170.0)))) + (should + (equal + (color-gradient '(255 192 203) '(250 128 114) 3) + '((253.75 176.0 180.75) (252.5 160.0 158.5) (251.25 144.0 136.25))))) + +(ert-deftest color-tests-hsl-to-rgb () + (should (equal (color-hsl-to-rgb 0 0 0) '(0 0 0))) + (should (equal (color-hsl-to-rgb 360 0.5 0.5) '(0.75 0.25 0.25))) + (should (equal (color-hsl-to-rgb 123 0.2 0.9) '(0.92 0.88 0.88)))) + +(ert-deftest color-tests-complement-hex () + (should + (equal (color-complement-hex "#000000000000") "#ffffffffffff")) + (should + (equal (color-complement-hex "#ffff00000000") "#0000ffffffff"))) + +(ert-deftest color-tests-rgb-to-hsv () + (should (equal (color-rgb-to-hsv 0 0 0) '(0.0 0.0 0.0))) + (should (equal (color-rgb-to-hsv 1 1 1) '(0.0 0.0 1.0))) + (should (equal (color-rgb-to-hsv 1 0 0) '(0.0 1.0 1.0))) + (should (equal (color-rgb-to-hsv 0.5 0.3 0.3) '(0.0 0.4 0.5)))) + +(ert-deftest color-tests-rgb-to-hsl () + (should (equal (color-rgb-to-hsl 0 0 0) '(0.0 0.0 0.0))) + (should (equal (color-rgb-to-hsl 1 1 1) '(0.0 0.0 1.0))) + (should (equal (color-rgb-to-hsl 1 0 0) '(0.0 1 0.5))) + (should (equal (color-rgb-to-hsl 0.5 0.3 0.3) '(0.0 0.25 0.4)))) + +(ert-deftest color-tests-srgb-to-xyz () + (should (equal (color-srgb-to-xyz 0 0 0) '(0.0 0.0 0.0))) + (should + (equal (color-srgb-to-xyz 0 0 1) '(0.1804375 0.072175 0.9503041))) + (should + (color-tests--approx-equal + (color-srgb-to-xyz 0.1 0.2 0.3) '(0.0291865 0.031092 0.073738)))) + +(ert-deftest color-tests-xyz-to-srgb () + (should (equal (color-xyz-to-srgb 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal + (color-xyz-to-srgb 0.1804375 0.072175 0.9503041) '(0 0 1))) + (should + (color-tests--approx-equal + (color-xyz-to-srgb 0.0291865 0.031092 0.073738) '(0.1 0.2 0.3)))) + +(ert-deftest color-tests-xyz-to-lab () + (should (equal (color-xyz-to-lab 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal + (color-xyz-to-lab 0.1804375 0.072175 0.9503041) + '(32.2970109 79.1890315 -107.8646674))) + (should + (color-tests--approx-equal + (color-xyz-to-lab 0.1804375 0.072175 0.9503041 '(1 1 1)) + '(32.2970109 74.3625763 -113.3597823))) + (should + (color-tests--approx-equal + (color-xyz-to-lab 0.0291865 0.031092 0.073738) + '(20.4760281 -0.6500752 -18.6340169)))) + +(ert-deftest color-tests-lab-to-xyz () + (should (equal (color-lab-to-xyz 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal + (color-lab-to-xyz 32.2970109 79.1890315 -107.8646674) + '(0.1804375 0.072175 0.9503041))) + (should + (color-tests--approx-equal + (color-lab-to-xyz 32.2970109 74.3625763 -113.3597823 '(1 1 1)) + '(0.1804375 0.072175 0.9503041))) + (should + (color-tests--approx-equal + (color-lab-to-xyz 20.4760281 -0.6500752 -18.6340169) + '(0.0291865 0.031092 0.073738)))) + +(ert-deftest color-tests-srgb-to-lab () + (should (equal (color-srgb-to-lab 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal + (color-srgb-to-lab 0 1 0) '(87.7347223 -86.1808176 83.1770651))) + (should + (color-tests--approx-equal + (color-srgb-to-lab 0.1 0.2 0.3) + '(20.4762218 -0.6508996 -18.6340085)))) + +(ert-deftest color-tests-lab-to-srgb () + (should (equal (color-lab-to-srgb 0 0 0) '(0.0 0.0 0.0))) + (should + (color-tests--approx-equal + (color-lab-to-srgb 87.7347223 -86.1808176 83.1770651) '(0 1 0))) + (should + (color-tests--approx-equal + (color-lab-to-srgb 20.4762218 -0.6508996 -18.6340085) + '(0.1 0.2 0.3)))) + +(ert-deftest color-tests-cie-de2000 () + (should (= (color-cie-de2000 '(0 0 0) '(0 0 0)) 0.0)) + (should + (color-tests--approx-equal + (list + (color-cie-de2000 + (color-srgb-to-lab 1 0 0) (color-srgb-to-lab 0 0 1))) + '(52.8803934))) + (should + (color-tests--approx-equal + (list + (color-cie-de2000 + (color-srgb-to-lab 0.8 0 0) (color-srgb-to-lab 0.9 0 0))) + '(5.3844503)))) + +(ert-deftest color-tests-clamp () + (should (= (color-clamp 0) 0.0)) + (should (= (color-clamp -1) 0.0)) + (should (= (color-clamp 0.5) 0.5)) + (should (= (color-clamp 1) 1.0)) + (should (= (color-clamp 1.1) 1.0))) + +(ert-deftest color-tests-saturate-hsl () + (should (equal (color-saturate-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) + (should (equal (color-saturate-hsl 360 0.5 0.5 -10) '(360 0.4 0.5))) + (should + (equal (color-saturate-hsl 360 0.5 0.5 -500) '(360 0.0 0.5))) + (should (equal (color-saturate-hsl 120 0.5 0.8 5) '(120 0.55 0.8))) + (should + (equal (color-saturate-hsl 120 0.5 0.8 500) '(120 1.0 0.8)))) + +(ert-deftest color-tests-saturate-name () + (should (equal (color-saturate-name "black" 100) "#000000000000")) + (should (equal (color-saturate-name "white" 100) "#ffffffffffff")) + (should (equal (color-saturate-name "red" 0) "#ffff00000000")) + (should (equal (color-saturate-name "red" 50) "#ffff00000000"))) + +(ert-deftest color-tests-desaturate-hsl () + (should (equal (color-desaturate-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) + (should + (equal (color-desaturate-hsl 360 0.5 0.5 -10) '(360 0.6 0.5))) + (should + (equal (color-desaturate-hsl 360 0.5 0.5 -500) '(360 1.0 0.5))) + (should + (equal (color-desaturate-hsl 120 0.5 0.8 5) '(120 0.45 0.8))) + (should + (equal (color-desaturate-hsl 120 0.5 0.8 500) '(120 0.0 0.8)))) + +(ert-deftest color-tests-desaturate-name () + (should (equal (color-desaturate-name "black" 100) "#000000000000")) + (should (equal (color-desaturate-name "white" 100) "#ffffffffffff")) + (should (equal (color-desaturate-name "red" 0) "#ffff00000000"))) + +(ert-deftest color-tests-lighten-hsl () + (should (equal (color-lighten-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) + (should (equal (color-lighten-hsl 360 0.5 0.5 -10) '(360 0.5 0.4))) + (should (equal (color-lighten-hsl 360 0.5 0.5 -500) '(360 0.5 0.0))) + (should + (color-tests--approx-equal + (color-lighten-hsl 120 0.5 0.8 5) '(120 0.5 0.85))) + (should + (equal (color-lighten-hsl 120 0.5 0.8 500) '(120 0.5 1.0)))) + +(ert-deftest color-tests-lighten-name () + (should (equal (color-lighten-name "black" 100) "#ffffffffffff")) + (should (equal (color-lighten-name "white" 100) "#ffffffffffff")) + (should (equal (color-lighten-name "red" 0) "#ffff00000000")) + (should (equal (color-lighten-name "red" 10) "#ffff33323332"))) + +(ert-deftest color-tests-darken-hsl () + (should (equal (color-darken-hsl 360 0.5 0.5 0) '(360 0.5 0.5))) + (should (equal (color-darken-hsl 360 0.5 0.5 -10) '(360 0.5 0.6))) + (should (equal (color-darken-hsl 360 0.5 0.5 -500) '(360 0.5 1.0))) + (should (equal (color-darken-hsl 120 0.5 0.8 5) '(120 0.5 0.75))) + (should (equal (color-darken-hsl 120 0.5 0.8 500) '(120 0.5 0.0)))) + +(ert-deftest color-tests-darken-name () + (should (equal (color-darken-name "black" 100) "#000000000000")) + (should (equal (color-darken-name "white" 100) "#000000000000")) + (should (equal (color-darken-name "red" 0) "#ffff00000000")) + (should (equal (color-darken-name "red" 10) "#cccc00000000"))) + +(provide 'color-tests) +;;; color-tests.el ends here commit 63398071471f6cd6b006d3c35d2d83c597549e4a Author: Lars Ingebrigtsen Date: Wed Sep 13 20:10:51 2017 +0200 Make gnutls-verify-error work again with url-retrieve-synchronously * lisp/url/url-gw.el (url-open-stream): Only use :nowait if we're doing async connections (bug#26835). * lisp/url/url-parse.el (url): Add an asynchronous slot. * lisp/url/url.el (url-asynchronous): New variable. (url-retrieve-internal): Store the value. (url-retrieve-synchronously): Bind the variable. diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 28acde6420..716b7c0a6e 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -24,6 +24,7 @@ ;;; Code: (require 'url-vars) +(require 'url-parse) ;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program? @@ -245,8 +246,9 @@ overriding the value of `url-gateway-method'." name buffer host service :type gw-method ;; Use non-blocking socket if we can. - :nowait (featurep 'make-network-process - '(:nowait t)))) + :nowait (and (featurep 'make-network-process) + (url-asynchronous url-current-object) + '(:nowait t)))) (`socks (socks-open-network-stream name buffer host service)) (`telnet diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 4738163f0b..ef8e17dd13 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -36,7 +36,8 @@ target attributes fullness)) (:copier nil)) type user password host portspec filename target attributes fullness - silent (use-cookies t)) + silent (use-cookies t) + (asynchronous t)) (defsubst url-port (urlobj) "Return the port number for the URL specified by URLOBJ. diff --git a/lisp/url/url.el b/lisp/url/url.el index be6377ceb3..a6145d3f5f 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -119,6 +119,8 @@ variable in the original buffer as a forwarding pointer.") (defvar url-retrieve-number-of-calls 0) (autoload 'url-cache-prune-cache "url-cache") +(defvar url-asynchronous t + "Bind to nil before calling `url-retrieve' to signal :nowait connections.") ;;;###autoload (defun url-retrieve (url callback &optional cbargs silent inhibit-cookies) @@ -190,6 +192,7 @@ URL-encoded before it's used." (unless (url-type url) (error "Bad url: %s" (url-recreate-url url))) (setf (url-silent url) silent) + (setf (url-asynchronous url) url-asynchronous) (setf (url-use-cookies url) (not inhibit-cookies)) ;; Once in a while, remove old entries from the URL cache. (when (zerop (% url-retrieve-number-of-calls 1000)) @@ -232,6 +235,7 @@ how long to wait for a response before giving up." (let ((retrieval-done nil) (start-time (current-time)) + (url-asynchronous nil) (asynch-buffer nil)) (setq asynch-buffer (url-retrieve url (lambda (&rest ignored) commit 4ab44f75d6ad7eb378c85c111ea1006076cf994b Author: Michael Albinus Date: Wed Sep 13 20:10:40 2017 +0200 Improve backward compatibility of tramp-tests * test/lisp/net/tramp-tests.el (seq): Don't require. (tramp--test-emacs26-p): New defun. (tramp-test10-write-region, tramp-test11-copy-file) (tramp-test12-rename-file, tramp-test15-copy-directory) (tramp-test21-file-links): Use it. (tramp-test16-file-expand-wildcards): Use `copy-sequence'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d5fec30384..8d30570a0c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -39,7 +39,6 @@ (require 'dired) (require 'ert) -(require 'seq) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -1862,11 +1861,8 @@ This checks also `file-name-as-directory', `file-name-directory', ;; Do not overwrite if excluded. (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) - ;; `mustbenew' is passed to Tramp since Emacs 26.1. We - ;; have no test for this, so we check function - ;; `temporary-file-directory', which has been added to - ;; Emacs 26.1 as well. - (when (fboundp 'temporary-file-directory) + ;; `mustbenew' is passed to Tramp since Emacs 26.1. + (when (tramp--test-emacs26-p) (should-error (cl-letf (((symbol-function 'y-or-n-p) 'ignore)) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) @@ -1905,9 +1901,11 @@ This checks also `file-name-as-directory', `file-name-directory', :type 'file-already-exists) (copy-file tmp-name1 tmp-name2 'ok) (make-directory tmp-name3) - (should-error - (copy-file tmp-name1 tmp-name3) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (copy-file tmp-name1 tmp-name3) + :type 'file-already-exists)) (copy-file tmp-name1 (file-name-as-directory tmp-name3)) (should (file-exists-p @@ -1932,9 +1930,11 @@ This checks also `file-name-as-directory', `file-name-directory', :type 'file-already-exists) (copy-file tmp-name1 tmp-name4 'ok) (make-directory tmp-name5) - (should-error - (copy-file tmp-name1 tmp-name5) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (copy-file tmp-name1 tmp-name5) + :type 'file-already-exists)) (copy-file tmp-name1 (file-name-as-directory tmp-name5)) (should (file-exists-p @@ -1959,9 +1959,11 @@ This checks also `file-name-as-directory', `file-name-directory', :type 'file-already-exists) (copy-file tmp-name4 tmp-name1 'ok) (make-directory tmp-name3) - (should-error - (copy-file tmp-name4 tmp-name3) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (copy-file tmp-name4 tmp-name3) + :type 'file-already-exists)) (copy-file tmp-name4 (file-name-as-directory tmp-name3)) (should (file-exists-p @@ -2003,9 +2005,11 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name3) - (should-error - (rename-file tmp-name1 tmp-name3) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (rename-file tmp-name1 tmp-name3) + :type 'file-already-exists)) (rename-file tmp-name1 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name1)) (should @@ -2035,9 +2039,11 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name5) - (should-error - (rename-file tmp-name1 tmp-name5) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (rename-file tmp-name1 tmp-name5) + :type 'file-already-exists)) (rename-file tmp-name1 (file-name-as-directory tmp-name5)) (should-not (file-exists-p tmp-name1)) (should @@ -2067,9 +2073,11 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name4)) (write-region "foo" nil tmp-name4 nil 'nomessage) (make-directory tmp-name3) - (should-error - (rename-file tmp-name4 tmp-name3) - :type 'file-already-exists) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (rename-file tmp-name4 tmp-name3) + :type 'file-already-exists)) (rename-file tmp-name4 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name4)) (should @@ -2147,9 +2155,11 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (file-directory-p tmp-name2)) (should (file-exists-p tmp-name5)) ;; Target directory does exist already. - (should-error - (copy-directory tmp-name1 tmp-name2) - :type 'file-error) + ;; This has been changed in Emacs 26.1. + (when (tramp--test-emacs26-p) + (should-error + (copy-directory tmp-name1 tmp-name2) + :type 'file-error)) (copy-directory tmp-name1 (file-name-as-directory tmp-name2)) (should (file-directory-p tmp-name3)) (should (file-exists-p tmp-name6))) @@ -2240,30 +2250,44 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (file-exists-p tmp-name3)) (should (file-exists-p tmp-name4)) - ;; We cannot use `sort', it works destructive. - (should (equal (file-expand-wildcards "*") - (seq-sort 'string< '("foo" "bar" "baz")))) - (should (equal (file-expand-wildcards "ba?") - (seq-sort 'string< '("bar" "baz")))) - (should (equal (file-expand-wildcards "ba[rz]") - (seq-sort 'string< '("bar" "baz")))) - - (should (equal (file-expand-wildcards "*" 'full) - (seq-sort - 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) - (should (equal (file-expand-wildcards "ba?" 'full) - (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) - (should (equal (file-expand-wildcards "ba[rz]" 'full) - (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) - - (should (equal (file-expand-wildcards (concat tmp-name1 "/" "*")) - (seq-sort - 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) - (should (equal (file-expand-wildcards (concat tmp-name1 "/" "ba?")) - (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) - (should (equal (file-expand-wildcards - (concat tmp-name1 "/" "ba[rz]")) - (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))) + ;; `sort' works destructive. + (should + (equal (file-expand-wildcards "*") + (sort (copy-sequence '("foo" "bar" "baz")) 'string<))) + (should + (equal (file-expand-wildcards "ba?") + (sort (copy-sequence '("bar" "baz")) 'string<))) + (should + (equal (file-expand-wildcards "ba[rz]") + (sort (copy-sequence '("bar" "baz")) 'string<))) + + (should + (equal + (file-expand-wildcards "*" 'full) + (sort + (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<))) + (should + (equal + (file-expand-wildcards "ba?" 'full) + (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) + (should + (equal + (file-expand-wildcards "ba[rz]" 'full) + (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) + + (should + (equal + (file-expand-wildcards (concat tmp-name1 "/" "*")) + (sort + (copy-sequence `(,tmp-name2 ,tmp-name3 ,tmp-name4)) 'string<))) + (should + (equal + (file-expand-wildcards (concat tmp-name1 "/" "ba?")) + (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<))) + (should + (equal + (file-expand-wildcards (concat tmp-name1 "/" "ba[rz]")) + (sort (copy-sequence `(,tmp-name3 ,tmp-name4)) 'string<)))) ;; Cleanup. (ignore-errors @@ -2616,6 +2640,9 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." "Check `file-symlink-p'. This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (tramp--test-enabled)) + ;; The semantics has changed heavily in Emacs 26.1. We cannot test + ;; older Emacsen, therefore. + (skip-unless (tramp--test-emacs26-p)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) ;; We must use `file-truename' for the temporary directory, @@ -3648,6 +3675,12 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-directory tmp-file) (should-not (file-exists-p tmp-file)))) +(defun tramp--test-emacs26-p () + "Check for Emacs version >= 26.1. +Some semantics has been changed for there, w/o new functions or +variables, so we check function Emacs version directly." + (>= emacs-major-version 26)) + (defun tramp--test-adb-p () "Check, whether the remote host runs Android. This requires restrictions of file name syntax." commit 516481156c91822ba217661272ef410b2252e97e Author: Michael Albinus Date: Wed Sep 13 20:10:10 2017 +0200 * lisp/net/trampver.el (customize-package-emacs-version-alist): Add Tramp version integrated in Emacs 25.3. diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 527630d747..5f9b2b6f42 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -68,7 +68,8 @@ ("2.1.20" . "23.3") ("2.1.21-pre" . "23.4") ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") - ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2"))) + ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") + ("2.2.13.25.2" . "25.3"))) (add-hook 'tramp-unload-hook (lambda () commit bdb71dea4a478115bde5c8260f228613d6717157 Author: Mark Oteiza Date: Wed Sep 13 13:25:41 2017 -0400 Add clarification to if-let* docstring Also make its behaviour consistent with and-let* in that empty bindings results in success, not failure. * lisp/emacs-lisp/subr-x.el: Edit docstring, change else to then. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index ba0ab6cb4c..8d41f9298b 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -128,9 +128,10 @@ binding value is nil. If all are non-nil, the value of THEN is returned, or the last form in ELSE is returned. Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds -SYMBOL to the value of VALUEFORM). -An element can additionally be of the form (VALUEFORM), which is -evaluated and checked for nil." +SYMBOL to the value of VALUEFORM). An element can additionally +be of the form (VALUEFORM), which is evaluated and checked for +nil; i.e. SYMBOL can be omitted if only the test result is of +interest." (declare (indent 2) (debug ((&rest [&or symbolp (symbolp form) (sexp)]) form body))) @@ -139,7 +140,7 @@ evaluated and checked for nil." (if ,(caar (last varlist)) ,then ,@else)) - `(let* () ,@else))) + `(let* () ,then))) (defmacro when-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. commit 6519df8f5a10826f4a3203aa55da30bca25cb6f1 Author: Lars Ingebrigtsen Date: Wed Sep 13 18:08:34 2017 +0200 Make fully qualified domain names more fully qualified * lisp/gnus/message.el (message-make-fqdn): Don't try to use a system-name without any periods as a fully qualified domain name. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 214cf61e84..80f270a0c1 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -5778,7 +5778,10 @@ give as trustworthy answer as possible." (not (string-match message-bogus-system-names message-user-fqdn))) ;; `message-user-fqdn' seems to be valid message-user-fqdn) - ((not (string-match message-bogus-system-names sysname)) + ;; A system name without any dots is unlikely to be a good fully + ;; qualified domain name. + ((and (string-match "[.]" sysname) + (not (string-match message-bogus-system-names sysname))) ;; `system-name' returned the right result. sysname) ;; Try `mail-host-address'. commit b74d536ed414717e974109f2db67274cba4dcebf Author: Paul Eggert Date: Wed Sep 13 08:47:33 2017 -0700 Remove unused file lib/getopt_.h * lib/getopt_.h: Remove. It was renamed to lib/getopt.in.h etc. on 2011-01-08, but I forgot to remove the old file. diff --git a/lib/getopt_.h b/lib/getopt_.h deleted file mode 100644 index 7c77a1c8d4..0000000000 --- a/lib/getopt_.h +++ /dev/null @@ -1,285 +0,0 @@ -/* Declarations for getopt. - Copyright (C) 1989-1994, 1996-1999, 2001, 2003-2007, 2009-2017 Free - Software Foundation, Inc. - This file is part of the GNU C Library. - - This program 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. - - This program 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 this program. If not, see . */ - -#ifndef _GL_GETOPT_H - -#if __GNUC__ >= 3 -#pragma GCC system_header -#endif - - -/* The include_next requires a split double-inclusion guard. We must - also inform the replacement unistd.h to not recursively use - ; our definitions will be present soon enough. */ -#if HAVE_GETOPT_H -# define _GL_SYSTEM_GETOPT -# ifndef __GNUC__ -# include -# else -# include_next -# endif -# undef _GL_SYSTEM_GETOPT -#endif - -#ifndef _GL_GETOPT_H - -#ifndef __need_getopt -# define _GL_GETOPT_H 1 -#endif - -/* Standalone applications should #define __GETOPT_PREFIX to an - identifier that prefixes the external functions and variables - defined in this header. When this happens, include the - headers that might declare getopt so that they will not cause - confusion if included after this file (if the system had , - we have already included it). Then systematically rename - identifiers so that they do not collide with the system functions - and variables. Renaming avoids problems with some compilers and - linkers. */ -#if defined __GETOPT_PREFIX && !defined __need_getopt -# if !HAVE_GETOPT_H -# define __need_system_stdlib_h -# include -# undef __need_system_stdlib_h -# include -# include -# endif -# undef __need_getopt -# undef getopt -# undef getopt_long -# undef getopt_long_only -# undef optarg -# undef opterr -# undef optind -# undef optopt -# undef option -# define __GETOPT_CONCAT(x, y) x ## y -# define __GETOPT_XCONCAT(x, y) __GETOPT_CONCAT (x, y) -# define __GETOPT_ID(y) __GETOPT_XCONCAT (__GETOPT_PREFIX, y) -# define getopt __GETOPT_ID (getopt) -# define getopt_long __GETOPT_ID (getopt_long) -# define getopt_long_only __GETOPT_ID (getopt_long_only) -# define optarg __GETOPT_ID (optarg) -# define opterr __GETOPT_ID (opterr) -# define optind __GETOPT_ID (optind) -# define optopt __GETOPT_ID (optopt) -# define option __GETOPT_ID (option) -# define _getopt_internal __GETOPT_ID (getopt_internal) -#endif - -/* Standalone applications get correct prototypes for getopt_long and - getopt_long_only; they declare "char **argv". libc uses prototypes - with "char *const *argv" that are incorrect because getopt_long and - getopt_long_only can permute argv; this is required for backward - compatibility (e.g., for LSB 2.0.1). - - This used to be '#if defined __GETOPT_PREFIX && !defined __need_getopt', - but it caused redefinition warnings if both unistd.h and getopt.h were - included, since unistd.h includes getopt.h having previously defined - __need_getopt. - - The only place where __getopt_argv_const is used is in definitions - of getopt_long and getopt_long_only below, but these are visible - only if __need_getopt is not defined, so it is quite safe to rewrite - the conditional as follows: -*/ -#if !defined __need_getopt -# if defined __GETOPT_PREFIX -# define __getopt_argv_const /* empty */ -# else -# define __getopt_argv_const const -# endif -#endif - -/* If __GNU_LIBRARY__ is not already defined, either we are being used - standalone, or this is the first header included in the source file. - If we are being used with glibc, we need to include , but - that does not exist if we are standalone. So: if __GNU_LIBRARY__ is - not defined, include , which will pull in for us - if it's from glibc. (Why ctype.h? It's guaranteed to exist and it - doesn't flood the namespace with stuff the way some other headers do.) */ -#if !defined __GNU_LIBRARY__ -# include -#endif - -#ifndef __THROW -# ifndef __GNUC_PREREQ -# define __GNUC_PREREQ(maj, min) (0) -# endif -# if defined __cplusplus && __GNUC_PREREQ (2,8) -# define __THROW throw () -# else -# define __THROW -# endif -#endif - -/* The definition of _GL_ARG_NONNULL is copied here. */ -/* A C macro for declaring that specific arguments must not be NULL. - Copyright (C) 2009-2017 Free Software Foundation, Inc. - - This program 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. - - This program 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 this program. If not, see . */ - -/* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools - that the values passed as arguments n, ..., m must be non-NULL pointers. - n = 1 stands for the first argument, n = 2 for the second argument etc. */ -#ifndef _GL_ARG_NONNULL -# if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || __GNUC__ > 3 -# define _GL_ARG_NONNULL(params) __attribute__ ((__nonnull__ params)) -# else -# define _GL_ARG_NONNULL(params) -# endif -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -/* For communication from 'getopt' to the caller. - When 'getopt' finds an option that takes an argument, - the argument value is returned here. - Also, when 'ordering' is RETURN_IN_ORDER, - each non-option ARGV-element is returned here. */ - -extern char *optarg; - -/* Index in ARGV of the next element to be scanned. - This is used for communication to and from the caller - and for communication between successive calls to 'getopt'. - - On entry to 'getopt', zero means this is the first call; initialize. - - When 'getopt' returns -1, this is the index of the first of the - non-option elements that the caller should itself scan. - - Otherwise, 'optind' communicates from one call to the next - how much of ARGV has been scanned so far. */ - -extern int optind; - -/* Callers store zero here to inhibit the error message 'getopt' prints - for unrecognized options. */ - -extern int opterr; - -/* Set to an option character which was unrecognized. */ - -extern int optopt; - -#ifndef __need_getopt -/* Describe the long-named options requested by the application. - The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector - of 'struct option' terminated by an element containing a name which is - zero. - - The field 'has_arg' is: - no_argument (or 0) if the option does not take an argument, - required_argument (or 1) if the option requires an argument, - optional_argument (or 2) if the option takes an optional argument. - - If the field 'flag' is not NULL, it points to a variable that is set - to the value given in the field 'val' when the option is found, but - left unchanged if the option is not found. - - To have a long-named option do something other than set an 'int' to - a compiled-in constant, such as set a value from 'optarg', set the - option's 'flag' field to zero and its 'val' field to a nonzero - value (the equivalent single-letter option character, if there is - one). For long options that have a zero 'flag' field, 'getopt' - returns the contents of the 'val' field. */ - -# if !GNULIB_defined_struct_option -struct option -{ - const char *name; - /* has_arg can't be an enum because some compilers complain about - type mismatches in all the code that assumes it is an int. */ - int has_arg; - int *flag; - int val; -}; -# define GNULIB_defined_struct_option 1 -# endif - -/* Names for the values of the 'has_arg' field of 'struct option'. */ - -# define no_argument 0 -# define required_argument 1 -# define optional_argument 2 -#endif /* need getopt */ - - -/* Get definitions and prototypes for functions to process the - arguments in ARGV (ARGC of them, minus the program name) for - options given in OPTS. - - Return the option character from OPTS just read. Return -1 when - there are no more options. For unrecognized options, or options - missing arguments, 'optopt' is set to the option letter, and '?' is - returned. - - The OPTS string is a list of characters which are recognized option - letters, optionally followed by colons, specifying that that letter - takes an argument, to be placed in 'optarg'. - - If a letter in OPTS is followed by two colons, its argument is - optional. This behavior is specific to the GNU 'getopt'. - - The argument '--' causes premature termination of argument - scanning, explicitly telling 'getopt' that there are no more - options. - - If OPTS begins with '-', then non-option arguments are treated as - arguments to the option '\1'. This behavior is specific to the GNU - 'getopt'. If OPTS begins with '+', or POSIXLY_CORRECT is set in - the environment, then do not permute arguments. */ - -extern int getopt (int ___argc, char *const *___argv, const char *__shortopts) - __THROW _GL_ARG_NONNULL ((2, 3)); - -#ifndef __need_getopt -extern int getopt_long (int ___argc, char *__getopt_argv_const *___argv, - const char *__shortopts, - const struct option *__longopts, int *__longind) - __THROW _GL_ARG_NONNULL ((2, 3)); -extern int getopt_long_only (int ___argc, char *__getopt_argv_const *___argv, - const char *__shortopts, - const struct option *__longopts, int *__longind) - __THROW _GL_ARG_NONNULL ((2, 3)); - -#endif - -#ifdef __cplusplus -} -#endif - -/* Make sure we later can get all the definitions and declarations. */ -#undef __need_getopt - -#endif /* _GL_GETOPT_H */ -#endif /* _GL_GETOPT_H */ commit 912826a829fc5e95d677f48b72413dccd216c6e1 Author: Mark Oteiza Date: Wed Sep 13 10:38:05 2017 -0400 Remove "baroque" use of prefix argument from gensym 'cl-gensym' was simply moved here, but let us take an opportunity to shed some historical baggage. * lisp/subr.el (gensym): Remove special treatment of PREFIX as a number. Use "g" as prefix to differentiate from cl-gensym defaults. * doc/lispref/symbols.texi (Creating Symbols): Update accordingly. * lisp/emacs-lisp/cl-macs.el (cl--gensym-counter, cl-gensym): Restore. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 2d9ec6fda3..cda5f1c40f 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -276,8 +276,7 @@ distinct uninterned symbol whose name is also @samp{foo}. @defun gensym &optional prefix This function returns a symbol using @code{make-symbol}, whose name is made by appending @code{gensym-counter} to @var{prefix}. The prefix -defaults to @code{"G"}. If @var{prefix} is a number, it replaces the -value of the counter. +defaults to @code{"g"}. @end defun @defun intern name &optional obarray diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index eee5953882..3405c92e8d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -161,9 +161,16 @@ whether X is known at compile time, macroexpand it completely in ;;; Symbols. -(defvaralias 'cl--gensym-counter 'gensym-counter) +(defvar cl--gensym-counter 0) ;;;###autoload -(cl--defalias 'cl-gensym 'gensym) +(defun cl-gensym (&optional prefix) + "Generate a new uninterned symbol. +The name is made by appending a number to PREFIX, default \"G\"." + (let ((pfix (if (stringp prefix) prefix "G")) + (num (if (integerp prefix) prefix + (prog1 cl--gensym-counter + (setq cl--gensym-counter (1+ cl--gensym-counter)))))) + (make-symbol (format "%s%d" pfix num)))) (defvar cl--gentemp-counter 0) ;;;###autoload diff --git a/lisp/subr.el b/lisp/subr.el index ebb8b53b50..52d4e190e7 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -286,13 +286,10 @@ without silencing all errors." (defun gensym (&optional prefix) "Return a new uninterned symbol. The name is made by appending `gensym-counter' to PREFIX. -PREFIX can be a string, and defaults to \"G\". -If PREFIX is a number, it replaces the value of `gensym-counter'." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 gensym-counter - (setq gensym-counter (1+ gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))) +PREFIX is a string, and defaults to \"g\"." + (let ((num (prog1 gensym-counter + (setq gensym-counter (1+ gensym-counter))))) + (make-symbol (format "%s%d" prefix num)))) (defun ignore (&rest _ignore) "Do nothing and return nil. commit 3d96fc15362453f43f3f04ffa288a57ee1e633c3 Author: Mark Oteiza Date: Wed Sep 13 10:36:05 2017 -0400 Provide an lcms2 feature * src/lcms.c (syms_of_lcms2): Provide "lcms2". diff --git a/src/lcms.c b/src/lcms.c index 120ef76981..4c3a8b529d 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -177,6 +177,8 @@ syms_of_lcms2 (void) { defsubr (&Slcms_cie_de2000); defsubr (&Slcms_cam02_ucs); + + Fprovide (intern_c_string ("lcms2"), Qnil); } #endif /* HAVE_LCMS2 */ commit 5d4c539bd7e15e7fd0fb092276791b6287260a9a Author: Mark Oteiza Date: Wed Sep 13 10:27:37 2017 -0400 Add lcms2 interface configure.ac: Add boilerplate for configuring and detecting liblcms2. etc/NEWS: Mention new configure option and color-distance change. src/Makefile.in: Add references to lcms.c and liblcms. src/emacs.c: Define lcms2 symbols. src/lcms.c: New file. src/lisp.h: Add declaration for lcms2. src/xfaces.c: Add optional METRIC argument. diff --git a/configure.ac b/configure.ac index d294412dc4..df3931f938 100644 --- a/configure.ac +++ b/configure.ac @@ -3451,6 +3451,25 @@ if test "${with_jpeg}" != "no"; then fi AC_SUBST(LIBJPEG) +HAVE_LCMS2=no +LIBLCMS2= +if test "${with_lcms2}" != "no"; then + OLIBS=$LIBS + AC_SEARCH_LIBS([cmsCreateTransform], [lcms2], [HAVE_LCMS2=yes]) + LIBS=$OLIBS + case $ac_cv_search_cmsCreateTransform in + -*) LIBLCMS2=$ac_cv_search_cmsCreateTransform ;; + esac +fi +if test "${HAVE_LCMS2}" = "yes"; then + AC_DEFINE([HAVE_LCMS2], 1, [Define to 1 if you have the lcms2 library (-llcms2).]) + ### ??? + if test "${opsys}" = "mingw32"; then + LIBLCMS2= + fi +fi +AC_SUBST(LIBLCMS2) + HAVE_ZLIB=no LIBZ= if test "${with_zlib}" != "no"; then diff --git a/etc/NEWS b/etc/NEWS index 9467369709..b49cf70e2a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -69,6 +69,11 @@ Deterministic builds omit the build date from the output of the following variables nil: 'emacs-build-system', 'emacs-build-time', 'erc-emacs-build-time'. +** New configure option '--with-lcms2' attempts to build an Emacs +linked to Little CMS, exposing color management functions in Lisp. +Implemented functions include the color metrics 'lcms-cie-de2000' and +'lcms-cam02-ucs'. + ** The configure option '--with-gameuser' now defaults to 'no', as this appears to be the most common configuration in practice. When it is 'no', the shared game directory and the auxiliary program @@ -1588,6 +1593,11 @@ function keeps on returning the line number taking potential narrowing into account. If this parameter is non-nil, the function ignores narrowing and returns the absolute line number. +--- +** The function 'color-distance' now takes a second optional argument +'metric'. When non-nil, it should be a function of two arguments that +accepts two colors and returns a number. + ** Changes in Frame and Window Handling +++ diff --git a/src/Makefile.in b/src/Makefile.in index dde3f1d3fb..a98ad9c5eb 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -234,6 +234,8 @@ LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ GETADDRINFO_A_LIBS = @GETADDRINFO_A_LIBS@ +LIBLCMS2 = @LIBLCMS2@ + LIBZ = @LIBZ@ ## system-specific libs for dynamic modules, else empty @@ -389,7 +391,7 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o intervals.o textprop.o composite.o xml.o $(NOTIFY_OBJ) \ + doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \ $(XWIDGETS_OBJ) \ profiler.o decompress.o \ thread.o systhread.o \ @@ -490,7 +492,7 @@ LIBES = $(LIBS) $(W32_LIBS) $(LIBS_GNUSTEP) $(LIBX_BASE) $(LIBIMAGE) \ $(LIBXML2_LIBS) $(LIBGPM) $(LIBS_SYSTEM) $(CAIRO_LIBS) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) $(SETTINGS_LIBS) $(LIBSELINUX_LIBS) \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ - $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) \ + $(LIBGNUTLS_LIBS) $(LIB_PTHREAD) $(GETADDRINFO_A_LIBS) $(LIBLCMS2) \ $(NOTIFY_LIBS) $(LIB_MATH) $(LIBZ) $(LIBMODULES) $(LIBSYSTEMD_LIBS) ## FORCE it so that admin/unidata can decide whether these files diff --git a/src/emacs.c b/src/emacs.c index 44f6285795..668711a5ab 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -1546,6 +1546,10 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_xml (); #endif +#ifdef HAVE_LCMS2 + syms_of_lcms2 (); +#endif + #ifdef HAVE_ZLIB syms_of_decompress (); #endif diff --git a/src/lcms.c b/src/lcms.c new file mode 100644 index 0000000000..120ef76981 --- /dev/null +++ b/src/lcms.c @@ -0,0 +1,182 @@ +/* Interface to Little CMS + Copyright (C) 2017 Free Software Foundation, Inc. + +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 . */ + +#include + +#ifdef HAVE_LCMS2 + +#include +#include + +#include "lisp.h" + +static bool +parse_lab_list (Lisp_Object lab_list, cmsCIELab *color) +{ +#define PARSE_LAB_LIST_FIELD(field) \ + if (CONSP (lab_list) && NUMBERP (XCAR (lab_list))) \ + { \ + color->field = XFLOATINT (XCAR (lab_list)); \ + lab_list = XCDR (lab_list); \ + } \ + else \ + return false; + + PARSE_LAB_LIST_FIELD (L); + PARSE_LAB_LIST_FIELD (a); + PARSE_LAB_LIST_FIELD (b); + + return true; +} + +/* http://www.ece.rochester.edu/~gsharma/ciede2000/ciede2000noteCRNA.pdf> */ + +DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0, + doc: /* Compute CIEDE2000 metric distance between COLOR1 and COLOR2. +Each color is a list of L*a*b* coordinates, where the L* channel ranges from +0 to 100, and the a* and b* channels range from -128 to 128. +Optional arguments KL, KC, KH are weighting parameters for lightness, +chroma, and hue, respectively. The parameters each default to 1. */) + (Lisp_Object color1, Lisp_Object color2, + Lisp_Object kL, Lisp_Object kC, Lisp_Object kH) +{ + cmsCIELab Lab1, Lab2; + cmsFloat64Number Kl, Kc, Kh; + + if (!(CONSP (color1) && parse_lab_list (color1, &Lab1))) + signal_error ("Invalid color", color1); + if (!(CONSP (color2) && parse_lab_list (color2, &Lab2))) + signal_error ("Invalid color", color1); + if (NILP (kL)) + Kl = 1.0f; + else if (!(NUMBERP (kL) && (Kl = XFLOATINT(kL)))) + wrong_type_argument(Qnumberp, kL); + if (NILP (kC)) + Kc = 1.0f; + else if (!(NUMBERP (kC) && (Kc = XFLOATINT(kC)))) + wrong_type_argument(Qnumberp, kC); + if (NILP (kL)) + Kh = 1.0f; + else if (!(NUMBERP (kH) && (Kh = XFLOATINT(kH)))) + wrong_type_argument(Qnumberp, kH); + + return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh)); +} + +/* FIXME: code duplication */ + +static bool +parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) +{ +#define PARSE_XYZ_LIST_FIELD(field) \ + if (CONSP (xyz_list) && NUMBERP (XCAR (xyz_list))) \ + { \ + color->field = 100.0 * XFLOATINT (XCAR (xyz_list)); \ + xyz_list = XCDR (xyz_list); \ + } \ + else \ + return false; + + PARSE_XYZ_LIST_FIELD (X); + PARSE_XYZ_LIST_FIELD (Y); + PARSE_XYZ_LIST_FIELD (Z); + + return true; +} + +DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, + doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. +Each color is a list of XYZ coordinates, with Y scaled to unity. +Optional argument is the XYZ white point, which defaults to illuminant D65. */) + (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) +{ + cmsViewingConditions vc; + cmsJCh jch1, jch2; + cmsHANDLE h1, h2; + cmsCIEXYZ xyz1, xyz2, xyzw; + double Jp1, ap1, bp1, Jp2, ap2, bp2; + double Mp1, Mp2, FL, k, k4; + + if (!(CONSP (color1) && parse_xyz_list (color1, &xyz1))) + signal_error ("Invalid color", color1); + if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) + signal_error ("Invalid color", color1); + if (NILP (whitepoint)) + { + xyzw.X = 95.047; + xyzw.Y = 100.0; + xyzw.Z = 108.883; + } + else if (!(CONSP (whitepoint) && parse_xyz_list(whitepoint, &xyzw))) + signal_error("Invalid white point", whitepoint); + + vc.whitePoint.X = xyzw.X; + vc.whitePoint.Y = xyzw.Y; + vc.whitePoint.Z = xyzw.Z; + vc.Yb = 20; + vc.La = 100; + vc.surround = AVG_SURROUND; + vc.D_value = 1.0; + + h1 = cmsCIECAM02Init (0, &vc); + h2 = cmsCIECAM02Init (0, &vc); + cmsCIECAM02Forward (h1, &xyz1, &jch1); + cmsCIECAM02Forward (h2, &xyz2, &jch2); + cmsCIECAM02Done (h1); + cmsCIECAM02Done (h2); + + /* Now have colors in JCh, need to calculate J'a'b' + + M = C * F_L^0.25 + J' = 1.7 J / (1 + 0.007 J) + M' = 43.86 ln(1 + 0.0228 M) + a' = M' cos(h) + b' = M' sin(h) + + where + + F_L = 0.2 k^4 (5 L_A) + 0.1 (1 - k^4)^2 (5 L_A)^(1/3), + k = 1/(5 L_A + 1) + */ + k = 1.0 / (1.0 + (5.0 * vc.La)); + k4 = k * k * k * k; + FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La); + Mp1 = 43.86 * log (1.0 + 0.0228 * (jch1.C * sqrt (sqrt (FL)))); + Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL)))); + Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J)); + Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J)); + ap1 = Mp1 * cos (jch1.h); + ap2 = Mp2 * cos (jch2.h); + bp1 = Mp1 * sin (jch1.h); + bp2 = Mp2 * sin (jch2.h); + + return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) + + (ap2 - ap1) * (ap2 - ap1) + + (bp2 - bp1) * (bp2 - bp1))); +} + + +/* Initialization */ +void +syms_of_lcms2 (void) +{ + defsubr (&Slcms_cie_de2000); + defsubr (&Slcms_cam02_ucs); +} + +#endif /* HAVE_LCMS2 */ diff --git a/src/lisp.h b/src/lisp.h index 81f8d6a24b..19594e7830 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4396,6 +4396,11 @@ extern void syms_of_xml (void); extern void xml_cleanup_parser (void); #endif +#ifdef HAVE_LCMS2 +/* Defined in lcms.c. */ +extern void syms_of_lcms2 (void); +#endif + #ifdef HAVE_ZLIB /* Defined in decompress.c. */ extern void syms_of_decompress (void); diff --git a/src/xfaces.c b/src/xfaces.c index 86bb9b0b49..32a5bd5f60 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -4088,12 +4088,14 @@ color_distance (XColor *x, XColor *y) } -DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 3, 0, +DEFUN ("color-distance", Fcolor_distance, Scolor_distance, 2, 4, 0, doc: /* Return an integer distance between COLOR1 and COLOR2 on FRAME. COLOR1 and COLOR2 may be either strings containing the color name, -or lists of the form (RED GREEN BLUE). -If FRAME is unspecified or nil, the current frame is used. */) - (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame) +or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive. +If FRAME is unspecified or nil, the current frame is used. +If METRIC is unspecified or nil, a modified L*u*v* metric is used. */) + (Lisp_Object color1, Lisp_Object color2, Lisp_Object frame, + Lisp_Object metric) { struct frame *f = decode_live_frame (frame); XColor cdef1, cdef2; @@ -4107,7 +4109,10 @@ If FRAME is unspecified or nil, the current frame is used. */) && defined_color (f, SSDATA (color2), &cdef2, false))) signal_error ("Invalid color", color2); - return make_number (color_distance (&cdef1, &cdef2)); + if (NILP (metric)) + return make_number (color_distance (&cdef1, &cdef2)); + else + return call2 (metric, color1, color2); } commit 9a8bbb9d5d3a55d4a31658e188f305669bd26e79 Author: Mark Oteiza Date: Wed Sep 13 10:19:59 2017 -0400 ; Fix previous commit Removing extraneous code, thanks to Michael Heerdegen. * lisp/emacs-lisp/subr-x.el (internal--listify): Remove latter condition which always evaluates to t. (internal--build-binding-value-form): Remove dead code. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 3ea01065c8..ba0ab6cb4c 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -87,9 +87,7 @@ threading." If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." (cond ((symbolp elt) (list elt elt)) - ((and (null (cdr elt)) - (let ((form (car elt))) - (or (listp form) (atom form)))) + ((null (cdr elt)) (list (make-symbol "s") (car elt))) (t elt))) @@ -104,9 +102,7 @@ If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." (defsubst internal--build-binding-value-form (binding prev-var) "Build the conditional value form for BINDING using PREV-VAR." (let ((var (car binding))) - (if (and (null (cdr binding)) (atom (car binding)) (not (symbolp (car binding)))) - `(,var (and ,prev-var ,var)) - `(,var (and ,prev-var ,(cadr binding)))))) + `(,var (and ,prev-var ,(cadr binding))))) (defun internal--build-binding (binding prev-var) "Check and build a single BINDING with PREV-VAR." commit d532caaeee1d604e72e75072310c4447b694a070 Author: Mark Oteiza Date: Wed Sep 13 10:00:39 2017 -0400 Add other D series white points and some simple conversions * lisp/color.el (color-d75-xyz, color-d55-xyz, color-d50-xyz): New constants. (color-xyz-to-xyy, color-xyy-to-xyz, color-lab-to-lch): (color-lch-to-lab): New functions. diff --git a/lisp/color.el b/lisp/color.el index ddd0fdb15a..22b6808c87 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -212,9 +212,18 @@ RED, GREEN and BLUE should be between 0.0 and 1.0, inclusive." (* 12.92 b) (- (* 1.055 (expt b (/ 2.4))) 0.055))))) +(defconst color-d75-xyz '(0.9497 1.0 1.2264) + "D75 white point in CIE XYZ.") + (defconst color-d65-xyz '(0.950455 1.0 1.088753) "D65 white point in CIE XYZ.") +(defconst color-d55-xyz '(0.9568 1.0 0.9215) + "D55 white point in CIE XYZ.") + +(defconst color-d50-xyz '(0.9642 1.0 0.8249) + "D50 white point in CIE XYZ.") + (defconst color-cie-ε (/ 216 24389.0)) (defconst color-cie-κ (/ 24389 27.0)) @@ -269,6 +278,24 @@ conversion. If omitted or nil, use `color-d65-xyz'." "Convert CIE L*a*b* to RGB." (apply 'color-xyz-to-srgb (color-lab-to-xyz L a b))) +(defun color-xyz-to-xyy (X Y Z) + "Convert CIE XYZ to xyY." + (let ((d (float (+ X Y Z)))) + (list (/ X d) (/ Y d) Y))) + +(defun color-xyy-to-xyz (x y Y) + "Convert CIE xyY to XYZ." + (let ((y (float y))) + (list (/ (* Y x) y) Y (/ (* Y (- 1 x y)) y)))) + +(defun color-lab-to-lch (L a b) + "Convert CIE L*a*b* to L*C*h*" + (list L (sqrt (+ (* a a) (* b b))) (atan b a))) + +(defun color-lch-to-lab (L C h) + "Convert CIE L*a*b* to L*C*h*" + (list L (* C (cos h)) (* C (sin h)))) + (defun color-cie-de2000 (color1 color2 &optional kL kC kH) "Return the CIEDE2000 color distance between COLOR1 and COLOR2. Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as commit 8d433d9b22d2c5f209cb27e80c13576e6d1bf9b7 Author: Mark Oteiza Date: Wed Sep 13 09:59:37 2017 -0400 Permit non-integral color gradients * lisp/color.el (color-gradient): Float the step-number. diff --git a/lisp/color.el b/lisp/color.el index 6dbf3d55cb..ddd0fdb15a 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -82,9 +82,10 @@ resulting list." (let* ((r (nth 0 start)) (g (nth 1 start)) (b (nth 2 start)) - (r-step (/ (- (nth 0 stop) r) (1+ step-number))) - (g-step (/ (- (nth 1 stop) g) (1+ step-number))) - (b-step (/ (- (nth 2 stop) b) (1+ step-number))) + (interval (float (1+ step-number))) + (r-step (/ (- (nth 0 stop) r) interval)) + (g-step (/ (- (nth 1 stop) g) interval)) + (b-step (/ (- (nth 2 stop) b) interval)) result) (dotimes (_ step-number) (push (list (setq r (+ r r-step)) commit 61b8f9c4903734ae5a019b1f8e7706287aeb0f9d Author: Katsumi Yamaoka Date: Wed Sep 13 10:04:14 2017 +0000 Protect against malformed MIME messages that cause inf-loop (bugfix) * lisp/gnus/gnus-art.el (gnus-article-mime-handles): Protect against malformed MIME messages that cause inf-loop. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 8fc5ebaa9b..226a56e187 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6342,8 +6342,9 @@ Provided for backwards compatibility." ;; in each element are in the increasing order. (dolist (handle (reverse gnus-article-mime-handle-alist)) (if (stringp (cadr handle)) - (setq flat (nconc flat (gnus-article-mime-handles - (cddr handle) (list (car handle)) flat))) + (when (cddr handle) + (setq flat (nconc flat (gnus-article-mime-handles + (cddr handle) (list (car handle)) flat)))) (delq (rassq (cdr handle) flat) flat) (setq flat (nconc flat (list (cons (list (car handle)) (cdr handle))))))) commit a0202fdc85ddc36b73a1c7c4f2d3ec45cd22c5e1 Author: Paul Eggert Date: Wed Sep 13 02:07:03 2017 -0700 Merge from Gnulib This incorporates: 2017-09-13 all: prefer https: URLs This just changes http: to https: in comments, in files copied from Gnulib. diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog index cf16425463..ec5ab9e141 100755 --- a/build-aux/gitlog-to-changelog +++ b/build-aux/gitlog-to-changelog @@ -3,7 +3,7 @@ eval '(exit $?0)' && eval 'exec perl -wS "$0" "$@"' if 0; # Convert git log output to ChangeLog format. -my $VERSION = '2016-03-22 21:49'; # UTC +my $VERSION = '2017-09-13 06:45'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -22,7 +22,7 @@ my $VERSION = '2016-03-22 21:49'; # UTC # GNU General Public License for more details. # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . # Written by Jim Meyering diff --git a/build-aux/move-if-change b/build-aux/move-if-change index 4dd8699592..4a65145594 100755 --- a/build-aux/move-if-change +++ b/build-aux/move-if-change @@ -2,7 +2,7 @@ # Like mv $1 $2, but if the files are the same, just delete $1. # Status is zero if successful, nonzero otherwise. -VERSION='2016-01-11 22:04'; # UTC +VERSION='2017-09-13 06:45'; # UTC # The definition above must lie within the first 8 lines in order # for the Emacs time-stamp write hook (at end) to update it. # If you change this file with Emacs, please let the write hook @@ -21,7 +21,7 @@ VERSION='2016-01-11 22:04'; # UTC # GNU General Public License for more details. # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . usage="usage: $0 SOURCE DEST" @@ -39,7 +39,7 @@ Report bugs to ." version=`expr "$VERSION" : '\([^ ]*\)'` version="move-if-change (gnulib) $version Copyright (C) 2011 Free Software Foundation, Inc. -License GPLv3+: GNU GPL version 3 or later +License GPLv3+: GNU GPL version 3 or later This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law." diff --git a/build-aux/update-copyright b/build-aux/update-copyright index 2d20d211c9..63455c3794 100755 --- a/build-aux/update-copyright +++ b/build-aux/update-copyright @@ -3,7 +3,7 @@ eval '(exit $?0)' && eval 'exec perl -wS -0777 -pi "$0" "$@"' if 0; # Update an FSF copyright year list to include the current year. -my $VERSION = '2016-01-12.23:13'; # UTC +my $VERSION = '2017-09-13.06:45'; # UTC # Copyright (C) 2009-2017 Free Software Foundation, Inc. # @@ -18,7 +18,7 @@ my $VERSION = '2016-01-12.23:13'; # UTC # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . # Written by Jim Meyering and Joel E. Denny diff --git a/lib/acl-errno-valid.c b/lib/acl-errno-valid.c index a633985663..1e96974dd1 100644 --- a/lib/acl-errno-valid.c +++ b/lib/acl-errno-valid.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert. */ diff --git a/lib/acl-internal.c b/lib/acl-internal.c index 2a2dee947d..63e6b6b997 100644 --- a/lib/acl-internal.c +++ b/lib/acl-internal.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ diff --git a/lib/acl-internal.h b/lib/acl-internal.h index e7bda0eade..ebd24217bb 100644 --- a/lib/acl-internal.h +++ b/lib/acl-internal.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ diff --git a/lib/acl.h b/lib/acl.h index b13370c591..d3b048022e 100644 --- a/lib/acl.h +++ b/lib/acl.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert. */ diff --git a/lib/acl_entries.c b/lib/acl_entries.c index 1df6a844df..c7efaefd52 100644 --- a/lib/acl_entries.c +++ b/lib/acl_entries.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert and Andreas Gruenbacher. */ diff --git a/lib/alloca.in.h b/lib/alloca.in.h index c3dc38a5b9..1881e74f5d 100644 --- a/lib/alloca.in.h +++ b/lib/alloca.in.h @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, see - . + . */ /* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H diff --git a/lib/allocator.h b/lib/allocator.h index 650f8e071e..2ecbf1a379 100644 --- a/lib/allocator.h +++ b/lib/allocator.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/arg-nonnull.h b/lib/arg-nonnull.h index 1e62cc8982..61ee071274 100644 --- a/lib/arg-nonnull.h +++ b/lib/arg-nonnull.h @@ -12,7 +12,7 @@ General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* _GL_ARG_NONNULL((n,...,m)) tells the compiler and static analyzer tools that the values passed as arguments n, ..., m must be non-NULL pointers. diff --git a/lib/at-func.c b/lib/at-func.c index 9eaa9932fa..2a3e375e9a 100644 --- a/lib/at-func.c +++ b/lib/at-func.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/binary-io.c b/lib/binary-io.c index a7558b20fd..2cee469781 100644 --- a/lib/binary-io.c +++ b/lib/binary-io.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/binary-io.h b/lib/binary-io.h index 9f1dde108e..75adb33c91 100644 --- a/lib/binary-io.h +++ b/lib/binary-io.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _BINARY_H #define _BINARY_H diff --git a/lib/byteswap.in.h b/lib/byteswap.in.h index 5fc0663def..32385a289c 100644 --- a/lib/byteswap.in.h +++ b/lib/byteswap.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _GL_BYTESWAP_H #define _GL_BYTESWAP_H diff --git a/lib/c++defs.h b/lib/c++defs.h index f03f3591c3..09dcd3e068 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h @@ -12,7 +12,7 @@ General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _GL_CXXDEFS_H #define _GL_CXXDEFS_H @@ -266,7 +266,7 @@ _GL_CXXALIASWARN_1 (func, GNULIB_NAMESPACE) # define _GL_CXXALIASWARN_1(func,namespace) \ _GL_CXXALIASWARN_2 (func, namespace) -/* To work around GCC bug , +/* To work around GCC bug , we enable the warning only when not optimizing. */ # if !__OPTIMIZE__ # define _GL_CXXALIASWARN_2(func,namespace) \ @@ -294,7 +294,7 @@ GNULIB_NAMESPACE) # define _GL_CXXALIASWARN1_1(func,rettype,parameters_and_attributes,namespace) \ _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) -/* To work around GCC bug , +/* To work around GCC bug , we enable the warning only when not optimizing. */ # if !__OPTIMIZE__ # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ diff --git a/lib/c-ctype.h b/lib/c-ctype.h index bcdba6b996..9ad3c18d47 100644 --- a/lib/c-ctype.h +++ b/lib/c-ctype.h @@ -18,7 +18,7 @@ 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 this program; if not, see . */ +along with this program; if not, see . */ #ifndef C_CTYPE_H #define C_CTYPE_H diff --git a/lib/c-strcase.h b/lib/c-strcase.h index c82dab1dbe..220d21d34e 100644 --- a/lib/c-strcase.h +++ b/lib/c-strcase.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef C_STRCASE_H #define C_STRCASE_H diff --git a/lib/c-strcasecmp.c b/lib/c-strcasecmp.c index 5bce873d7b..b2880a2e6c 100644 --- a/lib/c-strcasecmp.c +++ b/lib/c-strcasecmp.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #include diff --git a/lib/c-strncasecmp.c b/lib/c-strncasecmp.c index ada62d70b7..982e17915b 100644 --- a/lib/c-strncasecmp.c +++ b/lib/c-strncasecmp.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #include diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c index 455e00efe0..e2af54f098 100644 --- a/lib/careadlinkat.c +++ b/lib/careadlinkat.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */ diff --git a/lib/careadlinkat.h b/lib/careadlinkat.h index 528a8289e5..d436c691ea 100644 --- a/lib/careadlinkat.h +++ b/lib/careadlinkat.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */ diff --git a/lib/cloexec.c b/lib/cloexec.c index e34aef8797..2b67a0102e 100644 --- a/lib/cloexec.c +++ b/lib/cloexec.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . The code is taken from glibc/manual/llio.texi */ diff --git a/lib/cloexec.h b/lib/cloexec.h index cdaf422226..d937a40681 100644 --- a/lib/cloexec.h +++ b/lib/cloexec.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . */ diff --git a/lib/close-stream.c b/lib/close-stream.c index 96c126536c..19707626fa 100644 --- a/lib/close-stream.c +++ b/lib/close-stream.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index e197137e66..1b60e28e7f 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Eric Blake. */ diff --git a/lib/count-one-bits.h b/lib/count-one-bits.h index fb5fb927ff..1576b08481 100644 --- a/lib/count-one-bits.h +++ b/lib/count-one-bits.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Ben Pfaff. */ diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 4a0a109d99..be7131429c 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/diffseq.h b/lib/diffseq.h index a3cf140990..b6f9f6f9d1 100644 --- a/lib/diffseq.h +++ b/lib/diffseq.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* The basic idea is to consider two vectors as similar if, when diff --git a/lib/dirent.in.h b/lib/dirent.in.h index f59178751b..5b235731e0 100644 --- a/lib/dirent.in.h +++ b/lib/dirent.in.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef _@GUARD_PREFIX@_DIRENT_H diff --git a/lib/dirfd.c b/lib/dirfd.c index 6b1a7b2744..7e38fabdac 100644 --- a/lib/dirfd.c +++ b/lib/dirfd.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Jim Meyering. */ diff --git a/lib/dosname.h b/lib/dosname.h index dd5c177725..255d57e4d6 100644 --- a/lib/dosname.h +++ b/lib/dosname.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . From Paul Eggert and Jim Meyering. */ diff --git a/lib/dtotimespec.c b/lib/dtotimespec.c index 3ca5a9cfd3..8f2e8150c9 100644 --- a/lib/dtotimespec.c +++ b/lib/dtotimespec.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Paul Eggert */ diff --git a/lib/dup2.c b/lib/dup2.c index 002dc8c76c..b89f83732f 100644 --- a/lib/dup2.c +++ b/lib/dup2.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Paul Eggert */ diff --git a/lib/errno.in.h b/lib/errno.in.h index 13194f9d29..aaf5fecd73 100644 --- a/lib/errno.in.h +++ b/lib/errno.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _@GUARD_PREFIX@_ERRNO_H diff --git a/lib/euidaccess.c b/lib/euidaccess.c index da2bda9be0..298c445947 100644 --- a/lib/euidaccess.c +++ b/lib/euidaccess.c @@ -16,7 +16,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by David MacKenzie and Torbjorn Granlund. Adapted for GNU C library by Roland McGrath. */ diff --git a/lib/execinfo.in.h b/lib/execinfo.in.h index 065a78dbff..f2269269c5 100644 --- a/lib/execinfo.in.h +++ b/lib/execinfo.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c index 262c68f9cd..0909346776 100644 --- a/lib/explicit_bzero.c +++ b/lib/explicit_bzero.c @@ -14,7 +14,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ /* An assembler implementation of explicit_bzero can be created as an assembler alias of an optimized bzero implementation. diff --git a/lib/faccessat.c b/lib/faccessat.c index f9458e8303..6cf9c99df2 100644 --- a/lib/faccessat.c +++ b/lib/faccessat.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Eric Blake */ diff --git a/lib/fcntl.c b/lib/fcntl.c index d4dd144e05..91efd12c2b 100644 --- a/lib/fcntl.c +++ b/lib/fcntl.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Eric Blake . */ diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index 076d1ac34a..00b270c958 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Paul Eggert */ diff --git a/lib/fdatasync.c b/lib/fdatasync.c index 6875fa4c69..25fd74049f 100644 --- a/lib/fdatasync.c +++ b/lib/fdatasync.c @@ -13,7 +13,7 @@ General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include #include diff --git a/lib/fdopendir.c b/lib/fdopendir.c index 03be92adc1..7f72258598 100644 --- a/lib/fdopendir.c +++ b/lib/fdopendir.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/filemode.c b/lib/filemode.c index d62f70bc9b..c6cf1f3196 100644 --- a/lib/filemode.c +++ b/lib/filemode.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/filemode.h b/lib/filemode.h index 5fbb79146d..809bf7eb0f 100644 --- a/lib/filemode.h +++ b/lib/filemode.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef FILEMODE_H_ diff --git a/lib/filevercmp.c b/lib/filevercmp.c index 0396867c7e..56c9821e36 100644 --- a/lib/filevercmp.c +++ b/lib/filevercmp.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include #include "filevercmp.h" diff --git a/lib/filevercmp.h b/lib/filevercmp.h index d698991172..25cc6f624c 100644 --- a/lib/filevercmp.h +++ b/lib/filevercmp.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef FILEVERCMP_H #define FILEVERCMP_H diff --git a/lib/flexmember.h b/lib/flexmember.h index 7405c41838..7e4f95d3c8 100644 --- a/lib/flexmember.h +++ b/lib/flexmember.h @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . + . Written by Paul Eggert. */ diff --git a/lib/fpending.c b/lib/fpending.c index 02602a1c27..5811a4a747 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Jim Meyering. */ diff --git a/lib/fpending.h b/lib/fpending.h index a901deee4b..73c7d795c1 100644 --- a/lib/fpending.h +++ b/lib/fpending.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Jim Meyering. */ diff --git a/lib/fstatat.c b/lib/fstatat.c index 70799bebcd..d09add037f 100644 --- a/lib/fstatat.c +++ b/lib/fstatat.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert and Jim Meyering. */ diff --git a/lib/fsync.c b/lib/fsync.c index 5a4945ef2b..a52e6642f9 100644 --- a/lib/fsync.c +++ b/lib/fsync.c @@ -20,7 +20,7 @@ General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include #include diff --git a/lib/ftoastr.c b/lib/ftoastr.c index f2434161db..029e797b79 100644 --- a/lib/ftoastr.c +++ b/lib/ftoastr.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/ftoastr.h b/lib/ftoastr.h index 74a855ac21..3ee05a3033 100644 --- a/lib/ftoastr.h +++ b/lib/ftoastr.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/get-permissions.c b/lib/get-permissions.c index dc77748af1..c54d71c1c5 100644 --- a/lib/get-permissions.c +++ b/lib/get-permissions.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c index a0928630fa..d0a5ecaf5d 100644 --- a/lib/getdtablesize.c +++ b/lib/getdtablesize.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/getgroups.c b/lib/getgroups.c index dce0f2d003..52473a5a23 100644 --- a/lib/getgroups.c +++ b/lib/getgroups.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/getloadavg.c b/lib/getloadavg.c index 0fe23bb9a5..5f2dfabb6f 100644 --- a/lib/getloadavg.c +++ b/lib/getloadavg.c @@ -17,7 +17,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Compile-time symbols that this file uses: diff --git a/lib/getopt-cdefs.in.h b/lib/getopt-cdefs.in.h index c71a4f11f6..21d847b8c3 100644 --- a/lib/getopt-cdefs.in.h +++ b/lib/getopt-cdefs.in.h @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with gnulib; if not, see - . */ + . */ #ifndef _GETOPT_CDEFS_H #define _GETOPT_CDEFS_H 1 diff --git a/lib/getopt-core.h b/lib/getopt-core.h index d315891aef..ec0734c723 100644 --- a/lib/getopt-core.h +++ b/lib/getopt-core.h @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifndef _GETOPT_CORE_H #define _GETOPT_CORE_H 1 diff --git a/lib/getopt-ext.h b/lib/getopt-ext.h index e4da22f54f..4cdbfb0e7a 100644 --- a/lib/getopt-ext.h +++ b/lib/getopt-ext.h @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifndef _GETOPT_EXT_H #define _GETOPT_EXT_H 1 diff --git a/lib/getopt-pfx-core.h b/lib/getopt-pfx-core.h index db5f15c22d..2ede4bbffe 100644 --- a/lib/getopt-pfx-core.h +++ b/lib/getopt-pfx-core.h @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with gnulib; if not, see - . */ + . */ #ifndef _GETOPT_PFX_CORE_H #define _GETOPT_PFX_CORE_H 1 diff --git a/lib/getopt-pfx-ext.h b/lib/getopt-pfx-ext.h index 91f4df1720..16d9634e8c 100644 --- a/lib/getopt-pfx-ext.h +++ b/lib/getopt-pfx-ext.h @@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along with gnulib; if not, see - . */ + . */ #ifndef _GETOPT_PFX_EXT_H #define _GETOPT_PFX_EXT_H 1 diff --git a/lib/getopt.c b/lib/getopt.c index 9a2867db27..b0cc35bfb1 100644 --- a/lib/getopt.c +++ b/lib/getopt.c @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifndef _LIBC # include diff --git a/lib/getopt.in.h b/lib/getopt.in.h index 4ce1eb485a..908f84166a 100644 --- a/lib/getopt.in.h +++ b/lib/getopt.in.h @@ -16,7 +16,7 @@ General Public License for more details. You should have received a copy of the GNU General Public - License along with gnulib; if not, see . */ + License along with gnulib; if not, see . */ #ifndef _@GUARD_PREFIX@_GETOPT_H diff --git a/lib/getopt1.c b/lib/getopt1.c index 2bc5926016..d689f4ce67 100644 --- a/lib/getopt1.c +++ b/lib/getopt1.c @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifndef _LIBC # include diff --git a/lib/getopt_int.h b/lib/getopt_int.h index a556219512..e33856ce9b 100644 --- a/lib/getopt_int.h +++ b/lib/getopt_int.h @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifndef _GETOPT_INT_H #define _GETOPT_INT_H 1 diff --git a/lib/gettext.h b/lib/gettext.h index 742ce37e6c..f6150be652 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ #ifndef _LIBGETTEXT_H #define _LIBGETTEXT_H 1 diff --git a/lib/gettime.c b/lib/gettime.c index 4ae313e78e..e5af26c990 100644 --- a/lib/gettime.c +++ b/lib/gettime.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/gettimeofday.c b/lib/gettimeofday.c index 8ae7622af3..a11b1830c4 100644 --- a/lib/gettimeofday.c +++ b/lib/gettimeofday.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* written by Jim Meyering */ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fdf87433e5..9500871b16 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -13,7 +13,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see . +# along with this file. If not, see . # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that diff --git a/lib/group-member.c b/lib/group-member.c index 20f8ee8b67..7c4ce49675 100644 --- a/lib/group-member.c +++ b/lib/group-member.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/ignore-value.h b/lib/ignore-value.h index 2439d9506a..8ef3fe782f 100644 --- a/lib/ignore-value.h +++ b/lib/ignore-value.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Jim Meyering, Eric Blake and Pádraig Brady. */ diff --git a/lib/intprops.h b/lib/intprops.h index 28f43613fe..400ba5b912 100644 --- a/lib/intprops.h +++ b/lib/intprops.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/inttypes.in.h b/lib/inttypes.in.h index 69b12a839a..e7357e96ac 100644 --- a/lib/inttypes.in.h +++ b/lib/inttypes.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* * ISO C 99 for platforms that lack it. diff --git a/lib/limits.in.h b/lib/limits.in.h index 08d3c328c4..78dcf31037 100644 --- a/lib/limits.in.h +++ b/lib/limits.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _@GUARD_PREFIX@_LIMITS_H diff --git a/lib/localtime-buffer.c b/lib/localtime-buffer.c index f84ad3e823..c96c577ac1 100644 --- a/lib/localtime-buffer.c +++ b/lib/localtime-buffer.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* written by Jim Meyering */ diff --git a/lib/localtime-buffer.h b/lib/localtime-buffer.h index 483a579bda..0a0389da07 100644 --- a/lib/localtime-buffer.h +++ b/lib/localtime-buffer.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* written by Jim Meyering */ diff --git a/lib/lstat.c b/lib/lstat.c index f4dc43ec64..c721a4e641 100644 --- a/lib/lstat.c +++ b/lib/lstat.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/md5.c b/lib/md5.c index dcbba45ddf..e16da5990f 100644 --- a/lib/md5.c +++ b/lib/md5.c @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Ulrich Drepper , 1995. */ diff --git a/lib/md5.h b/lib/md5.h index e38a619870..8b94bfcf0e 100644 --- a/lib/md5.h +++ b/lib/md5.h @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _MD5_H #define _MD5_H 1 diff --git a/lib/memrchr.c b/lib/memrchr.c index fefe16cc51..29e56984cb 100644 --- a/lib/memrchr.c +++ b/lib/memrchr.c @@ -20,7 +20,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #if defined _LIBC # include diff --git a/lib/minmax.h b/lib/minmax.h index 6b602a94fd..bbf14163c1 100644 --- a/lib/minmax.h +++ b/lib/minmax.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _MINMAX_H #define _MINMAX_H diff --git a/lib/mkostemp.c b/lib/mkostemp.c index 56c22a4464..f1ce93babe 100644 --- a/lib/mkostemp.c +++ b/lib/mkostemp.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #if !_LIBC # include diff --git a/lib/mktime-internal.h b/lib/mktime-internal.h index 6c8b2e7f52..00e58abdd6 100644 --- a/lib/mktime-internal.h +++ b/lib/mktime-internal.h @@ -14,7 +14,7 @@ You should have received a copy of the GNU General Public License along with this program; if not, see - . */ + . */ #include diff --git a/lib/mktime.c b/lib/mktime.c index 058ab65c03..dd7f0a3ab3 100644 --- a/lib/mktime.c +++ b/lib/mktime.c @@ -15,7 +15,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ /* Define this to 1 to have a standalone program to test this implementation of mktime. */ diff --git a/lib/nstrftime.c b/lib/nstrftime.c index 99bee4ef97..8795cd729d 100644 --- a/lib/nstrftime.c +++ b/lib/nstrftime.c @@ -13,7 +13,7 @@ You should have received a copy of the GNU General Public License along with the GNU C Library; if not, see - . */ + . */ #ifdef _LIBC # define USE_IN_EXTENDED_LOCALE_MODEL 1 diff --git a/lib/open.c b/lib/open.c index c62f02b145..b5452b56af 100644 --- a/lib/open.c +++ b/lib/open.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Bruno Haible , 2007. */ diff --git a/lib/openat-priv.h b/lib/openat-priv.h index 2598719ecc..b5a411b944 100644 --- a/lib/openat-priv.h +++ b/lib/openat-priv.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/openat-proc.c b/lib/openat-proc.c index 101449bbb7..6d2b598c8b 100644 --- a/lib/openat-proc.c +++ b/lib/openat-proc.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/openat.h b/lib/openat.h index a036081e0a..1c4f64a32e 100644 --- a/lib/openat.h +++ b/lib/openat.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Jim Meyering */ diff --git a/lib/pipe2.c b/lib/pipe2.c index 830f006bd3..741cee99ff 100644 --- a/lib/pipe2.c +++ b/lib/pipe2.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ #include diff --git a/lib/pselect.c b/lib/pselect.c index 0c44ca9c0f..2ea7c45307 100644 --- a/lib/pselect.c +++ b/lib/pselect.c @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ /* written by Paul Eggert */ diff --git a/lib/pthread_sigmask.c b/lib/pthread_sigmask.c index cb213303fb..9ccf89b51f 100644 --- a/lib/pthread_sigmask.c +++ b/lib/pthread_sigmask.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/putenv.c b/lib/putenv.c index b55e262093..7831864478 100644 --- a/lib/putenv.c +++ b/lib/putenv.c @@ -15,7 +15,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/qcopy-acl.c b/lib/qcopy-acl.c index fdf0a052b9..003cb42b7d 100644 --- a/lib/qcopy-acl.c +++ b/lib/qcopy-acl.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ diff --git a/lib/readlink.c b/lib/readlink.c index bf0cedc5fa..cd9604b224 100644 --- a/lib/readlink.c +++ b/lib/readlink.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/readlinkat.c b/lib/readlinkat.c index 29a71ddfc2..c9880e1c70 100644 --- a/lib/readlinkat.c +++ b/lib/readlinkat.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* written by Eric Blake */ diff --git a/lib/root-uid.h b/lib/root-uid.h index 3a0037a486..4aa9dfe24f 100644 --- a/lib/root-uid.h +++ b/lib/root-uid.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert. */ diff --git a/lib/set-permissions.c b/lib/set-permissions.c index 75bb2dcce4..b30841fca4 100644 --- a/lib/set-permissions.c +++ b/lib/set-permissions.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert, Andreas Grünbacher, and Bruno Haible. */ diff --git a/lib/sha1.c b/lib/sha1.c index a57814131d..ca3eabc45e 100644 --- a/lib/sha1.c +++ b/lib/sha1.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Scott G. Miller Credits: diff --git a/lib/sha1.h b/lib/sha1.h index fcef9ce2c6..dd48889fa4 100644 --- a/lib/sha1.h +++ b/lib/sha1.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef SHA1_H # define SHA1_H 1 diff --git a/lib/sha256.c b/lib/sha256.c index c0fb8beecf..449a9b7b71 100644 --- a/lib/sha256.c +++ b/lib/sha256.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by David Madore, considerably copypasting from Scott G. Miller's sha1.c diff --git a/lib/sha256.h b/lib/sha256.h index 348b76ef26..b998aa4b63 100644 --- a/lib/sha256.h +++ b/lib/sha256.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef SHA256_H # define SHA256_H 1 diff --git a/lib/sha512.c b/lib/sha512.c index dbde67183b..e666231148 100644 --- a/lib/sha512.c +++ b/lib/sha512.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by David Madore, considerably copypasting from Scott G. Miller's sha1.c diff --git a/lib/sha512.h b/lib/sha512.h index 4460e6c9b7..70a3f9ad6c 100644 --- a/lib/sha512.h +++ b/lib/sha512.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef SHA512_H # define SHA512_H 1 diff --git a/lib/sig2str.c b/lib/sig2str.c index c50c612b39..a3ed970063 100644 --- a/lib/sig2str.c +++ b/lib/sig2str.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/sig2str.h b/lib/sig2str.h index 9bec78ed6a..4e43ea404c 100644 --- a/lib/sig2str.h +++ b/lib/sig2str.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/signal.in.h b/lib/signal.in.h index 1ffba37e23..1d8ebfa57e 100644 --- a/lib/signal.in.h +++ b/lib/signal.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/stat-time.h b/lib/stat-time.h index 9e45e85565..47a3bf8f21 100644 --- a/lib/stat-time.h +++ b/lib/stat-time.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/stdalign.in.h b/lib/stdalign.in.h index ea24823170..68e889e053 100644 --- a/lib/stdalign.in.h +++ b/lib/stdalign.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Paul Eggert and Bruno Haible. */ @@ -53,7 +53,7 @@ #undef _Alignof /* GCC releases before GCC 4.9 had a bug in _Alignof. See GCC bug 52023 - . */ + . */ #if (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112 \ || (defined __GNUC__ && __GNUC__ < 4 + (__GNUC_MINOR__ < 9))) # ifdef __cplusplus diff --git a/lib/stddef.in.h b/lib/stddef.in.h index 16e72bd1e0..758ccf6338 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Eric Blake. */ diff --git a/lib/stdint.in.h b/lib/stdint.in.h index 5fbec34310..df8b37d3d4 100644 --- a/lib/stdint.in.h +++ b/lib/stdint.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* * ISO C 99 for platforms that lack it. diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index d5b5943fd7..0d606c19c8 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Many stdio implementations have the same logic and therefore can share the same implementation of stdio extension API, except that some fields diff --git a/lib/stdio.in.h b/lib/stdio.in.h index b714c54a54..5cf31319d9 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index ef41c992df..d5fa02b57a 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/stpcpy.c b/lib/stpcpy.c index 154d95f89e..079599db86 100644 --- a/lib/stpcpy.c +++ b/lib/stpcpy.c @@ -16,7 +16,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/strftime.h b/lib/strftime.h index 27a8d62412..9d91e5139c 100644 --- a/lib/strftime.h +++ b/lib/strftime.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/string.in.h b/lib/string.in.h index aaff5638d0..0e0e0c51f5 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/strtoimax.c b/lib/strtoimax.c index 3f31fe913a..f7d46f040d 100644 --- a/lib/strtoimax.c +++ b/lib/strtoimax.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/strtol.c b/lib/strtol.c index 751d1e0f1e..1ef88700fc 100644 --- a/lib/strtol.c +++ b/lib/strtol.c @@ -17,7 +17,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifdef _LIBC # define USE_NUMBER_GROUPING diff --git a/lib/strtoll.c b/lib/strtoll.c index d770e81db3..f6952f3cd2 100644 --- a/lib/strtoll.c +++ b/lib/strtoll.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #define QUAD 1 diff --git a/lib/symlink.c b/lib/symlink.c index 60d4c14fea..427f1f5f00 100644 --- a/lib/symlink.c +++ b/lib/symlink.c @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #include diff --git a/lib/sys_select.in.h b/lib/sys_select.in.h index 616e77dd4c..3bda212227 100644 --- a/lib/sys_select.in.h +++ b/lib/sys_select.in.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ # if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h index 1831740900..f0919e90d5 100644 --- a/lib/sys_stat.in.h +++ b/lib/sys_stat.in.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Eric Blake, Paul Eggert, and Jim Meyering. */ diff --git a/lib/sys_time.in.h b/lib/sys_time.in.h index 57739bc4c5..8a3c87d11d 100644 --- a/lib/sys_time.in.h +++ b/lib/sys_time.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/sys_types.in.h b/lib/sys_types.in.h index 3cea44884e..b0d6132a16 100644 --- a/lib/sys_types.in.h +++ b/lib/sys_types.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/tempname.c b/lib/tempname.c index c274b8dd4e..2e3f95f3fb 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Extracted from glibc sysdeps/posix/tempname.c. See also tmpdir.c. */ diff --git a/lib/tempname.h b/lib/tempname.h index 1ca97484fb..245c8161ab 100644 --- a/lib/tempname.h +++ b/lib/tempname.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* header written by Eric Blake */ diff --git a/lib/time-internal.h b/lib/time-internal.h index bf22834b2e..8caf11d874 100644 --- a/lib/time-internal.h +++ b/lib/time-internal.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/time.in.h b/lib/time.in.h index f0c7ef8666..d210fbf80b 100644 --- a/lib/time.in.h +++ b/lib/time.in.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #if __GNUC__ >= 3 @PRAGMA_SYSTEM_HEADER@ diff --git a/lib/time_r.c b/lib/time_r.c index 708a98b324..8cf8329fe5 100644 --- a/lib/time_r.c +++ b/lib/time_r.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/time_rz.c b/lib/time_rz.c index 17bc11c20e..ad02edb23c 100644 --- a/lib/time_rz.c +++ b/lib/time_rz.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along - with this program; if not, see . */ + with this program; if not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/timegm.c b/lib/timegm.c index 957a3b830c..1cabf64826 100644 --- a/lib/timegm.c +++ b/lib/timegm.c @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _LIBC # include diff --git a/lib/timespec-add.c b/lib/timespec-add.c index e6c87c6568..faa4582944 100644 --- a/lib/timespec-add.c +++ b/lib/timespec-add.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/timespec-sub.c b/lib/timespec-sub.c index 5d9276dd0f..3872f1bc2d 100644 --- a/lib/timespec-sub.c +++ b/lib/timespec-sub.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/timespec.h b/lib/timespec.h index f5d823aefe..3831301578 100644 --- a/lib/timespec.h +++ b/lib/timespec.h @@ -14,7 +14,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #if ! defined TIMESPEC_H # define TIMESPEC_H diff --git a/lib/u64.h b/lib/u64.h index a8601932a1..f56cc38233 100644 --- a/lib/u64.h +++ b/lib/u64.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/unistd.in.h b/lib/unistd.in.h index f366caffa5..8a383b3d01 100644 --- a/lib/unistd.in.h +++ b/lib/unistd.in.h @@ -12,7 +12,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, see . */ + along with this program; if not, see . */ #ifndef _@GUARD_PREFIX@_UNISTD_H diff --git a/lib/unlocked-io.h b/lib/unlocked-io.h index aaf60a0fb4..be5d2b5d84 100644 --- a/lib/unlocked-io.h +++ b/lib/unlocked-io.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Jim Meyering. */ diff --git a/lib/utimens.c b/lib/utimens.c index ff4eab073c..a5716ac810 100644 --- a/lib/utimens.c +++ b/lib/utimens.c @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/utimens.h b/lib/utimens.h index 4d9c18edad..f1dd9884dc 100644 --- a/lib/utimens.h +++ b/lib/utimens.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert. */ diff --git a/lib/verify.h b/lib/verify.h index dcba9c8cb0..e0b4861337 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* Written by Paul Eggert, Bruno Haible, and Jim Meyering. */ diff --git a/lib/vla.h b/lib/vla.h index 5bbf56bb39..59de9a6bcd 100644 --- a/lib/vla.h +++ b/lib/vla.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . + along with this program. If not, see . Written by Paul Eggert. */ diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h index 3c0eb579fa..cae8c3eec5 100644 --- a/lib/warn-on-use.h +++ b/lib/warn-on-use.h @@ -12,7 +12,7 @@ General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ /* _GL_WARN_ON_USE (function, "literal string") issues a declaration for FUNCTION which will then trigger a compiler warning containing diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index 2e09bab0be..ae4fbc77f9 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -13,7 +13,7 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program. If not, see . */ + along with this program. If not, see . */ #ifndef XALLOC_OVERSIZED_H_ #define XALLOC_OVERSIZED_H_ diff --git a/m4/getgroups.m4 b/m4/getgroups.m4 index 02ce2353ca..17f7409944 100644 --- a/m4/getgroups.m4 +++ b/m4/getgroups.m4 @@ -12,7 +12,7 @@ dnl A wrapper around AC_FUNC_GETGROUPS. m4_version_prereq([2.70], [] ,[ # This is taken from the following Autoconf patch: -# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9 +# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=7fbb553727ed7e0e689a17594b58559ecf3ea6e9 AC_DEFUN([AC_FUNC_GETGROUPS], [ AC_REQUIRE([AC_TYPE_GETGROUPS])dnl diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 13504a8ca2..c5517529f0 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -12,7 +12,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this file. If not, see . +# along with this file. If not, see . # # As a special exception to the GNU General Public License, # this file may be distributed as part of a program that diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4 index 9dae9b1ccf..bd34aa1a26 100644 --- a/m4/std-gnu11.m4 +++ b/m4/std-gnu11.m4 @@ -20,7 +20,7 @@ # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License -# along with this program. If not, see . +# along with this program. If not, see . # Written by David MacKenzie, with help from # Akim Demaille, Paul Eggert, diff --git a/m4/stdalign.m4 b/m4/stdalign.m4 index 0652a1e4af..f091aa58c2 100644 --- a/m4/stdalign.m4 +++ b/m4/stdalign.m4 @@ -18,7 +18,7 @@ AC_DEFUN([gl_STDALIGN_H], /* Test that alignof yields a result consistent with offsetof. This catches GCC bug 52023 - . */ + . */ #ifdef __cplusplus template struct alignof_helper { char a; t b; }; # define ao(type) offsetof (alignof_helper, b) commit 4bef92e9e02d074de1d92e30dc5ef4dd62558c80 Author: Dmitry Gutov Date: Wed Sep 13 02:30:45 2017 +0300 Call vc-resynch-buffer in vc-git-resolve-when-done * lisp/vc/vc-git.el (vc-git-resolve-when-done): Call vc-resynch-buffer on the current file (bug#28121). Move its autoload to before this function. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index cc3e295641..71cf57ab32 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -951,6 +951,10 @@ This prompts for a branch to merge from." "DU" "AA" "UU")) (push (expand-file-name file directory) files))))))) +;; Everywhere but here, follows vc-git-command, which uses vc-do-command +;; from vc-dispatcher. +(autoload 'vc-resynch-buffer "vc-dispatcher") + (defun vc-git-resolve-when-done () "Call \"git add\" if the conflict markers have been removed." (save-excursion @@ -964,6 +968,7 @@ This prompts for a branch to merge from." (vc-git-root buffer-file-name))) (vc-git-conflicted-files (vc-git-root buffer-file-name))) (vc-git-command nil 0 nil "reset")) + (vc-resynch-buffer buffer-file-name t t) ;; Remove the hook so that it is not called multiple times. (remove-hook 'after-save-hook 'vc-git-resolve-when-done t)))) @@ -1450,10 +1455,6 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (if (eq next-error-last-buffer (current-buffer)) (setq default-directory dir)))))) -;; Everywhere but here, follows vc-git-command, which uses vc-do-command -;; from vc-dispatcher. -(autoload 'vc-resynch-buffer "vc-dispatcher") - (defun vc-git-stash (name) "Create a stash." (interactive "sStash name: ") commit 9b980e2691afa3a7a967011fc004d352750fe618 Author: Eric Abrahamsen Date: Tue Sep 12 16:06:12 2017 -0700 Allow write-contents-functions to short-circuit buffer save Bug#28412 * lisp/files.el (basic-save-buffer): Re-arrange function so that write-contents-functions are run earlier. If they return non-nil, consider the buffer saved without requiring the buffer to be visiting a file. (save-some-buffers): This function should consider any buffer with a buffer-local value for write-contents-functions eligible for saving. * test/lisp/files-tests.el (files-test-no-file-write-contents): New test. * doc/lispref/files.texi (Saving Buffers): Mention in docs. * etc/NEWS: And in NEWS. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 901382fe9b..6be998f0b2 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -457,15 +457,23 @@ Even though this is not a normal hook, you can use @code{add-hook} and @defvar write-contents-functions This works just like @code{write-file-functions}, but it is intended for hooks that pertain to the buffer's contents, not to the particular -visited file or its location. Such hooks are usually set up by major -modes, as buffer-local bindings for this variable. This variable -automatically becomes buffer-local whenever it is set; switching to a -new major mode always resets this variable, but calling -@code{set-visited-file-name} does not. +visited file or its location, and can be used to create arbitrary save +processes for buffers that aren't visiting files at all. Such hooks +are usually set up by major modes, as buffer-local bindings for this +variable. This variable automatically becomes buffer-local whenever +it is set; switching to a new major mode always resets this variable, +but calling @code{set-visited-file-name} does not. If any of the functions in this hook returns non-@code{nil}, the file is considered already written and the rest are not called and neither are the functions in @code{write-file-functions}. + +When using this hook to save buffers that are not visiting files (for +instance, special-mode buffers), keep in mind that, if the function +fails to save correctly and returns a @code{nil} value, +@code{save-buffer} will go on to prompt the user for a file to save +the buffer in. If this is undesirable, consider having the function +fail by raising an error. @end defvar @defopt before-save-hook diff --git a/etc/NEWS b/etc/NEWS index 03ef05b2a3..9467369709 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -108,6 +108,14 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 ++++ +** Functions in 'write-contents-functions' can fully short-circuit the +'save-buffer' process. Previously, saving a buffer that was not +visiting a file would always prompt for a file name. Now it only does +so if 'write-contents-functions' is nil (or all its functions return +nil). A non-nil buffer-local value for this variable is sufficient +for 'save-some-buffers' to consider the buffer for saving. + --- ** New variable 'executable-prefix-env' for inserting magic signatures. This variable affects the format of the interpreter magic number diff --git a/lisp/files.el b/lisp/files.el index de9fab8d32..72ace24644 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -517,10 +517,12 @@ updates before the buffer is saved, use `before-save-hook'.") 'write-contents-functions "22.1") (defvar write-contents-functions nil "List of functions to be called before writing out a buffer to a file. -Only used by `save-buffer'. -If one of them returns non-nil, the file is considered already written -and the rest are not called and neither are the functions in -`write-file-functions'. + +Only used by `save-buffer'. If one of them returns non-nil, the +file is considered already written and the rest are not called +and neither are the functions in `write-file-functions'. This +hook can thus be used to create save behavior for buffers that +are not visiting a file at all. This variable is meant to be used for hooks that pertain to the buffer's contents, not to the particular visited file; thus, @@ -4875,9 +4877,12 @@ in such cases.") (defun basic-save-buffer (&optional called-interactively) "Save the current buffer in its visited file, if it has been modified. -The hooks `write-contents-functions' and `write-file-functions' get a chance -to do the job of saving; if they do not, then the buffer is saved in -the visited file in the usual way. + +The hooks `write-contents-functions', `local-write-file-hooks' +and `write-file-functions' get a chance to do the job of saving; +if they do not, then the buffer is saved in the visited file in +the usual way. + Before and after saving the buffer, this function runs `before-save-hook' and `after-save-hook', respectively." (interactive '(called-interactively)) @@ -4886,29 +4891,14 @@ Before and after saving the buffer, this function runs (if (buffer-base-buffer) (set-buffer (buffer-base-buffer))) (if (or (buffer-modified-p) - ;; handle the case when no modification has been made but - ;; the file disappeared since visited + ;; Handle the case when no modification has been made but + ;; the file disappeared since visited. (and buffer-file-name (not (file-exists-p buffer-file-name)))) (let ((recent-save (recent-auto-save-p)) setmodes) - ;; If buffer has no file name, ask user for one. - (or buffer-file-name - (let ((filename - (expand-file-name - (read-file-name "File to save in: " - nil (expand-file-name (buffer-name)))))) - (if (file-exists-p filename) - (if (file-directory-p filename) - ;; Signal an error if the user specified the name of an - ;; existing directory. - (error "%s is a directory" filename) - (unless (y-or-n-p (format-message - "File `%s' exists; overwrite? " - filename)) - (error "Canceled")))) - (set-visited-file-name filename))) - (or (verify-visited-file-modtime (current-buffer)) + (or (null buffer-file-name) + (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) (yes-or-no-p (format @@ -4920,6 +4910,7 @@ Before and after saving the buffer, this function runs (save-excursion (and (> (point-max) (point-min)) (not find-file-literally) + (null buffer-read-only) (/= (char-after (1- (point-max))) ?\n) (not (and (eq selective-display t) (= (char-after (1- (point-max))) ?\r))) @@ -4932,46 +4923,65 @@ Before and after saving the buffer, this function runs (save-excursion (goto-char (point-max)) (insert ?\n)))) - ;; Support VC version backups. - (vc-before-save) ;; Don't let errors prevent saving the buffer. (with-demoted-errors (run-hooks 'before-save-hook)) - (or (run-hook-with-args-until-success 'write-contents-functions) - (run-hook-with-args-until-success 'local-write-file-hooks) - (run-hook-with-args-until-success 'write-file-functions) - ;; If a hook returned t, file is already "written". - ;; Otherwise, write it the usual way now. - (let ((dir (file-name-directory - (expand-file-name buffer-file-name)))) - (unless (file-exists-p dir) - (if (y-or-n-p - (format-message - "Directory `%s' does not exist; create? " dir)) - (make-directory dir t) - (error "Canceled"))) - (setq setmodes (basic-save-buffer-1)))) + ;; Give `write-contents-functions' a chance to + ;; short-circuit the whole process. + (unless (run-hook-with-args-until-success 'write-contents-functions) + ;; If buffer has no file name, ask user for one. + (or buffer-file-name + (let ((filename + (expand-file-name + (read-file-name "File to save in: " + nil (expand-file-name (buffer-name)))))) + (if (file-exists-p filename) + (if (file-directory-p filename) + ;; Signal an error if the user specified the name of an + ;; existing directory. + (error "%s is a directory" filename) + (unless (y-or-n-p (format-message + "File `%s' exists; overwrite? " + filename)) + (error "Canceled")))) + (set-visited-file-name filename))) + ;; Support VC version backups. + (vc-before-save) + (or (run-hook-with-args-until-success 'local-write-file-hooks) + (run-hook-with-args-until-success 'write-file-functions) + ;; If a hook returned t, file is already "written". + ;; Otherwise, write it the usual way now. + (let ((dir (file-name-directory + (expand-file-name buffer-file-name)))) + (unless (file-exists-p dir) + (if (y-or-n-p + (format-message + "Directory `%s' does not exist; create? " dir)) + (make-directory dir t) + (error "Canceled"))) + (setq setmodes (basic-save-buffer-1))))) ;; Now we have saved the current buffer. Let's make sure ;; that buffer-file-coding-system is fixed to what ;; actually used for saving by binding it locally. - (if save-buffer-coding-system - (setq save-buffer-coding-system last-coding-system-used) - (setq buffer-file-coding-system last-coding-system-used)) - (setq buffer-file-number - (nthcdr 10 (file-attributes buffer-file-name))) - (if setmodes - (condition-case () - (progn - (unless - (with-demoted-errors - (set-file-modes buffer-file-name (car setmodes))) - (set-file-extended-attributes buffer-file-name - (nth 1 setmodes)))) - (error nil)))) - ;; If the auto-save file was recent before this command, - ;; delete it now. - (delete-auto-save-file-if-necessary recent-save) - ;; Support VC `implicit' locking. - (vc-after-save) + (when buffer-file-name + (if save-buffer-coding-system + (setq save-buffer-coding-system last-coding-system-used) + (setq buffer-file-coding-system last-coding-system-used)) + (setq buffer-file-number + (nthcdr 10 (file-attributes buffer-file-name))) + (if setmodes + (condition-case () + (progn + (unless + (with-demoted-errors + (set-file-modes buffer-file-name (car setmodes))) + (set-file-extended-attributes buffer-file-name + (nth 1 setmodes)))) + (error nil))) + ;; Support VC `implicit' locking. + (vc-after-save)) + ;; If the auto-save file was recent before this command, + ;; delete it now. + (delete-auto-save-file-if-necessary recent-save)) (run-hooks 'after-save-hook)) (or noninteractive (not called-interactively) @@ -5183,7 +5193,9 @@ change the additional actions you can take on files." (and pred (progn (set-buffer buffer) - (and buffer-offer-save (> (buffer-size) 0))))) + (and buffer-offer-save (> (buffer-size) 0)))) + (buffer-local-value + 'write-contents-functions buffer)) (or (not (functionp pred)) (with-current-buffer buffer (funcall pred))) (if arg diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index b52965a02b..c6806cdb58 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -365,6 +365,33 @@ be invoked with the right arguments." (should-error (make-directory a/b)) (should-not (make-directory a/b t)))) +(ert-deftest files-test-no-file-write-contents () + "Test that `write-contents-functions' permits saving a file. +Usually `basic-save-buffer' will prompt for a file name if the +current buffer has none. It should first call the functions in +`write-contents-functions', and if one of them returns non-nil, +consider the buffer saved, without prompting for a file +name (Bug#28412)." + (let ((read-file-name-function + (lambda (&rest _ignore) + (error "Prompting for file name")))) + ;; With contents function, and no file. + (with-temp-buffer + (setq write-contents-functions (lambda () t)) + (set-buffer-modified-p t) + (should (null (save-buffer)))) + ;; With no contents function and no file. This should reach the + ;; `read-file-name' prompt. + (with-temp-buffer + (set-buffer-modified-p t) + (should-error (save-buffer) :type 'error)) + ;; Then a buffer visiting a file: should save normally. + (files-tests--with-temp-file temp-file-name + (with-current-buffer (find-file-noselect temp-file-name) + (setq write-contents-functions nil) + (insert "p") + (should (null (save-buffer))) + (should (eq (buffer-size) 1)))))) (provide 'files-tests) ;;; files-tests.el ends here commit d07fd34722b84ae2c407f195c82d7632a94de704 Author: Paul Eggert Date: Tue Sep 12 12:55:29 2017 -0700 * etc/NEWS.25: Copy from emacs-25 etc/NEWS. diff --git a/etc/NEWS.25 b/etc/NEWS.25 index db448fd61a..be04b5fcdc 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -18,33 +18,28 @@ with a prefix argument or by typing C-u C-h C-n. * Changes in Emacs 25.3 -This is mainly a release to fix security-relevant bugs. +This is an emergency release to fix a security vulnerability in Emacs. -** Enriched text mode no longer supports the 'FUNCTION' and 'display' -translations, and Gnus no longer processes enriched text when -inlining. This fixes bugs introduced in Emacs 19.29. To work around -these bugs in Emacs versions 19.29 through 25.2, append the following -to your ~/.emacs file: +** Security vulnerability related to Enriched Text mode is removed. - (provide 'enriched) - (defun enriched-mode (&optional arg)) - (defun enriched-decode (from to)) +*** Enriched Text mode has its support for decoding 'x-display' disabled. +This feature allows saving 'display' properties as part of text. +Emacs 'display' properties support evaluation of arbitrary Lisp forms +as part of instantiating the property, so decoding 'x-display' is +vulnerable to executing arbitrary malicious Lisp code included in the +text (e.g., sent as part of an email message). -Thanks to Charles A. Roelli for reporting this bug; see: -https://bugs.gnu.org/28350 +This vulnerability was introduced in Emacs 21.1. To work around that +in Emacs versions before 25.3, append the following to your ~/.emacs +init file: -** TLS/SSL connections no longer fall back on the openssl s_client -command to set up SSL connections in some hopefully-unlikely cases. -This fixes a bug introduced in Emacs 22.1. To work around this bug in -Emacs versions 22.1 through 25.2, append the following to your -~/.emacs file: + (eval-after-load "enriched" + '(defun enriched-decode-display-prop (start end &optional param) + (list start end))) - (setq tls-program '("gnutls-cli --x509cafile %t -p %p %h")) - -You may need to omit the "--x509cafile %t" on older installations. - -Thanks to Kurt Roeckx for reporting this bug to Debian; see: -https://bugs.debian.org/766397 +*** Gnus no longer supports "richtext" and "enriched" inline MIME objects. +This support was disabled to avoid evaluation of arbitrary Lisp code +contained in email messages and news articles. * Changes in Emacs 25.2 commit cb80fd0d5009f4ae246a55a5504173c08215eaa7 Author: Paul Eggert Date: Tue Sep 12 12:17:41 2017 -0700 Less chatter for ’make info/dir’ * Makefile.in (${srcdir}/info/dir): Tweak shell command so that an ordinary make says just "GEN info/dir" rather than also having a seemingly-unrelated mv line. diff --git a/Makefile.in b/Makefile.in index 8a08465c4a..d286c597af 100644 --- a/Makefile.in +++ b/Makefile.in @@ -991,8 +991,7 @@ ${srcdir}/info/dir: ${info_dir_deps} $(AM_V_at)${MKDIR_P} ${srcdir}/info $(AM_V_GEN)(cd ${srcdir}/doc && \ AWK='${AWK}' ../build-aux/make-info-dir ${info_dir_inputs} \ - ) >$@.tmp - mv $@.tmp $@ + ) >$@.tmp && mv $@.tmp $@ INSTALL_DVI = install-emacs-dvi install-lispref-dvi \ install-lispintro-dvi install-misc-dvi commit 7aa49c2952d4aff6dba3a00dcd4624b090c848a8 Author: Paul Eggert Date: Tue Sep 12 12:15:22 2017 -0700 Tweak Gnus doc re gnus-copy-file * doc/misc/gnus.texi (Saving Articles): Document behavior with directory name targets (Bug#27986). Problem reported by Katsumi Yamaoka in: http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00216.html diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 3e9b48ec65..b002f5dea7 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -7759,7 +7759,9 @@ processing of the article is done before it is saved). For a different approach (uudecoding, unsharing) you should use @code{gnus-uu} (@pxref{Decoding Articles}). -For the commands listed here, the target is a file. If you want to +For the commands listed here, the target is a file. +A directory name (ending in @samp{/}) causes the target +to be a file under that directory. If you want to save to a group, see the @kbd{B c} (@code{gnus-summary-copy-article}) command (@pxref{Mail Group Commands}). commit 370d0e7aa7309b25fb9e974164261077b326e8e2 Author: Mark Oteiza Date: Tue Sep 12 13:08:47 2017 -0400 Update uses of if-let and when-let * lisp/dom.el (dom-previous-sibling): * lisp/emacs-lisp/package.el (package--with-work-buffer): (package--sort-deps-in-alist, package--sort-by-dependence): (package-install-from-archive, package-install): (package-menu-execute, package-menu--populate-new-package-list): * lisp/filenotify.el (file-notify--rm-descriptor): (file-notify--event-watched-file, file-notify--event-file-name): (file-notify--event-file1-name, file-notify-rm-watch): (file-notify-valid-p): * lisp/gnus/message.el (message-toggle-image-thumbnails): * lisp/gnus/nnimap.el (nnimap-request-move-article): * lisp/ibuf-ext.el (ibuffer-repair-saved-filters): * lisp/mpc.el (mpc-format): * lisp/net/eww.el (eww-tag-meta, eww-process-text-input): (eww-save-history): * lisp/net/shr.el (shr-tag-base, shr-tag-object, shr-make-table-1): * lisp/progmodes/prog-mode.el (prettify-symbols--post-command-hook): * lisp/svg.el (svg-remove): * lisp/textmodes/css-mode.el (css--named-color): (css--colon-inside-funcall): * lisp/textmodes/sgml-mode.el (html-current-buffer-classes): (html-current-buffer-ids): Use if-let* and when-let* instead. diff --git a/lisp/dom.el b/lisp/dom.el index 4d0d4233db..52e7f4baf1 100644 --- a/lisp/dom.el +++ b/lisp/dom.el @@ -162,7 +162,7 @@ ATTRIBUTE would typically be `class', `id' or the like." (defun dom-previous-sibling (dom node) "Return the previous sibling of NODE in DOM." - (when-let (parent (dom-parent dom node)) + (when-let* ((parent (dom-parent dom node))) (let ((siblings (dom-children parent)) (previous nil)) (while siblings diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 889d7943c9..7301dbd61d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1192,7 +1192,7 @@ errors signaled by ERROR-FORM or by BODY). (let ((,b-sym (current-buffer))) (require 'url-handlers) (unless-error ,body - (when-let ((er (plist-get status :error))) + (when-let* ((er (plist-get status :error))) (error "Error retrieving: %s %S" ,url-sym er)) (with-current-buffer ,b-sym (goto-char (point-min)) @@ -1770,8 +1770,8 @@ Only these packages will be in the return value an their cdrs are destructively set to nil in ONLY." (let ((out)) (dolist (dep (package-desc-reqs package)) - (when-let ((cell (assq (car dep) only)) - (dep-package (cdr-safe cell))) + (when-let* ((cell (assq (car dep) only)) + (dep-package (cdr-safe cell))) (setcdr cell nil) (setq out (append (package--sort-deps-in-alist dep-package only) out)))) @@ -1790,7 +1790,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." (dolist (cell alist out-list) ;; `package--sort-deps-in-alist' destructively changes alist, so ;; some cells might already be empty. We check this here. - (when-let ((pkg-desc (cdr cell))) + (when-let* ((pkg-desc (cdr cell))) (setcdr cell nil) (setq out-list (append (package--sort-deps-in-alist pkg-desc alist) @@ -1847,7 +1847,7 @@ if all the in-between dependencies are also in PACKAGE-LIST." ;; Update the old pkg-desc which will be shown on the description buffer. (setf (package-desc-signed pkg-desc) t) ;; Update the new (activated) pkg-desc as well. - (when-let ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) + (when-let* ((pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))) (setf (package-desc-signed (car pkg-descs)) t)))))))))) (defun package-installed-p (package &optional min-version) @@ -1970,12 +1970,12 @@ to install it but still mark it as selected." (unless (or dont-select (package--user-selected-p name)) (package--save-selected-packages (cons name package-selected-packages))) - (if-let ((transaction - (if (package-desc-p pkg) - (unless (package-installed-p pkg) - (package-compute-transaction (list pkg) - (package-desc-reqs pkg))) - (package-compute-transaction () (list (list pkg)))))) + (if-let* ((transaction + (if (package-desc-p pkg) + (unless (package-installed-p pkg) + (package-compute-transaction (list pkg) + (package-desc-reqs pkg))) + (package-compute-transaction () (list (list pkg)))))) (package-download-transaction transaction) (message "`%s' is already installed" name)))) @@ -3281,7 +3281,7 @@ Optional argument NOQUERY non-nil means do not ask the user to confirm." (package--update-selected-packages .install .delete) (package-menu--perform-transaction install-list delete-list) (when package-selected-packages - (if-let ((removable (package--removable-packages))) + (if-let* ((removable (package--removable-packages))) (message "Package menu: Operation finished. %d packages %s" (length removable) (substitute-command-keys @@ -3353,7 +3353,7 @@ Store this list in `package-menu--new-package-list'." (defun package-menu--find-and-notify-upgrades () "Notify the user of upgradable packages." - (when-let ((upgrades (package-menu--find-upgrades))) + (when-let* ((upgrades (package-menu--find-upgrades))) (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." (length upgrades) (if (= (length upgrades) 1) "" "s") diff --git a/lisp/filenotify.el b/lisp/filenotify.el index 64cfab143e..6a3b9e1743 100644 --- a/lisp/filenotify.el +++ b/lisp/filenotify.el @@ -71,7 +71,7 @@ struct.") "Remove DESCRIPTOR from `file-notify-descriptors'. DESCRIPTOR should be an object returned by `file-notify-add-watch'. If it is registered in `file-notify-descriptors', a stopped event is sent." - (when-let (watch (gethash descriptor file-notify-descriptors)) + (when-let* ((watch (gethash descriptor file-notify-descriptors))) ;; Send `stopped' event. (unwind-protect (funcall @@ -106,12 +106,12 @@ It is a form ((DESCRIPTOR ACTION FILE [FILE1-OR-COOKIE]) CALLBACK).") (defun file-notify--event-watched-file (event) "Return file or directory being watched. Could be different from the directory watched by the backend library." - (when-let (watch (gethash (car event) file-notify-descriptors)) + (when-let* ((watch (gethash (car event) file-notify-descriptors))) (file-notify--watch-absolute-filename watch))) (defun file-notify--event-file-name (event) "Return file name of file notification event, or nil." - (when-let (watch (gethash (car event) file-notify-descriptors)) + (when-let* ((watch (gethash (car event) file-notify-descriptors))) (directory-file-name (expand-file-name (or (and (stringp (nth 2 event)) (nth 2 event)) "") @@ -121,7 +121,7 @@ Could be different from the directory watched by the backend library." (defun file-notify--event-file1-name (event) "Return second file name of file notification event, or nil. This is available in case a file has been moved." - (when-let (watch (gethash (car event) file-notify-descriptors)) + (when-let* ((watch (gethash (car event) file-notify-descriptors))) (and (stringp (nth 3 event)) (directory-file-name (expand-file-name @@ -375,7 +375,7 @@ FILE is the name of the file whose event is being reported." (defun file-notify-rm-watch (descriptor) "Remove an existing watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." - (when-let (watch (gethash descriptor file-notify-descriptors)) + (when-let* ((watch (gethash descriptor file-notify-descriptors))) (let ((handler (find-file-name-handler (file-notify--watch-directory watch) 'file-notify-rm-watch))) @@ -399,7 +399,7 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'." (defun file-notify-valid-p (descriptor) "Check a watch specified by its DESCRIPTOR. DESCRIPTOR should be an object returned by `file-notify-add-watch'." - (when-let (watch (gethash descriptor file-notify-descriptors)) + (when-let* ((watch (gethash descriptor file-notify-descriptors))) (let ((handler (find-file-name-handler (file-notify--watch-directory watch) 'file-notify-valid-p))) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 996b0ac5af..214cf61e84 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8410,7 +8410,7 @@ Used in `message-simplify-recipients'." (save-excursion (goto-char (point-min)) (while (not (eobp)) - (when-let ((props (get-text-property (point) 'display))) + (when-let* ((props (get-text-property (point) 'display))) (when (and (consp props) (eq (car props) 'image)) (put-text-property (point) (1+ (point)) 'display nil) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 2943c8dc7d..6424d9d780 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -950,7 +950,7 @@ textual parts.") internal-move-group server message-id nnimap-request-articles-find-limit))))) ;; Move the article to a different method. - (when-let ((result (eval accept-form))) + (when-let* ((result (eval accept-form))) (nnimap-change-group group server) (nnimap-delete-article article) result)))))) diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 2a68f777d9..8bcd18864c 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -375,7 +375,7 @@ format. See `ibuffer-update-saved-filters-format' and (let ((fixed (ibuffer-update-saved-filters-format ibuffer-saved-filters))) (prog1 (setq ibuffer-saved-filters (cdr fixed)) - (when-let (old-format-detected (car fixed)) + (when-let* ((old-format-detected (car fixed))) (let ((warning-series t) (updated-form (with-output-to-string diff --git a/lisp/mpc.el b/lisp/mpc.el index cce752739b..73692e228f 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1029,12 +1029,12 @@ If PLAYLIST is t or nil or missing, use the main playlist." (let ((dir (file-name-directory (cdr (assq 'file info))))) ;; (debug) (push `(equal ',dir (file-name-directory (cdr (assq 'file info)))) pred) - (if-let ((covers '(".folder.png" "cover.jpg" "folder.jpg")) - (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir)) - if (member (downcase file) covers) - return (concat dir file))) - (file (with-demoted-errors "MPC: %s" - (mpc-file-local-copy cover)))) + (if-let* ((covers '(".folder.png" "cover.jpg" "folder.jpg")) + (cover (cl-loop for file in (directory-files (mpc-file-local-copy dir)) + if (member (downcase file) covers) + return (concat dir file))) + (file (with-demoted-errors "MPC: %s" + (mpc-file-local-copy cover)))) (let (image) (if (null size) (setq image (create-image file)) (let ((tempfile (make-temp-file "mpc" nil ".jpg"))) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 03d9172b65..2938e35dd5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -521,7 +521,7 @@ Currently this means either text/html or application/xhtml+xml." (defun eww-tag-meta (dom) (when (and (cl-equalp (dom-attr dom 'http-equiv) "refresh") (< eww-redirect-level 5)) - (when-let (refresh (dom-attr dom 'content)) + (when-let* ((refresh (dom-attr dom 'content))) (when (or (string-match "^\\([0-9]+\\) *;.*url=\"\\([^\"]+\\)\"" refresh) (string-match "^\\([0-9]+\\) *;.*url='\\([^']+\\)'" refresh) (string-match "^\\([0-9]+\\) *;.*url=\\([^ ]+\\)" refresh)) @@ -1110,13 +1110,13 @@ just re-display the HTML already fetched." See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (defun eww-process-text-input (beg end replace-length) - (when-let (pos (and (< (1+ end) (point-max)) - (> (1- end) (point-min)) - (cond - ((get-text-property (1+ end) 'eww-form) - (1+ end)) - ((get-text-property (1- end) 'eww-form) - (1- end))))) + (when-let* ((pos (and (< (1+ end) (point-max)) + (> (1- end) (point-min)) + (cond + ((get-text-property (1+ end) 'eww-form) + (1+ end)) + ((get-text-property (1- end) 'eww-form) + (1- end)))))) (let* ((form (get-text-property pos 'eww-form)) (properties (text-properties-at pos)) (buffer-undo-list t) @@ -1799,8 +1799,8 @@ If CHARSET is nil then use UTF-8." (setq eww-data (list :title "")) ;; Don't let the history grow infinitely. We store quite a lot of ;; data per page. - (when-let (tail (and eww-history-limit - (nthcdr eww-history-limit eww-history))) + (when-let* ((tail (and eww-history-limit + (nthcdr eww-history-limit eww-history)))) (setcdr tail nil))) (defvar eww-current-buffer) diff --git a/lisp/net/shr.el b/lisp/net/shr.el index fe93fc32ad..cb915da1c1 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -1363,7 +1363,7 @@ ones, in case fg and bg are nil." plist))) (defun shr-tag-base (dom) - (when-let (base (dom-attr dom 'href)) + (when-let* ((base (dom-attr dom 'href))) (setq shr-base (shr-parse-base base))) (shr-generic dom)) @@ -1388,7 +1388,7 @@ ones, in case fg and bg are nil." (unless shr-inhibit-images (let ((start (point)) url multimedia image) - (when-let (type (dom-attr dom 'type)) + (when-let* ((type (dom-attr dom 'type))) (when (string-match "\\`image/svg" type) (setq url (dom-attr dom 'data) image t))) @@ -2178,7 +2178,7 @@ flags that control whether to collect or render objects." (when (and (not (stringp column)) (or (memq (dom-tag column) '(td th)) (not column))) - (when-let (span (dom-attr column 'rowspan)) + (when-let* ((span (dom-attr column 'rowspan))) (aset rowspans i (+ (aref rowspans i) (1- (string-to-number span))))) ;; Sanity check for invalid column-spans. diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index 8f66f1c954..eddaa89ef9 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -225,11 +225,11 @@ on the symbol." (apply #'font-lock-flush prettify-symbols--current-symbol-bounds) (setq prettify-symbols--current-symbol-bounds nil)) ;; Unprettify the current symbol. - (when-let ((c (get-prop-as-list 'composition)) - (s (get-prop-as-list 'prettify-symbols-start)) - (e (get-prop-as-list 'prettify-symbols-end)) - (s (apply #'min s)) - (e (apply #'max e))) + (when-let* ((c (get-prop-as-list 'composition)) + (s (get-prop-as-list 'prettify-symbols-start)) + (e (get-prop-as-list 'prettify-symbols-end)) + (s (apply #'min s)) + (e (apply #'max e))) (with-silent-modifications (setq prettify-symbols--current-symbol-bounds (list s e)) (remove-text-properties s e '(composition)))))) diff --git a/lisp/svg.el b/lisp/svg.el index fc1a6d60e1..8310eba629 100644 --- a/lisp/svg.el +++ b/lisp/svg.el @@ -264,10 +264,10 @@ If the SVG is later changed, the image will also be updated." (defun svg-remove (svg id) "Remove the element identified by ID from SVG." - (when-let ((node (car (dom-by-id - svg - (concat "\\`" (regexp-quote id) - "\\'"))))) + (when-let* ((node (car (dom-by-id + svg + (concat "\\`" (regexp-quote id) + "\\'"))))) (dom-remove-node svg node))) (provide 'svg) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 1e49ca81fc..44ba870662 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1045,7 +1045,7 @@ This function simply drops any transparency." "Check whether STR, seen at point, is CSS named color. Returns STR if it is a valid color. Special care is taken to exclude some SCSS constructs." - (when-let ((color (assoc str css--color-map))) + (when-let* ((color (assoc str css--color-map))) (save-excursion (goto-char start-point) (forward-comment (- (point))) @@ -1154,7 +1154,7 @@ for determining whether point is within a selector." (defun css--colon-inside-funcall () "Return t if point is inside a function call." - (when-let (opening-paren-pos (nth 1 (syntax-ppss))) + (when-let* ((opening-paren-pos (nth 1 (syntax-ppss)))) (save-excursion (goto-char opening-paren-pos) (eq (char-after) ?\()))) diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 1f99786ae7..78fbbb5936 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -2242,8 +2242,8 @@ The result is cached in `html--buffer-classes-cache'." (classes (seq-mapcat (lambda (el) - (when-let (class-list - (cdr (assq 'class (dom-attributes el)))) + (when-let* ((class-list + (cdr (assq 'class (dom-attributes el))))) (split-string class-list))) (dom-by-class dom "")))) (setq-local html--buffer-classes-cache (cons tick classes)) @@ -2260,8 +2260,8 @@ The result is cached in `html--buffer-ids-cache'." (ids (seq-mapcat (lambda (el) - (when-let (id-list - (cdr (assq 'id (dom-attributes el)))) + (when-let* ((id-list + (cdr (assq 'id (dom-attributes el))))) (split-string id-list))) (dom-by-id dom "")))) (setq-local html--buffer-ids-cache (cons tick ids)) commit 4612b2a2b37026bef5a9b8e92878a15dabb9b261 Author: Mark Oteiza Date: Tue Sep 12 12:44:45 2017 -0400 Implement and-let* This also includes changes to if-let and when-let. The single tuple special case is ambiguous, and binding a symbol to nil is not as useful as binding it to its value outside the lexical scope of the binding. (Bug#28254) * etc/NEWS: Mention. * lisp/emacs-lisp/subr-x.el (internal--listify): (internal--build-binding-value-form): Extend to account for solitary symbols and (EXPR) items in binding varlist. (if-let*, when-let*): Nix single tuple case and incumbent bind-symbol-to-nil behavior. (and-let*): New macro. (if-let, when-let): Mark obsolete. Redefine in terms of if-let*, so they implicitly gain the new features without breaking existing code. * test/lisp/emacs-lisp/subr-x-tests.el: Adjust tests for: lack of single-tuple special case, lack of binding solitary symbols to nil, and the introduction of uninterned symbols for (EXPR) bindings. Add SRFI-2 test suite adapted to Elisp. diff --git a/etc/NEWS b/etc/NEWS index af29b29264..03ef05b2a3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1136,6 +1136,14 @@ be disabled by setting 'byte-compile-cond-use-jump-table' to nil. --- ** The alist 'ucs-names' is now a hash table. +--- +** 'if-let' and 'when-let' are subsumed by 'if-let*' and 'when-let*'. +The incumbent 'if-let' and 'when-let' are now marked obsolete. +'if-let*' and 'when-let*' do not accept the single tuple special case. +New macro 'and-let*' is an implementation of the Scheme SRFI-2 syntax +of the same name. 'if-let*' and 'when-let*' now accept the same +binding syntax as 'and-let*'. + --- ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term mode to send the same escape sequences that xterm does. This makes @@ -1528,10 +1536,6 @@ It avoids unnecessary consing (and garbage collection). +++ ** 'gensym' is now part of Elisp. ---- -** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. -The incumbent 'if-let' and 'when-let' are now aliases. - --- ** Low-level list functions like 'length' and 'member' now do a better job of signaling list cycles instead of looping indefinitely. diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 849ac19d6a..3ea01065c8 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -83,10 +83,15 @@ threading." `(internal--thread-argument nil ,@forms)) (defsubst internal--listify (elt) - "Wrap ELT in a list if it is not one." - (if (not (listp elt)) - (list elt) - elt)) + "Wrap ELT in a list if it is not one. +If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." + (cond + ((symbolp elt) (list elt elt)) + ((and (null (cdr elt)) + (let ((form (car elt))) + (or (listp form) (atom form)))) + (list (make-symbol "s") (car elt))) + (t elt))) (defsubst internal--check-binding (binding) "Check BINDING is properly formed." @@ -98,7 +103,10 @@ threading." (defsubst internal--build-binding-value-form (binding prev-var) "Build the conditional value form for BINDING using PREV-VAR." - `(,(car binding) (and ,prev-var ,(cadr binding)))) + (let ((var (car binding))) + (if (and (null (cdr binding)) (atom (car binding)) (not (symbolp (car binding)))) + `(,var (and ,prev-var ,var)) + `(,var (and ,prev-var ,(cadr binding)))))) (defun internal--build-binding (binding prev-var) "Check and build a single BINDING with PREV-VAR." @@ -117,44 +125,68 @@ threading." binding)) bindings))) -(defmacro if-let* (bindings then &rest else) +(defmacro if-let* (varlist then &rest else) "Bind variables according to VARLIST and eval THEN or ELSE. -Each binding is evaluated in turn with `let*', and evaluation -stops if a binding value is nil. If all are non-nil, the value -of THEN is returned, or the last form in ELSE is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -In the special case you only want to bind a single value, -VARLIST can just be a plain tuple. -\n(fn VARLIST THEN ELSE...)" +Each binding is evaluated in turn, and evaluation stops if a +binding value is nil. If all are non-nil, the value of THEN is +returned, or the last form in ELSE is returned. + +Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds +SYMBOL to the value of VALUEFORM). +An element can additionally be of the form (VALUEFORM), which is +evaluated and checked for nil." (declare (indent 2) - (debug ([&or (&rest [&or symbolp (symbolp form)]) (symbolp form)] + (debug ((&rest [&or symbolp (symbolp form) (sexp)]) form body))) - (when (and (<= (length bindings) 2) - (not (listp (car bindings)))) - ;; Adjust the single binding case - (setq bindings (list bindings))) - `(let* ,(internal--build-bindings bindings) - (if ,(car (internal--listify (car (last bindings)))) - ,then - ,@else))) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (if ,(caar (last varlist)) + ,then + ,@else)) + `(let* () ,@else))) + +(defmacro when-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally eval BODY. +Each binding is evaluated in turn, and evaluation stops if a +binding value is nil. If all are non-nil, the value of the last +form in BODY is returned. + +VARLIST is the same as in `if-let*'." + (declare (indent 1) (debug if-let*)) + (list 'if-let* varlist (macroexp-progn body))) -(defmacro when-let* (bindings &rest body) +(defmacro and-let* (varlist &rest body) "Bind variables according to VARLIST and conditionally eval BODY. -Each binding is evaluated in turn with `let*', and evaluation -stops if a binding value is nil. If all are non-nil, the value -of the last form in BODY is returned. -Each element of VARLIST is a symbol (which is bound to nil) -or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM). -In the special case you only want to bind a single value, -VARLIST can just be a plain tuple. -\n(fn VARLIST BODY...)" - (declare (indent 1) (debug if-let)) - (list 'if-let bindings (macroexp-progn body))) - -(defalias 'if-let 'if-let*) -(defalias 'when-let 'when-let*) -(defalias 'and-let* 'when-let*) +Like `when-let*', except if BODY is empty and all the bindings +are non-nil, then the result is non-nil." + (declare (indent 1) (debug when-let*)) + (let (res) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (if ,(setq res (caar (last varlist))) + ,@(or body `(,res)))) + `(let* () ,@(or body '(t)))))) + +(defmacro if-let (spec then &rest else) + "Bind variables according to SPEC and eval THEN or ELSE. +Like `if-let*' except SPEC can have the form (SYMBOL VALUEFORM)." + (declare (indent 2) + (debug ([&or (&rest [&or symbolp (symbolp form) (sexp)]) + (symbolp form)] + form body)) + (obsolete "use `if-let*' instead." "26.1")) + (when (and (<= (length spec) 2) + (not (listp (car spec)))) + ;; Adjust the single binding case + (setq spec (list spec))) + (list 'if-let* spec then (macroexp-progn else))) + +(defmacro when-let (spec &rest body) + "Bind variables according to SPEC and conditionally eval BODY. +Like `when-let*' except SPEC can have the form (SYMBOL VALUEFORM)." + (declare (indent 1) (debug if-let) + (obsolete "use `when-let*' instead." "26.1")) + (list 'if-let spec (macroexp-progn body))) (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index 2b2a5cd0d7..111dc38f29 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -28,13 +28,13 @@ (require 'subr-x) -;; if-let tests +;; `if-let*' tests -(ert-deftest subr-x-test-if-let-single-binding-expansion () +(ert-deftest subr-x-test-if-let*-single-binding-expansion () "Test single bindings are expanded properly." (should (equal (macroexpand - '(if-let (a 1) + '(if-let* ((a 1)) (- a) "no")) '(let* ((a (and t 1))) @@ -43,53 +43,53 @@ "no")))) (should (equal (macroexpand - '(if-let (a) + '(if-let* (a) (- a) "no")) - '(let* ((a (and t nil))) + '(let* ((a (and t a))) (if a (- a) "no"))))) -(ert-deftest subr-x-test-if-let-single-symbol-expansion () +(ert-deftest subr-x-test-if-let*-single-symbol-expansion () "Test single symbol bindings are expanded properly." (should (equal (macroexpand - '(if-let (a) + '(if-let* (a) (- a) "no")) - '(let* ((a (and t nil))) + '(let* ((a (and t a))) (if a (- a) "no")))) (should (equal (macroexpand - '(if-let (a b c) + '(if-let* (a b c) (- a) "no")) - '(let* ((a (and t nil)) - (b (and a nil)) - (c (and b nil))) + '(let* ((a (and t a)) + (b (and a b)) + (c (and b c))) (if c (- a) "no")))) (should (equal (macroexpand - '(if-let (a (b 2) c) + '(if-let* (a (b 2) c) (- a) "no")) - '(let* ((a (and t nil)) + '(let* ((a (and t a)) (b (and a 2)) - (c (and b nil))) + (c (and b c))) (if c (- a) "no"))))) -(ert-deftest subr-x-test-if-let-nil-related-expansion () +(ert-deftest subr-x-test-if-let*-nil-related-expansion () "Test nil is processed properly." (should (equal (macroexpand - '(if-let (nil) + '(if-let* (nil) (- a) "no")) '(let* ((nil (and t nil))) @@ -98,27 +98,7 @@ "no")))) (should (equal (macroexpand - '(if-let ((nil)) - (- a) - "no")) - '(let* ((nil (and t nil))) - (if nil - (- a) - "no")))) - (should (equal - (macroexpand - '(if-let ((a 1) (nil) (b 2)) - (- a) - "no")) - '(let* ((a (and t 1)) - (nil (and a nil)) - (b (and nil 2))) - (if b - (- a) - "no")))) - (should (equal - (macroexpand - '(if-let ((a 1) nil (b 2)) + '(if-let* ((a 1) nil (b 2)) (- a) "no")) '(let* ((a (and t 1)) @@ -128,104 +108,106 @@ (- a) "no"))))) -(ert-deftest subr-x-test-if-let-malformed-binding () +(ert-deftest subr-x-test-if-let*-malformed-binding () "Test malformed bindings trigger errors." (should-error (macroexpand - '(if-let (_ (a 1 1) (b 2) (c 3) d) + '(if-let* (_ (a 1 1) (b 2) (c 3) d) (- a) "no")) :type 'error) (should-error (macroexpand - '(if-let (_ (a 1) (b 2 2) (c 3) d) + '(if-let* (_ (a 1) (b 2 2) (c 3) d) (- a) "no")) :type 'error) (should-error (macroexpand - '(if-let (_ (a 1) (b 2) (c 3 3) d) + '(if-let* (_ (a 1) (b 2) (c 3 3) d) (- a) "no")) :type 'error) (should-error (macroexpand - '(if-let ((a 1 1)) + '(if-let* ((a 1 1)) (- a) "no")) :type 'error)) -(ert-deftest subr-x-test-if-let-true () +(ert-deftest subr-x-test-if-let*-true () "Test `if-let' with truthy bindings." (should (equal - (if-let (a 1) + (if-let* ((a 1)) a "no") 1)) (should (equal - (if-let ((a 1) (b 2) (c 3)) + (if-let* ((a 1) (b 2) (c 3)) (list a b c) "no") (list 1 2 3)))) -(ert-deftest subr-x-test-if-let-false () +(ert-deftest subr-x-test-if-let*-false () "Test `if-let' with falsie bindings." (should (equal - (if-let (a nil) + (if-let* ((a nil)) (list a b c) "no") "no")) (should (equal - (if-let ((a nil) (b 2) (c 3)) + (if-let* ((a nil) (b 2) (c 3)) (list a b c) "no") "no")) (should (equal - (if-let ((a 1) (b nil) (c 3)) + (if-let* ((a 1) (b nil) (c 3)) (list a b c) "no") "no")) (should (equal - (if-let ((a 1) (b 2) (c nil)) + (if-let* ((a 1) (b 2) (c nil)) (list a b c) "no") "no")) (should (equal - (if-let (z (a 1) (b 2) (c 3)) - (list a b c) - "no") + (let (z) + (if-let* (z (a 1) (b 2) (c 3)) + (list a b c) + "no")) "no")) (should (equal - (if-let ((a 1) (b 2) (c 3) d) - (list a b c) - "no") + (let (d) + (if-let* ((a 1) (b 2) (c 3) d) + (list a b c) + "no")) "no"))) -(ert-deftest subr-x-test-if-let-bound-references () +(ert-deftest subr-x-test-if-let*-bound-references () "Test `if-let' bindings can refer to already bound symbols." (should (equal - (if-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) + (if-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) (list a b c) "no") (list 1 2 3)))) -(ert-deftest subr-x-test-if-let-and-laziness-is-preserved () +(ert-deftest subr-x-test-if-let*-and-laziness-is-preserved () "Test `if-let' respects `and' laziness." (let (a-called b-called c-called) (should (equal - (if-let ((a nil) - (b (setq b-called t)) - (c (setq c-called t))) + (if-let* ((a nil) + (b (setq b-called t)) + (c (setq c-called t))) "yes" (list a-called b-called c-called)) (list nil nil nil)))) (let (a-called b-called c-called) (should (equal - (if-let ((a (setq a-called t)) - (b nil) - (c (setq c-called t))) + (if-let* ((a (setq a-called t)) + (b nil) + (c (setq c-called t))) "yes" (list a-called b-called c-called)) (list t nil nil)))) (let (a-called b-called c-called) (should (equal - (if-let ((a (setq a-called t)) + (if-let* ((a (setq a-called t)) (b (setq b-called t)) (c nil) (d (setq c-called t))) @@ -234,13 +216,13 @@ (list t t nil))))) -;; when-let tests +;; `when-let*' tests -(ert-deftest subr-x-test-when-let-body-expansion () +(ert-deftest subr-x-test-when-let*-body-expansion () "Test body allows for multiple sexps wrapping with progn." (should (equal (macroexpand - '(when-let (a 1) + '(when-let* ((a 1)) (message "opposite") (- a))) '(let* ((a (and t 1))) @@ -249,79 +231,46 @@ (message "opposite") (- a))))))) -(ert-deftest subr-x-test-when-let-single-binding-expansion () - "Test single bindings are expanded properly." - (should (equal - (macroexpand - '(when-let (a 1) - (- a))) - '(let* ((a (and t 1))) - (if a - (- a))))) - (should (equal - (macroexpand - '(when-let (a) - (- a))) - '(let* ((a (and t nil))) - (if a - (- a)))))) - -(ert-deftest subr-x-test-when-let-single-symbol-expansion () +(ert-deftest subr-x-test-when-let*-single-symbol-expansion () "Test single symbol bindings are expanded properly." (should (equal (macroexpand - '(when-let (a) + '(when-let* (a) (- a))) - '(let* ((a (and t nil))) + '(let* ((a (and t a))) (if a (- a))))) (should (equal (macroexpand - '(when-let (a b c) + '(when-let* (a b c) (- a))) - '(let* ((a (and t nil)) - (b (and a nil)) - (c (and b nil))) + '(let* ((a (and t a)) + (b (and a b)) + (c (and b c))) (if c (- a))))) (should (equal (macroexpand - '(when-let (a (b 2) c) + '(when-let* (a (b 2) c) (- a))) - '(let* ((a (and t nil)) + '(let* ((a (and t a)) (b (and a 2)) - (c (and b nil))) + (c (and b c))) (if c (- a)))))) -(ert-deftest subr-x-test-when-let-nil-related-expansion () +(ert-deftest subr-x-test-when-let*-nil-related-expansion () "Test nil is processed properly." (should (equal (macroexpand - '(when-let (nil) - (- a))) - '(let* ((nil (and t nil))) - (if nil - (- a))))) - (should (equal - (macroexpand - '(when-let ((nil)) + '(when-let* (nil) (- a))) '(let* ((nil (and t nil))) (if nil (- a))))) (should (equal (macroexpand - '(when-let ((a 1) (nil) (b 2)) - (- a))) - '(let* ((a (and t 1)) - (nil (and a nil)) - (b (and nil 2))) - (if b - (- a))))) - (should (equal - (macroexpand - '(when-let ((a 1) nil (b 2)) + '(when-let* ((a 1) nil (b 2)) (- a))) '(let* ((a (and t 1)) (nil (and a nil)) @@ -329,108 +278,171 @@ (if b (- a)))))) -(ert-deftest subr-x-test-when-let-malformed-binding () +(ert-deftest subr-x-test-when-let*-malformed-binding () "Test malformed bindings trigger errors." (should-error (macroexpand - '(when-let (_ (a 1 1) (b 2) (c 3) d) + '(when-let* (_ (a 1 1) (b 2) (c 3) d) (- a))) :type 'error) (should-error (macroexpand - '(when-let (_ (a 1) (b 2 2) (c 3) d) + '(when-let* (_ (a 1) (b 2 2) (c 3) d) (- a))) :type 'error) (should-error (macroexpand - '(when-let (_ (a 1) (b 2) (c 3 3) d) + '(when-let* (_ (a 1) (b 2) (c 3 3) d) (- a))) :type 'error) (should-error (macroexpand - '(when-let ((a 1 1)) + '(when-let* ((a 1 1)) (- a))) :type 'error)) -(ert-deftest subr-x-test-when-let-true () +(ert-deftest subr-x-test-when-let*-true () "Test `when-let' with truthy bindings." (should (equal - (when-let (a 1) + (when-let* ((a 1)) a) 1)) (should (equal - (when-let ((a 1) (b 2) (c 3)) + (when-let* ((a 1) (b 2) (c 3)) (list a b c)) (list 1 2 3)))) -(ert-deftest subr-x-test-when-let-false () +(ert-deftest subr-x-test-when-let*-false () "Test `when-let' with falsie bindings." (should (equal - (when-let (a nil) + (when-let* ((a nil)) (list a b c) "no") nil)) (should (equal - (when-let ((a nil) (b 2) (c 3)) + (when-let* ((a nil) (b 2) (c 3)) (list a b c) "no") nil)) (should (equal - (when-let ((a 1) (b nil) (c 3)) + (when-let* ((a 1) (b nil) (c 3)) (list a b c) "no") nil)) (should (equal - (when-let ((a 1) (b 2) (c nil)) + (when-let* ((a 1) (b 2) (c nil)) (list a b c) "no") nil)) (should (equal - (when-let (z (a 1) (b 2) (c 3)) - (list a b c) - "no") + (let (z) + (when-let* (z (a 1) (b 2) (c 3)) + (list a b c) + "no")) nil)) (should (equal - (when-let ((a 1) (b 2) (c 3) d) - (list a b c) - "no") + (let (d) + (when-let* ((a 1) (b 2) (c 3) d) + (list a b c) + "no")) nil))) -(ert-deftest subr-x-test-when-let-bound-references () +(ert-deftest subr-x-test-when-let*-bound-references () "Test `when-let' bindings can refer to already bound symbols." (should (equal - (when-let ((a (1+ 0)) (b (1+ a)) (c (1+ b))) + (when-let* ((a (1+ 0)) (b (1+ a)) (c (1+ b))) (list a b c)) (list 1 2 3)))) -(ert-deftest subr-x-test-when-let-and-laziness-is-preserved () +(ert-deftest subr-x-test-when-let*-and-laziness-is-preserved () "Test `when-let' respects `and' laziness." (let (a-called b-called c-called) (should (equal (progn - (when-let ((a nil) - (b (setq b-called t)) - (c (setq c-called t))) + (when-let* ((a nil) + (b (setq b-called t)) + (c (setq c-called t))) "yes") (list a-called b-called c-called)) (list nil nil nil)))) (let (a-called b-called c-called) (should (equal (progn - (when-let ((a (setq a-called t)) - (b nil) - (c (setq c-called t))) + (when-let* ((a (setq a-called t)) + (b nil) + (c (setq c-called t))) "yes") (list a-called b-called c-called)) (list t nil nil)))) (let (a-called b-called c-called) (should (equal (progn - (when-let ((a (setq a-called t)) - (b (setq b-called t)) - (c nil) - (d (setq c-called t))) + (when-let* ((a (setq a-called t)) + (b (setq b-called t)) + (c nil) + (d (setq c-called t))) "yes") (list a-called b-called c-called)) (list t t nil))))) +;; `and-let*' tests + +;; Adapted from the Guile tests +;; https://git.savannah.gnu.org/cgit/guile.git/tree/test-suite/tests/srfi-2.test + +(ert-deftest subr-x-and-let*-test-empty-varlist () + (should (equal 1 (and-let* () 1))) + (should (equal 2 (and-let* () 1 2))) + (should (equal t (and-let* ())))) + +(ert-deftest subr-x-and-let*-test-group-1 () + (should (equal nil (let ((x nil)) (and-let* (x))))) + (should (equal 1 (let ((x 1)) (and-let* (x))))) + (should (equal nil (and-let* ((x nil))))) + (should (equal 1 (and-let* ((x 1))))) + (should-error (and-let* (nil (x 1))) :type 'setting-constant) + (should (equal nil (and-let* ((nil) (x 1))))) + (should-error (and-let* (2 (x 1))) :type 'wrong-type-argument) + (should (equal 1 (and-let* ((2) (x 1))))) + (should (equal 2 (and-let* ((x 1) (2))))) + (should (equal nil (let ((x nil)) (and-let* (x) x)))) + (should (equal "" (let ((x "")) (and-let* (x) x)))) + (should (equal "" (let ((x "")) (and-let* (x))))) + (should (equal 2 (let ((x 1)) (and-let* (x) (+ x 1))))) + (should (equal nil (let ((x nil)) (and-let* (x) (+ x 1))))) + (should (equal 2 (let ((x 1)) (and-let* (((> x 0))) (+ x 1))))) + (should (equal t (let ((x 1)) (and-let* (((> x 0))))))) + (should (equal nil (let ((x 0)) (and-let* (((> x 0))) (+ x 1))))) + (should (equal 3 + (let ((x 1)) (and-let* (((> x 0)) (x (+ x 1))) (+ x 1)))))) + +(ert-deftest subr-x-and-let*-test-rebind () + (should + (equal 4 + (let ((x 1)) + (and-let* (((> x 0)) (x (+ x 1)) (x (+ x 1))) (+ x 1)))))) + +(ert-deftest subr-x-and-let*-test-group-2 () + (should + (equal 2 (let ((x 1)) (and-let* (x ((> x 0))) (+ x 1))))) + (should + (equal 2 (let ((x 1)) (and-let* (((progn x)) ((> x 0))) (+ x 1))))) + (should (equal nil (let ((x 0)) (and-let* (x ((> x 0))) (+ x 1))))) + (should (equal nil (let ((x nil)) (and-let* (x ((> x 0))) (+ x 1))))) + (should + (equal nil (let ((x nil)) (and-let* (((progn x)) ((> x 0))) (+ x 1)))))) + +(ert-deftest subr-x-and-let*-test-group-3 () + (should + (equal nil (let ((x 1)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (should + (equal nil (let ((x 0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (should + (equal nil + (let ((x nil)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y))))) + (should + (equal (/ 3.0 2) + (let ((x 3.0)) (and-let* (x (y (- x 1)) ((> y 0))) (/ x y)))))) + + + ;; Thread first tests (ert-deftest subr-x-test-thread-first-no-forms () commit c87331a1c04aa4be55be7b944680e4ec486f5b04 Merge: b215b3a2f3 f4859757b6 Author: Eli Zaretskii Date: Tue Sep 12 19:29:45 2017 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit b215b3a2f389d6759569bc3dccbbb2503998f06c Author: Eli Zaretskii Date: Tue Sep 12 19:28:41 2017 +0300 Fix minor typos in the Emacs manual * doc/emacs/text.texi (Org Organizer): * doc/emacs/ack.texi (Acknowledgments): Fix spelling of Org nodes. diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 8f592ec87a..733106b740 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -285,7 +285,7 @@ Borgman, Baoqiu Cui, Dan Davison, Christian Egli, Eric S. Fraga, Daniel German, Jackson, Martyn Jago, Thorsten Jolitz, Jambunathan K, Tokuya Kameshima, Sergey Litvinov, David Maus, Ross Patterson, Juan Pechiar, Sebastian Rose, Eric Schulte, Paul Sexton, Ulf Stegemann, Andy Stewart, Christopher Suckling, David O'Toole, John Wiegley, Zhang Weize, Piotr Zieliński, and others also wrote various Org mode components. -For more information, @pxref{History and Acknowledgments,,, org, The Org Manual}. +For more information, @pxref{History and acknowledgments,,, org, The Org Manual}. @item Scott Draves wrote @file{tq.el}, help functions for maintaining diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index ab401c7336..3b54aa8263 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1429,7 +1429,7 @@ org-agenda}. This command prompts for what you want to see: a list of things to do this week, a list of TODO items with specific keywords, etc. @ifnottex -@xref{Agenda Views,,,org, The Org Manual}, for details. +@xref{Agenda views,,,org, The Org Manual}, for details. @end ifnottex @node Org Authoring commit b3fd6831dc38c1e1fedc4c9fbf344662384fa10a Author: Paul Eggert Date: Tue Sep 12 09:24:43 2017 -0700 Merge Emacs 25.3 fixes The security patches released for Emacs 25.3 were less drastic than what we had immediately put into master. Adjust master to match 25.3 (Bug#28350). * lisp/textmodes/enriched.el (enriched-translations): Re-enable FUNCTION and display translations that are safe. (enriched-handle-display-prop): Bring back. (enriched-decode-display-prop): Bring back, but disable the unsafe part. diff --git a/ChangeLog.2 b/ChangeLog.2 index bf52ac0ef1..bd1800b330 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -1,3 +1,17 @@ +2017-09-11 Eli Zaretskii + + * etc/NEWS: Document the vulnerability and its resolution. + Include a workaround. Suggested by Charles A. Roelli + . + + * lisp/gnus/mm-view.el (mm-inline-text): Disable decoding of + "enriched" and "richtext" MIME objects. Suggested by Lars + Ingebrigtsen . + + * lisp/textmodes/enriched.el (enriched-decode-display-prop): + Don't produce 'display' properties. (Bug#28350) + + 2017-04-20 Nicolas Petton * Version 25.2 released. diff --git a/etc/HISTORY b/etc/HISTORY index ad38b3262d..301ba33b97 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -211,6 +211,8 @@ GNU Emacs 25.1 (2016-09-16) emacs-25.1 GNU Emacs 25.2 (2017-04-20) emacs-25.2 +GNU Emacs 25.3 (2017-09-11) emacs-25.3 + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 3698f4d9cf..fb80e6bf3c 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -362,6 +362,12 @@ (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) + ;; Disabled in Emacs 25.3 to avoid execution of arbitrary Lisp + ;; forms in display properties supported by enriched.el. + ;; (when (member type '("enriched" "richtext")) + ;; (set-text-properties (point-min) (point-max) nil) + ;; (ignore-errors + ;; (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index eba7c4ddd8..5319db7c16 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -117,7 +117,12 @@ expression, which is evaluated to get the string to insert.") (full "flushboth") (center "center")) (PARAMETER (t "param")) ; Argument of preceding annotation + ;; The following are not part of the standard: + (FUNCTION (enriched-decode-foreground "x-color") + (enriched-decode-background "x-bg-color") + (enriched-decode-display-prop "x-display")) (read-only (t "x-read-only")) + (display (nil enriched-handle-display-prop)) (unknown (nil format-annotate-value)) ; (font-size (2 "bigger") ; unimplemented ; (-2 "smaller")) @@ -472,5 +477,35 @@ Return value is \(begin end name positive-p), or nil if none was found." (message "Warning: no color specified for ") nil)) +;;; Handling the `display' property. + + +(defun enriched-handle-display-prop (old new) + "Return a list of annotations for a change in the `display' property. +OLD is the old value of the property, NEW is the new value. Value +is a list `(CLOSE OPEN)', where CLOSE is a list of annotations to +close and OPEN a list of annotations to open. Each of these lists +has the form `(ANNOTATION PARAM ...)'." + (let ((annotation "x-display") + (param (prin1-to-string (or old new)))) + (if (null old) + (cons nil (list (list annotation param))) + (cons (list (list annotation param)) nil)))) + +(defun enriched-decode-display-prop (start end &optional param) + "Decode a `display' property for text between START and END. +PARAM is a `' found for the property. +Value is a list `(START END SYMBOL VALUE)' with START and END denoting +the range of text to assign text property SYMBOL with value VALUE." + (let ((prop (when (stringp param) + (condition-case () + (car (read-from-string param)) + (error nil))))) + (unless prop + (message "Warning: invalid parameter %s" param)) + ;; Disabled in Emacs 25.3 to avoid execution of arbitrary Lisp + ;; forms in display properties stored within enriched text. + ;; (list start end 'display prop))) + (list start end))) ;;; enriched.el ends here commit f4859757b63a056392af410fce6b4938f7f27c00 Author: Alan Mackenzie Date: Tue Sep 12 16:19:52 2017 +0000 Don't match C++ template delims starting within a token. FIxes bug #28418. * lisp/progmodes/cc-engine.el (c-restore-<>-properties): After failing an attempted match from the start of a token (in particular, "<<"), move to the next token rather than the nex character before searching for the next "<". diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 5ac4a76933..9ea0b2046a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6418,7 +6418,7 @@ comment at the start of cc-engine.el for more info." (not (eq (c-get-char-property (point) 'c-type) 'c-decl-arg-start))))))) (or (c-forward-<>-arglist nil) - (forward-char))))) + (c-forward-token-2))))) ;; Functions to handle C++ raw strings. commit 35c893ddaf21b93677850a69709b59630bb0feb7 Author: Mark Oteiza Date: Tue Sep 12 11:08:00 2017 -0400 Move gensym to core Elisp * doc/lispref/symbols.texi (Creating Symbols): Mention gensym right after make-symbol. * etc/NEWS: Mention. * lisp/emacs-lisp/cl-macs.el (cl--gensym-counter): Alias to gensym-counter. (cl-gensym): Alias to gensym. * lisp/emacs-lisp/cl.el: Remove gensym from list of aliases. * lisp/emacs-lisp/edebug.el (edebug-make-enter-wrapper): * lisp/emacs-lisp/ert-x.el (ert-with-message-capture): (ert--expand-should-1, ert--expand-should): (ert--should-error-handle-error): * lisp/emacs-lisp/generator.el (cps--gensym): * lisp/emacs-lisp/gv.el (setf): * lisp/emacs-lisp/inline.el (inline--do-letlisteval): * lisp/emacs-lisp/pcase.el (pcase--make-docstring, pcase-dolist): (pcase--funcall, pcase--u1): Use gensym. * lisp/subr.el (gensym-counter): New variable. (gensym): New function, assimilated from cl-lib. diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index e6ea8a1cc0..2d9ec6fda3 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -273,6 +273,13 @@ distinct uninterned symbol whose name is also @samp{foo}. @end example @end defun +@defun gensym &optional prefix +This function returns a symbol using @code{make-symbol}, whose name is +made by appending @code{gensym-counter} to @var{prefix}. The prefix +defaults to @code{"G"}. If @var{prefix} is a number, it replaces the +value of the counter. +@end defun + @defun intern name &optional obarray This function returns the interned symbol whose name is @var{name}. If there is no such symbol in the obarray @var{obarray}, @code{intern} diff --git a/etc/NEWS b/etc/NEWS index 3f1df23ec3..af29b29264 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1525,6 +1525,9 @@ It avoids unnecessary consing (and garbage collection). +++ ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. ++++ +** 'gensym' is now part of Elisp. + --- ** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. The incumbent 'if-let' and 'when-let' are now aliases. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 3405c92e8d..eee5953882 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -161,16 +161,9 @@ whether X is known at compile time, macroexpand it completely in ;;; Symbols. -(defvar cl--gensym-counter 0) +(defvaralias 'cl--gensym-counter 'gensym-counter) ;;;###autoload -(defun cl-gensym (&optional prefix) - "Generate a new uninterned symbol. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) - (num (if (integerp prefix) prefix - (prog1 cl--gensym-counter - (setq cl--gensym-counter (1+ cl--gensym-counter)))))) - (make-symbol (format "%s%d" pfix num)))) +(cl--defalias 'cl-gensym 'gensym) (defvar cl--gentemp-counter 0) ;;;###autoload diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 73eb9a4e86..306237ca38 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -250,7 +250,6 @@ eval-when destructuring-bind gentemp - gensym pairlis acons subst diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index c6ef8d7a99..3190346497 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1193,7 +1193,7 @@ circular objects. Let `read' read everything else." ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. ;; Do this after parsing since that may find a name. (setq edebug-def-name - (or edebug-def-name edebug-old-def-name (cl-gensym "edebug-anon"))) + (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) `(edebug-enter (quote ,edebug-def-name) ,(if edebug-inside-func diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index 4cf9d9609e..1413b9cd0b 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -295,7 +295,7 @@ This is useful for separating the issuance of messages by the code under test from the behavior of the *Messages* buffer." (declare (debug (symbolp body)) (indent 1)) - (let ((g-advice (cl-gensym))) + (let ((g-advice (gensym))) `(let* ((,var "") (,g-advice (lambda (func &rest args) (if (or (null args) (equal (car args) "")) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 9cc764d78e..579e5e0aad 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -298,8 +298,8 @@ It should only be stopped when ran from inside ert--run-test-internal." (error `(signal ',(car err) ',(cdr err)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) - (let ((value (cl-gensym "value-"))) - `(let ((,value (cl-gensym "ert-form-evaluation-aborted-"))) + (let ((value (gensym "value-"))) + `(let ((,value (gensym "ert-form-evaluation-aborted-"))) ,(funcall inner-expander `(setq ,value ,form) `(list ',whole :form ',form :value ,value) @@ -312,10 +312,10 @@ It should only be stopped when ran from inside ert--run-test-internal." (and (consp fn-name) (eql (car fn-name) 'lambda) (listp (cdr fn-name))))) - (let ((fn (cl-gensym "fn-")) - (args (cl-gensym "args-")) - (value (cl-gensym "value-")) - (default-value (cl-gensym "ert-form-evaluation-aborted-"))) + (let ((fn (gensym "fn-")) + (args (gensym "args-")) + (value (gensym "value-")) + (default-value (gensym "ert-form-evaluation-aborted-"))) `(let* ((,fn (function ,fn-name)) (,args (condition-case err (let ((signal-hook-function #'ert--should-signal-hook)) @@ -357,7 +357,7 @@ FORM-DESCRIPTION-FORM before it has called INNER-FORM." (ert--expand-should-1 whole form (lambda (inner-form form-description-form value-var) - (let ((form-description (cl-gensym "form-description-"))) + (let ((form-description (gensym "form-description-"))) `(let (,form-description) ,(funcall inner-expander `(unwind-protect @@ -435,8 +435,8 @@ failed." `(should-error ,form ,@keys) form (lambda (inner-form form-description-form value-var) - (let ((errorp (cl-gensym "errorp")) - (form-description-fn (cl-gensym "form-description-fn-"))) + (let ((errorp (gensym "errorp")) + (form-description-fn (gensym "form-description-fn-"))) `(let ((,errorp nil) (,form-description-fn (lambda () ,form-description-form))) (condition-case -condition- diff --git a/lisp/emacs-lisp/generator.el b/lisp/emacs-lisp/generator.el index c96b400809..fe5d2d0728 100644 --- a/lisp/emacs-lisp/generator.el +++ b/lisp/emacs-lisp/generator.el @@ -86,10 +86,7 @@ (defvar cps--cleanup-function nil) (defmacro cps--gensym (fmt &rest args) - ;; Change this function to use `cl-gensym' if you want the generated - ;; code to be easier to read and debug. - ;; (cl-gensym (apply #'format fmt args)) - `(progn (ignore ,@args) (make-symbol ,fmt))) + `(gensym (format ,fmt ,@args))) (defvar cps--dynamic-wrappers '(identity) "List of transformer functions to apply to atomic forms we diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index a8b8974cb4..42b1c21695 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -431,7 +431,7 @@ The return value is the last VAL in the list. ;; code is large, but otherwise results in more efficient code. `(if ,test ,(gv-get then do) ,@(macroexp-unprogn (gv-get (macroexp-progn else) do))) - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (macroexp-let2 nil gv `(if ,test ,(gv-letplace (getter setter) then `(cons (lambda () ,getter) @@ -456,7 +456,7 @@ The return value is the last VAL in the list. (gv-get (macroexp-progn (cdr branch)) do))) (gv-get (car branch) do))) branches)) - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (macroexp-let2 nil gv `(cond ,@(mapcar diff --git a/lisp/emacs-lisp/inline.el b/lisp/emacs-lisp/inline.el index ce46f66aef..cf8e2f22d8 100644 --- a/lisp/emacs-lisp/inline.el +++ b/lisp/emacs-lisp/inline.el @@ -218,7 +218,7 @@ After VARS is handled, BODY is evaluated in the new environment." `(let* ((,bsym ()) (,listvar (mapcar (lambda (e) (if (macroexp-copyable-p e) e - (let ((v (make-symbol "v"))) + (let ((v (gensym "v"))) (push (list v e) ,bsym) v))) ,listvar))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 253b60e753..5935845743 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -213,7 +213,7 @@ Emacs Lisp manual for more information and examples." (defmacro pcase-exhaustive (exp &rest cases) "The exhaustive version of `pcase' (which see)." (declare (indent 1) (debug pcase)) - (let* ((x (make-symbol "x")) + (let* ((x (gensym "x")) (pcase--dontwarn-upats (cons x pcase--dontwarn-upats))) (pcase--expand ;; FIXME: Could we add the FILE:LINE data in the error message? @@ -304,7 +304,7 @@ any kind of error." (declare (indent 1) (debug ((pcase-PAT form) body))) (if (pcase--trivial-upat-p (car spec)) `(dolist ,spec ,@body) - (let ((tmpvar (make-symbol "x"))) + (let ((tmpvar (gensym "x"))) `(dolist (,tmpvar ,@(cdr spec)) (pcase-let* ((,(car spec) ,tmpvar)) ,@body))))) @@ -715,7 +715,7 @@ MATCH is the pattern that needs to be matched, of the form: (call (progn (when (memq arg vs) ;; `arg' is shadowed by `env'. - (let ((newsym (make-symbol "x"))) + (let ((newsym (gensym "x"))) (push (list newsym arg) env) (setq arg newsym))) (if (functionp fun) @@ -842,7 +842,7 @@ Otherwise, it defers to REST which is a list of branches of the form ;; A upat of the form (app FUN PAT) (pcase--mark-used sym) (let* ((fun (nth 1 upat)) - (nsym (make-symbol "x")) + (nsym (gensym "x")) (body ;; We don't change `matches' to reuse the newly computed value, ;; because we assume there shouldn't be such redundancy in there. diff --git a/lisp/subr.el b/lisp/subr.el index 2ad52f6a63..ebb8b53b50 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -280,6 +280,20 @@ without silencing all errors." ;;;; Basic Lisp functions. +(defvar gensym-counter 0 + "Number used to construct the name of the next symbol created by `gensym'.") + +(defun gensym (&optional prefix) + "Return a new uninterned symbol. +The name is made by appending `gensym-counter' to PREFIX. +PREFIX can be a string, and defaults to \"G\". +If PREFIX is a number, it replaces the value of `gensym-counter'." + (let ((pfix (if (stringp prefix) prefix "G")) + (num (if (integerp prefix) prefix + (prog1 gensym-counter + (setq gensym-counter (1+ gensym-counter)))))) + (make-symbol (format "%s%d" pfix num)))) + (defun ignore (&rest _ignore) "Do nothing and return nil. This function accepts any number of arguments, but ignores them." commit 2ae46b4c0dabfea80883a294dff16e0eb7182d30 Author: Mark Oteiza Date: Tue Sep 12 11:00:58 2017 -0400 Fix cl-gentemp * lisp/emacs-lisp/cl-macs.el (cl--gentemp-counter): New variable. (cl-gentemp): Use it. Change prefix to "T". diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 20a956b474..3405c92e8d 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -172,14 +172,15 @@ The name is made by appending a number to PREFIX, default \"G\"." (setq cl--gensym-counter (1+ cl--gensym-counter)))))) (make-symbol (format "%s%d" pfix num)))) +(defvar cl--gentemp-counter 0) ;;;###autoload (defun cl-gentemp (&optional prefix) "Generate a new interned symbol with a unique name. -The name is made by appending a number to PREFIX, default \"G\"." - (let ((pfix (if (stringp prefix) prefix "G")) +The name is made by appending a number to PREFIX, default \"T\"." + (let ((pfix (if (stringp prefix) prefix "T")) name) - (while (intern-soft (setq name (format "%s%d" pfix cl--gensym-counter))) - (setq cl--gensym-counter (1+ cl--gensym-counter))) + (while (intern-soft (setq name (format "%s%d" pfix cl--gentemp-counter))) + (setq cl--gentemp-counter (1+ cl--gentemp-counter))) (intern name))) commit fcf5d894c061fe7ea557aafd249f9cd0f69dfb28 Author: Sam Steingold Date: Tue Sep 12 10:31:13 2017 -0400 gnus-score-file-name: Do not append empty suffix. diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 2defa76f50..19cf799a2f 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -2961,8 +2961,8 @@ The list is determined from the variable `gnus-score-file-alist'." (expand-file-name suffix gnus-kill-files-directory)) ((gnus-use-long-file-name 'not-score) ;; Append ".SCORE" to newsgroup name. - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." suffix) + (expand-file-name (let ((name (gnus-newsgroup-savable-name newsgroup))) + (if (string= "" suffix) name (concat name "." suffix))) gnus-kill-files-directory)) (t ;; Place "SCORE" under the hierarchical directory. commit 49a42fbd27c3235d7183bc2adf7d413903985dc0 Author: Michael Albinus Date: Tue Sep 12 11:20:49 2017 +0200 Extend tramp-tests according to bug#27986 * test/lisp/net/tramp-tests.el (tramp-test11-copy-file) (tramp-test12-rename-file, tramp-test15-copy-directory) (tramp-test21-file-links): Extend tests. (tramp-test13-make-directory, tramp-test14-delete-directory): Specifiy error symbol in `should-error'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 13e2e30cab..d5fec30384 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1900,9 +1900,14 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-file-contents tmp-name2) (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name2)) + (should-error + (copy-file tmp-name1 tmp-name2) + :type 'file-already-exists) (copy-file tmp-name1 tmp-name2 'ok) (make-directory tmp-name3) + (should-error + (copy-file tmp-name1 tmp-name3) + :type 'file-already-exists) (copy-file tmp-name1 (file-name-as-directory tmp-name3)) (should (file-exists-p @@ -1922,9 +1927,14 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-file-contents tmp-name4) (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name1 tmp-name4)) + (should-error + (copy-file tmp-name1 tmp-name4) + :type 'file-already-exists) (copy-file tmp-name1 tmp-name4 'ok) (make-directory tmp-name5) + (should-error + (copy-file tmp-name1 tmp-name5) + :type 'file-already-exists) (copy-file tmp-name1 (file-name-as-directory tmp-name5)) (should (file-exists-p @@ -1944,9 +1954,14 @@ This checks also `file-name-as-directory', `file-name-directory', (with-temp-buffer (insert-file-contents tmp-name1) (should (string-equal (buffer-string) "foo"))) - (should-error (copy-file tmp-name4 tmp-name1)) + (should-error + (copy-file tmp-name4 tmp-name1) + :type 'file-already-exists) (copy-file tmp-name4 tmp-name1 'ok) (make-directory tmp-name3) + (should-error + (copy-file tmp-name4 tmp-name3) + :type 'file-already-exists) (copy-file tmp-name4 (file-name-as-directory tmp-name3)) (should (file-exists-p @@ -1981,11 +1996,16 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name2) (should (string-equal (buffer-string) "foo"))) (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name2)) + (should-error + (rename-file tmp-name1 tmp-name2) + :type 'file-already-exists) (rename-file tmp-name1 tmp-name2 'ok) (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name3) + (should-error + (rename-file tmp-name1 tmp-name3) + :type 'file-already-exists) (rename-file tmp-name1 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name1)) (should @@ -2008,11 +2028,16 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name4) (should (string-equal (buffer-string) "foo"))) (write-region "foo" nil tmp-name1) - (should-error (rename-file tmp-name1 tmp-name4)) + (should-error + (rename-file tmp-name1 tmp-name4) + :type 'file-already-exists) (rename-file tmp-name1 tmp-name4 'ok) (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name5) + (should-error + (rename-file tmp-name1 tmp-name5) + :type 'file-already-exists) (rename-file tmp-name1 (file-name-as-directory tmp-name5)) (should-not (file-exists-p tmp-name1)) (should @@ -2035,11 +2060,16 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name1) (should (string-equal (buffer-string) "foo"))) (write-region "foo" nil tmp-name4 nil 'nomessage) - (should-error (rename-file tmp-name4 tmp-name1)) + (should-error + (rename-file tmp-name4 tmp-name1) + :type 'file-already-exists) (rename-file tmp-name4 tmp-name1 'ok) (should-not (file-exists-p tmp-name4)) (write-region "foo" nil tmp-name4 nil 'nomessage) (make-directory tmp-name3) + (should-error + (rename-file tmp-name4 tmp-name3) + :type 'file-already-exists) (rename-file tmp-name4 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name4)) (should @@ -2064,7 +2094,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (make-directory tmp-name1) (should (file-directory-p tmp-name1)) (should (file-accessible-directory-p tmp-name1)) - (should-error (make-directory tmp-name2)) + (should-error (make-directory tmp-name2) :type 'file-error) (make-directory tmp-name2 'parents) (should (file-directory-p tmp-name2)) (should (file-accessible-directory-p tmp-name2))) @@ -2088,7 +2118,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (file-directory-p tmp-name)) (write-region "foo" nil (expand-file-name "bla" tmp-name)) (should (file-exists-p (expand-file-name "bla" tmp-name))) - (should-error (delete-directory tmp-name)) + (should-error (delete-directory tmp-name) :type 'file-error) (delete-directory tmp-name 'recursive) (should-not (file-directory-p tmp-name))))) @@ -2117,6 +2147,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (file-directory-p tmp-name2)) (should (file-exists-p tmp-name5)) ;; Target directory does exist already. + (should-error + (copy-directory tmp-name1 tmp-name2) + :type 'file-error) (copy-directory tmp-name1 (file-name-as-directory tmp-name2)) (should (file-directory-p tmp-name3)) (should (file-exists-p tmp-name6))) @@ -2140,8 +2173,9 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Target directory does exist already. (delete-file tmp-name5) (should-not (file-exists-p tmp-name5)) - (copy-directory tmp-name1 (file-name-as-directory tmp-name2) - nil 'parents 'contents) + (copy-directory + tmp-name1 (file-name-as-directory tmp-name2) + nil 'parents 'contents) (should (file-directory-p tmp-name2)) (should (file-exists-p tmp-name5)) (should-not (file-directory-p tmp-name3)) @@ -2591,7 +2625,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (file-truename tramp-test-temporary-file-directory)) (tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) - (tmp-name3 (tramp--test-make-temp-name 'local quoted))) + (tmp-name3 (tramp--test-make-temp-name 'local quoted)) + (tmp-name4 (tramp--test-make-temp-name nil quoted))) ;; Check `make-symbolic-link'. (unwind-protect @@ -2642,13 +2677,28 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; target remains unchanged, even if quoted. (make-symbolic-link tmp-name1 tmp-name3) (should - (string-equal tmp-name1 (file-symlink-p tmp-name3)))) + (string-equal tmp-name1 (file-symlink-p tmp-name3))) + ;; Check directory as newname. + (make-directory tmp-name4) + (should-error + (make-symbolic-link tmp-name1 tmp-name4) + :type 'file-already-exists) + (make-symbolic-link tmp-name1 (file-name-as-directory tmp-name4)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + (file-remote-p tmp-name1 'localname)) + (file-symlink-p + (expand-file-name + (file-name-nondirectory tmp-name1) tmp-name4))))) ;; Cleanup. (ignore-errors (delete-file tmp-name1) (delete-file tmp-name2) - (delete-file tmp-name3))) + (delete-file tmp-name3) + (delete-directory tmp-name4 'recursive))) ;; Check `add-name-to-file'. (unwind-protect @@ -2674,12 +2724,22 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; `tmp-name3' is a local file name. (should-error (add-name-to-file tmp-name1 tmp-name3) - :type 'file-error)) + :type 'file-error) + ;; Check directory as newname. + (make-directory tmp-name4) + (should-error + (add-name-to-file tmp-name1 tmp-name4) + :type 'file-already-exists) + (add-name-to-file tmp-name1 (file-name-as-directory tmp-name4)) + (should + (file-regular-p + (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))) ;; Cleanup. (ignore-errors (delete-file tmp-name1) - (delete-file tmp-name2))) + (delete-file tmp-name2) + (delete-directory tmp-name4 'recursive))) ;; Check `file-truename'. (unwind-protect @@ -2969,7 +3029,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "(provide 'tramp-test-load)" nil tmp-name) ;; `load' in lread.c does not pass `must-suffix'. Why? ;;(should-error - ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)) + ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix) + ;; :type 'file-error) (load tmp-name nil 'nomessage 'nosuffix) (should (featurep 'tramp-test-load))) @@ -3112,7 +3173,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (equal (process-status proc) 'signal)) ;; An interrupted process cannot be interrupted, again. ;; Does not work reliable. - ;; (should-error (interrupt-process proc))) + ;; (should-error (interrupt-process proc) :type 'error)) ) ;; Cleanup. commit 370e04fbb206c59c6a2251dc54f69c61887f60cc Author: Mark Oteiza Date: Mon Sep 11 22:20:41 2017 -0400 Add cl-print method for hash tables * lisp/emacs-lisp/cl-print.el (cl-print-object): New method. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index fec5e868d6..eb50d75687 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -78,6 +78,16 @@ call other entry points instead, such as `cl-prin1'." (cl-print-object (aref object i) stream)) (princ "]" stream)) +(cl-defmethod cl-print-object ((object hash-table) stream) + (princ "#" stream)) + (define-button-type 'help-byte-code 'follow-link t 'action (lambda (button) commit 8130186cfb830d82e7d0cc6fb7443e3b6e026660 Author: Mark Oteiza Date: Mon Sep 11 22:16:14 2017 -0400 Add docstrings to cl-print entry points * lisp/emacs-lisp/cl-print.el (cl-print-compiled): Fix docstring. (cl-prin1, cl-prin1-to-string): Add docstrings. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 6a292d2477..fec5e868d6 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -85,7 +85,8 @@ call other entry points instead, such as `cl-prin1'." 'help-echo (purecopy "mouse-2, RET: disassemble this function")) (defvar cl-print-compiled nil - "Control how to print byte-compiled functions. Can be: + "Control how to print byte-compiled functions. +Acceptable values include: - `static' to print the vector of constants. - `disassemble' to print the disassembly of the code. - nil to skip printing any details about the code.") @@ -253,6 +254,11 @@ into a button whose action shows the function's disassembly.") ;;;###autoload (defun cl-prin1 (object &optional stream) + "Print OBJECT on STREAM according to its type. +Output is further controlled by the variables +`cl-print-readably', `cl-print-compiled', along with output +variables for the standard printing functions. See Info +node `(elisp)Output Variables'. " (cond (cl-print-readably (prin1 object stream)) ((not print-circle) (cl-print-object object stream)) @@ -262,6 +268,7 @@ into a button whose action shows the function's disassembly.") ;;;###autoload (defun cl-prin1-to-string (object) + "Return a string containing the `cl-prin1'-printed representation of OBJECT." (with-temp-buffer (cl-prin1 object (current-buffer)) (buffer-string))) commit f6474b4808363dbddeffef8d73ee3be7b3858fa3 Author: Mark Oteiza Date: Mon Sep 11 21:23:38 2017 -0400 ; Fix previous commit The printer otherwise includes the 0x prefix. * lisp/emacs-lisp/cl-print.el: Add 0x to format. diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index cf9407c8a7..6a292d2477 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -131,7 +131,7 @@ into a button whose action shows the function's disassembly.") (let ((button-start (and cl-print-compiled-button (bufferp stream) (with-current-buffer stream (point))))) - (princ (format "#" (sxhash object)) stream) + (princ (format "#" (sxhash object)) stream) (when (eq cl-print-compiled 'static) (princ " " stream) (cl-print-object (aref object 2) stream)) commit 23252d4ccf0773100ccd0a08966745dbb11a3899 Author: Glenn Morris Date: Mon Sep 11 18:11:37 2017 -0400 Improve reproducibility of generated leim-list.el * lisp/international/quail.el (quail-update-leim-list-file): Sort the quail directory listing, for more stable output. diff --git a/lisp/international/quail.el b/lisp/international/quail.el index b7f0b15639..c94c9fc1be 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -3047,7 +3047,7 @@ of each directory." (while quail-dirs (setq dirname (car quail-dirs)) (when dirname - (setq pkg-list (directory-files dirname 'full "\\.el$" 'nosort)) + (setq pkg-list (directory-files dirname 'full "\\.el$")) (while pkg-list (message "Checking %s ..." (car pkg-list)) (with-temp-buffer commit 123d52f69c1149871e11b311c1819c4f02ea9982 Author: Philipp Stephani Date: Mon Sep 11 22:11:41 2017 +0200 ; * lisp/files.el (basic-save-buffer-2): Fix typo. diff --git a/lisp/files.el b/lisp/files.el index 611a4c5a6f..de9fab8d32 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5080,7 +5080,7 @@ Before and after saving the buffer, this function runs (progn ;; Pass in nil&nil rather than point-min&max to indicate ;; we're saving the buffer rather than just a region. - ;; write-region-annotate-functions may make us of it. + ;; write-region-annotate-functions may make use of it. (write-region nil nil buffer-file-name nil t buffer-file-truename) (when save-silently (message nil)) commit a66155555b6e37b7c5a4d3fd4604f9929288753a Author: Mark Oteiza Date: Mon Sep 11 16:06:06 2017 -0400 Include sxhash of object with printed bytecode This printing, while succint, is rather opaque. At least give an immediate clue of whether different byte code printouts are for the same or different byte code objects. * lisp/emacs-lisp/cl-print.el (cl-print-object): Add object sxhash to printed token "#". diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index e9ca041284..cf9407c8a7 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -131,7 +131,7 @@ into a button whose action shows the function's disassembly.") (let ((button-start (and cl-print-compiled-button (bufferp stream) (with-current-buffer stream (point))))) - (princ "#" stream) + (princ (format "#" (sxhash object)) stream) (when (eq cl-print-compiled 'static) (princ " " stream) (cl-print-object (aref object 2) stream)) commit 4c57eda5cf03ed9c3beda4c3a62624e6f46ad84e Author: Eli Zaretskii Date: Mon Sep 11 19:48:56 2017 +0300 Update documentation of 'max-lisp-eval-depth' * doc/lispref/eval.texi (Eval): Update the documented default value of 'max-lisp-eval-depth'. diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi index 363d0a1431..064fca22ff 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -818,7 +818,7 @@ The depth limit counts internal uses of @code{eval}, @code{apply}, and expressions, and recursive evaluation of function call arguments and function body forms, as well as explicit calls in Lisp code. -The default value of this variable is 400. If you set it to a value +The default value of this variable is 800. If you set it to a value less than 100, Lisp will reset it to 100 if the given value is reached. Entry to the Lisp debugger increases the value, if there is little room left, to make sure the debugger itself has room to commit 7fb03a28e74adff00154e5e144d0c9e8b4bab8ab Author: Eli Zaretskii Date: Mon Sep 11 19:44:38 2017 +0300 Another place to produce debugging output in etags * lib-src/etags.c (Ruby_functions): One more place to print debugging output under --debug. diff --git a/lib-src/etags.c b/lib-src/etags.c index df51c0b4f8..b4ce43de4f 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -4974,6 +4974,9 @@ Ruby_functions (FILE *inf) memcpy (wr_name + name_len - 1, "=", 2); pfnote (wr_name, true, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); + if (debug) + fprintf (stderr, "%s on %s:%d: %s\n", wr_name, + curfdp->taggedfname, lineno, lb.buffer); continuation = false; } if (alias) commit e33234ab9f387f56b3479359371c7d14d4f9e810 Author: Eli Zaretskii Date: Mon Sep 11 19:40:43 2017 +0300 Improve documentation of etags-related features * doc/emacs/maintaining.texi (Looking Up Identifiers): Document 'xref-prompt-for-identifier'. (Bug#28403) (Etags Regexps): Document \D back references in etags regexps. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 6a592e2d51..39b7144594 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1820,17 +1820,21 @@ Go back to where you previously invoked @kbd{M-.} and friends @kindex M-. @findex xref-find-definitions +@vindex xref-prompt-for-identifier @kbd{M-.}@: (@code{xref-find-definitions}) shows the definitions of the identifier at point. With a prefix argument, or if there's no -identifier at point, it prompts for the identifier. If the -identifier has only one definition, the command jumps to it. If the -identifier has more than one possible definition (e.g., in an -object-oriented language, or if there's a function and a variable by -the same name), the command shows the candidate definitions in a -@file{*xref*} buffer, together with the files in which these -definitions are found. Selecting one of these candidates by typing -@kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer showing -the corresponding definition. +identifier at point, it prompts for the identifier. (If you want it +to always prompt, customize @code{xref-prompt-for-identifier} to +@code{t}.) + +If the specified identifier has only one definition, the command jumps +to it. If the identifier has more than one possible definition (e.g., +in an object-oriented language, or if there's a function and a +variable by the same name), the command shows the candidate +definitions in a @file{*xref*} buffer, together with the files in +which these definitions are found. Selecting one of these candidates +by typing @kbd{@key{RET}} or clicking @kbd{mouse-2} will pop a buffer +showing the corresponding definition. When entering the identifier argument to @kbd{M-.}, the usual minibuffer completion commands can be used (@pxref{Completion}), with @@ -2430,8 +2434,11 @@ needed to recognize what you want to tag. If the syntax requires you to write @var{tagregexp} so it matches more characters beyond the tag itself, you should add a @var{nameregexp}, to pick out just the tag. This will enable Emacs to find tags more accurately and to do -completion on tag names more reliably. You can find some examples -below. +completion on tag names more reliably. In @var{nameregexp}, it is +frequently convenient to use ``back references'' (@pxref{Regexp +Backslash}) to parenthesized groupings @w{@samp{\( @dots{} \)}} in +@var{tagregexp}. For example, @samp{\1} refers to the first such +parenthesized grouping. You can find some examples of this below. The @var{modifiers} are a sequence of zero or more characters that modify the way @command{etags} does the matching. A regexp with no @@ -2479,7 +2486,7 @@ following example tags the @code{DEFVAR} macros in the Emacs source files, for the C language only: @smallexample ---regex='@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/' +--regex='@{c@}/[ \t]*DEFVAR_[A-Z_ \t(]+"\([^"]+\)"/\1/' @end smallexample @noindent commit aa4bb9de9dffda0669321505b64bb5f4551b9358 Author: Alan Third Date: Mon Sep 11 17:15:13 2017 +0100 Fix macOS compatibility versions for vibrant dark theme (bug#28415) * src/nsterm.m (ns_set_appearance, EmacsView::initFrameFromEmacs): Change macOS compatibility from 10.9 to 10.10. diff --git a/src/nsterm.m b/src/nsterm.m index be97e94dd5..001e4576e8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2040,17 +2040,17 @@ so some key presses (TAB) are swallowed by the system. */ void ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); NSWindow *window = [view window]; NSTRACE ("ns_set_appearance"); -#ifndef NSAppKitVersionNumber10_9 -#define NSAppKitVersionNumber10_9 1265 +#ifndef NSAppKitVersionNumber10_10 +#define NSAppKitVersionNumber10_10 1343 #endif - if (NSAppKitVersionNumber < NSAppKitVersionNumber10_9) + if (NSAppKitVersionNumber < NSAppKitVersionNumber10_10) return; if (EQ (new_value, Qdark)) @@ -2065,7 +2065,7 @@ so some key presses (TAB) are swallowed by the system. */ appearanceNamed: NSAppearanceNameAqua]; FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; } -#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */ +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ } void @@ -7135,12 +7135,12 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f if (! FRAME_UNDECORATED (f)) [self createToolbar: f]; -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 -#ifndef NSAppKitVersionNumber10_9 -#define NSAppKitVersionNumber10_9 1265 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 +#ifndef NSAppKitVersionNumber10_10 +#define NSAppKitVersionNumber10_10 1343 #endif - if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_9 + if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_10 && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua) win.appearance = [NSAppearance appearanceNamed: NSAppearanceNameVibrantDark]; commit 7004545244ea5efbe7a37db72431f982c70576e6 Author: Michael Albinus Date: Mon Sep 11 17:12:32 2017 +0200 Further optimization in Tramp's file name decomposition * lisp/net/tramp.el (tramp-syntax): Recompute all file name components. Call `custom-set-variables' after loading. (tramp-build-prefix-format, tramp-build-prefix-regexp) (tramp-build-method-regexp) (tramp-build-postfix-method-format) (tramp-build-postfix-method-regexp) (tramp-build-prefix-ipv6-format) (tramp-build-prefix-ipv6-regexp) (tramp-build-postfix-ipv6-format) (tramp-build-postfix-ipv6-regexp) (tramp-build-postfix-host-format) (tramp-build-postfix-host-regexp) (tramp-build-file-name-regexp) (tramp-build-completion-file-name-regexp): New defuns. (tramp-prefix-format, tramp-prefix-regexp) (tramp-method-regexp, tramp-postfix-method-format) (tramp-postfix-method-regexp, tramp-prefix-ipv6-format) (tramp-prefix-ipv6-regexp, tramp-postfix-ipv6-format) (tramp-postfix-ipv6-regexp, tramp-postfix-host-format) (tramp-postfix-host-regexp) (tramp-remote-file-name-spec-regexp) (tramp-file-name-structure, tramp-file-name-regexp) (tramp-completion-file-name-regexp): Convert defuns into defvars. (tramp-prefix-regexp-alist) (tramp-postfix-method-regexp-alist) (tramp-prefix-ipv6-regexp-alist) (tramp-postfix-ipv6-regexp-alist) (tramp-postfix-host-regexp-alist) (tramp-remote-file-name-spec-regexp-alist): Remove. (tramp-build-remote-file-name-spec-regexp) (tramp-build-file-name-structure): Simplify. (tramp-completion-file-name-regexp-alist): New defconst. (tramp-tramp-file-p, tramp-dissect-file-name) (tramp-make-tramp-file-name) (tramp-completion-make-tramp-file-name) (tramp-rfn-eshadow-update-overlay-regexp) (tramp-register-file-name-handlers) (tramp-completion-handle-file-name-all-completions) (tramp-completion-dissect-file-name, tramp-clear-passwd): * lisp/net/tramp-ftp.el (tramp-ftp-file-name-handler): * lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered) (tramp-compute-multi-hops): Use variables but functions for file name components. * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion): Use variables but functions for file name components. diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 8e489eee80..85afd52bf4 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -121,10 +121,10 @@ pass to the OPERATION." (or (boundp 'ange-ftp-name-format) (let (file-name-handler-alist) (require 'ange-ftp))) (let ((ange-ftp-name-format - (list (nth 0 (tramp-file-name-structure)) - (nth 3 (tramp-file-name-structure)) - (nth 2 (tramp-file-name-structure)) - (nth 4 (tramp-file-name-structure)))) + (list (nth 0 tramp-file-name-structure) + (nth 3 tramp-file-name-structure) + (nth 2 tramp-file-name-structure) + (nth 4 tramp-file-name-structure))) ;; ange-ftp uses `ange-ftp-ftp-name-arg' and `ange-ftp-ftp-name-res' ;; for optimization in `ange-ftp-ftp-name'. If Tramp wasn't active, ;; there could be incorrect values from previous calls in case the diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 597ca6a620..01fe335963 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3437,7 +3437,7 @@ the result will be a local, non-Tramp, file name." (let (tramp-vc-registered-file-names (remote-file-name-inhibit-cache (current-time)) (file-name-handler-alist - `((,(tramp-file-name-regexp) . tramp-vc-file-name-handler)))) + `((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) ;; Here we collect only file names, which need an operation. (tramp-with-demoted-errors @@ -4468,7 +4468,7 @@ Goes through the list `tramp-inline-compress-commands'." (let ((user (tramp-file-name-user item)) (host (tramp-file-name-host item)) (proxy (concat - (tramp-prefix-format) proxy (tramp-postfix-host-format)))) + tramp-prefix-format proxy tramp-postfix-host-format))) (tramp-message vec 5 "Add proxy (\"%s\" \"%s\" \"%s\")" (and (stringp host) (regexp-quote host)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 118960be5e..14624593e0 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -689,11 +689,34 @@ Do not change the value by `setq', it must be changed only by (tramp-cleanup-all-buffers)) ;; Set the value: (set-default symbol value) - ;; Reset `tramp-file-name-regexp'. - (setq tramp-file-name-regexp (tramp-file-name-regexp)) + ;; Reset the depending variables. + (with-no-warnings + (setq tramp-prefix-format (tramp-build-prefix-format) + tramp-prefix-regexp (tramp-build-prefix-regexp) + tramp-method-regexp (tramp-build-method-regexp) + tramp-postfix-method-format (tramp-build-postfix-method-format) + tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) + tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) + tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) + tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) + tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) + tramp-postfix-host-format (tramp-build-postfix-host-format) + tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) + tramp-remote-file-name-spec-regexp + (tramp-build-remote-file-name-spec-regexp) + tramp-file-name-structure (tramp-build-file-name-structure) + tramp-file-name-regexp (tramp-build-file-name-regexp) + tramp-completion-file-name-regexp + (tramp-build-completion-file-name-regexp))) ;; Rearrange file name handlers. (tramp-register-file-name-handlers))) +;; Initialize the Tramp syntax variables. We want to override initial +;; values of `tramp-file-name-regexp' and +;; `tramp-completion-file-name-regexp'. +(eval-after-load 'tramp + '(custom-set-variables `(tramp-syntax ',(tramp-compat-tramp-syntax)))) + (defun tramp-syntax-values () "Return possible values of `tramp-syntax', a list" (let ((values (cdr (get 'tramp-syntax 'custom-type)))) @@ -712,22 +735,19 @@ Raise an error if `tramp-syntax' is invalid." (separate . "/[")) "Alist mapping Tramp syntax to strings beginning Tramp file names.") -(defun tramp-prefix-format () - "String matching the very beginning of Tramp file names. -Used in `tramp-make-tramp-file-name'." +(defun tramp-build-prefix-format () (tramp-lookup-syntax tramp-prefix-format-alist)) -(defconst tramp-prefix-regexp-alist - (mapcar (lambda (x) - (cons (car x) (concat "^" (regexp-quote (cdr x))))) - tramp-prefix-format-alist) - "Alist of regexps matching the beginnings of Tramp file names. -Keyed by Tramp syntax. Derived from `tramp-prefix-format-alist'.") +(defvar tramp-prefix-format (tramp-build-prefix-format) + "String matching the very beginning of Tramp file names. +Used in `tramp-make-tramp-file-name'.") + +(defun tramp-build-prefix-regexp () + (concat "^" (regexp-quote tramp-prefix-format))) -(defun tramp-prefix-regexp () +(defvar tramp-prefix-regexp (tramp-build-prefix-regexp) "Regexp matching the very beginning of Tramp file names. -Should always start with \"^\". Derived from `tramp-prefix-format'." - (tramp-lookup-syntax tramp-prefix-regexp-alist)) +Should always start with \"^\". Derived from `tramp-prefix-format'.") (defconst tramp-method-regexp-alist '((default . "[a-zA-Z0-9-]+") @@ -735,34 +755,33 @@ Should always start with \"^\". Derived from `tramp-prefix-format'." (separate . "[a-zA-Z0-9-]*")) "Alist mapping Tramp syntax to regexps matching methods identifiers.") -(defun tramp-method-regexp () - "Regexp matching methods identifiers. -The `ftp' syntax does not support methods." +(defun tramp-build-method-regexp () (tramp-lookup-syntax tramp-method-regexp-alist)) +(defvar tramp-method-regexp (tramp-build-method-regexp) + "Regexp matching methods identifiers. +The `ftp' syntax does not support methods.") + (defconst tramp-postfix-method-format-alist '((default . ":") (simplified . "") (separate . "/")) "Alist mapping Tramp syntax to the delimiter after the method.") -(defun tramp-postfix-method-format () +(defun tramp-build-postfix-method-format () + (tramp-lookup-syntax tramp-postfix-method-format-alist)) + +(defvar tramp-postfix-method-format (tramp-build-postfix-method-format) "String matching delimiter between method and user or host names. The `ftp' syntax does not support methods. -Used in `tramp-make-tramp-file-name'." - (tramp-lookup-syntax tramp-postfix-method-format-alist)) +Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-method-regexp-alist - (mapcar (lambda (x) - (cons (car x) (regexp-quote (cdr x)))) - tramp-postfix-method-format-alist) - "Alist mapping Tramp syntax to regexp matching delimiter after method. -Derived from `tramp-postfix-method-format-alist'.") +(defun tramp-build-postfix-method-regexp () + (regexp-quote tramp-postfix-method-format)) -(defun tramp-postfix-method-regexp () +(defvar tramp-postfix-method-regexp (tramp-build-postfix-method-regexp) "Regexp matching delimiter between method and user or host names. -Derived from `tramp-postfix-method-format'." - (tramp-lookup-syntax tramp-postfix-method-regexp-alist)) +Derived from `tramp-postfix-method-format'.") (defconst tramp-user-regexp "[^/|: \t]+" "Regexp matching user names.") @@ -772,8 +791,7 @@ Derived from `tramp-postfix-method-format'." "String matching delimiter between user and domain names.") ;;;###tramp-autoload -(defconst tramp-prefix-domain-regexp - (regexp-quote tramp-prefix-domain-format) +(defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format) "Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") @@ -790,8 +808,7 @@ Derived from `tramp-prefix-domain-format'.") "String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") -(defconst tramp-postfix-user-regexp - (regexp-quote tramp-postfix-user-format) +(defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format) "Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") @@ -804,28 +821,24 @@ Derived from `tramp-postfix-user-format'.") (separate . "")) "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.") -(defun tramp-prefix-ipv6-format () - "String matching left hand side of IPv6 addresses. -Used in `tramp-make-tramp-file-name'." +(defun tramp-build-prefix-ipv6-format () (tramp-lookup-syntax tramp-prefix-ipv6-format-alist)) -(defconst tramp-prefix-ipv6-regexp-alist - (mapcar (lambda (x) - (cons (car x) (regexp-quote (cdr x)))) - tramp-prefix-ipv6-format-alist) - "Alist mapping Tramp syntax to regexp matching prefix of IPv6 addresses. -Derived from `tramp-prefix-ipv6-format-alist'") +(defvar tramp-prefix-ipv6-format (tramp-build-prefix-ipv6-format) + "String matching left hand side of IPv6 addresses. +Used in `tramp-make-tramp-file-name'.") + +(defun tramp-build-prefix-ipv6-regexp () + (regexp-quote tramp-prefix-ipv6-format)) -(defun tramp-prefix-ipv6-regexp () +(defvar tramp-prefix-ipv6-regexp (tramp-build-prefix-ipv6-regexp) "Regexp matching left hand side of IPv6 addresses. -Derived from `tramp-prefix-ipv6-format'." - (tramp-lookup-syntax tramp-prefix-ipv6-regexp-alist)) +Derived from `tramp-prefix-ipv6-format'.") ;; The following regexp is a bit sloppy. But it shall serve our ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in ;; "::ffff:192.168.0.1". -(defconst tramp-ipv6-regexp - "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+" +(defconst tramp-ipv6-regexp "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+" "Regexp matching IPv6 addresses.") (defconst tramp-postfix-ipv6-format-alist @@ -834,28 +847,24 @@ Derived from `tramp-prefix-ipv6-format'." (separate . "")) "Alist mapping Tramp syntax to suffix for IPv6 addresses.") -(defun tramp-postfix-ipv6-format () - "String matching right hand side of IPv6 addresses. -Used in `tramp-make-tramp-file-name'." +(defun tramp-build-postfix-ipv6-format () (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) -(defconst tramp-postfix-ipv6-regexp-alist - (mapcar (lambda (x) - (cons (car x) (regexp-quote (cdr x)))) - tramp-postfix-ipv6-format-alist) - "Alist mapping Tramp syntax to regexps matching IPv6 suffixes. -Derived from `tramp-postfix-ipv6-format-alist'.") +(defvar tramp-postfix-ipv6-format (tramp-build-postfix-ipv6-format) + "String matching right hand side of IPv6 addresses. +Used in `tramp-make-tramp-file-name'.") + +(defun tramp-build-postfix-ipv6-regexp () + (regexp-quote tramp-postfix-ipv6-format)) -(defun tramp-postfix-ipv6-regexp () +(defvar tramp-postfix-ipv6-regexp (tramp-build-postfix-ipv6-regexp) "Regexp matching right hand side of IPv6 addresses. -Derived from `tramp-postfix-ipv6-format'." - (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) +Derived from `tramp-postfix-ipv6-format'.") (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") -(defconst tramp-prefix-port-regexp - (regexp-quote tramp-prefix-port-format) +(defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format) "Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") @@ -871,8 +880,7 @@ Derived from `tramp-prefix-port-format'.") (defconst tramp-postfix-hop-format "|" "String matching delimiter after ad-hoc hop definitions.") -(defconst tramp-postfix-hop-regexp - (regexp-quote tramp-postfix-hop-format) +(defconst tramp-postfix-hop-regexp (regexp-quote tramp-postfix-hop-format) "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") @@ -882,22 +890,19 @@ Derived from `tramp-postfix-hop-format'.") (separate . "]")) "Alist mapping Tramp syntax to strings between host and local names.") -(defun tramp-postfix-host-format () - "String matching delimiter between host names and localnames. -Used in `tramp-make-tramp-file-name'." +(defun tramp-build-postfix-host-format () (tramp-lookup-syntax tramp-postfix-host-format-alist)) -(defconst tramp-postfix-host-regexp-alist - (mapcar (lambda (x) - (cons (car x) (regexp-quote (cdr x)))) - tramp-postfix-host-format-alist) - "Alist mapping Tramp syntax to regexp matching name delimiters. -Derived from `tramp-postfix-host-format-alist'.") +(defvar tramp-postfix-host-format (tramp-build-postfix-host-format) + "String matching delimiter between host names and localnames. +Used in `tramp-make-tramp-file-name'.") -(defun tramp-postfix-host-regexp () +(defun tramp-build-postfix-host-regexp () + (regexp-quote tramp-postfix-host-format)) + +(defvar tramp-postfix-host-regexp (tramp-build-postfix-host-regexp) "Regexp matching delimiter between host names and localnames. -Derived from `tramp-postfix-host-format'." - (tramp-lookup-syntax tramp-postfix-host-regexp-alist)) +Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp ".*$" "Regexp matching localnames.") @@ -910,48 +915,35 @@ Derived from `tramp-postfix-host-format'." ;;; File name format: -(defun tramp-build-remote-file-name-spec-regexp (syntax) - "Construct a regexp matching a Tramp file name for a Tramp SYNTAX." - (let ((tramp-syntax syntax)) - (concat - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" - "\\(" "\\(?:" tramp-host-regexp "\\|" - (tramp-prefix-ipv6-regexp) - "\\(?:" tramp-ipv6-regexp "\\)?" - (tramp-postfix-ipv6-regexp) "\\)?" - "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))) - -(defconst tramp-remote-file-name-spec-regexp-alist - `((default . ,(tramp-build-remote-file-name-spec-regexp 'default)) - (simplified . ,(tramp-build-remote-file-name-spec-regexp 'simplified)) - (separate . ,(tramp-build-remote-file-name-spec-regexp 'separate))) - "Alist mapping Tramp syntax to regexps matching Tramp file names.") - -(defun tramp-remote-file-name-spec-regexp () - "Regular expression matching a Tramp file name between prefix and postfix." - (tramp-lookup-syntax tramp-remote-file-name-spec-regexp-alist)) - -(defun tramp-build-file-name-structure (syntax) - "Construct the Tramp file name structure for SYNTAX. +(defun tramp-build-remote-file-name-spec-regexp () + "Construct a regexp matching a Tramp file name for a Tramp syntax. +It is expected, that `tramp-syntax' has the proper value." + (concat + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" + "\\(" "\\(?:" tramp-host-regexp "\\|" + tramp-prefix-ipv6-regexp "\\(?:" tramp-ipv6-regexp "\\)?" + tramp-postfix-ipv6-regexp "\\)" + "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")) + +(defvar tramp-remote-file-name-spec-regexp + (tramp-build-remote-file-name-spec-regexp) + "Regular expression matching a Tramp file name between prefix and postfix.") + +(defun tramp-build-file-name-structure () + "Construct the Tramp file name structure for a Tramp syntax. +It is expected, that `tramp-syntax' has the proper value. See `tramp-file-name-structure'." - (let ((tramp-syntax syntax)) - (list - (concat - (tramp-prefix-regexp) - "\\(" "\\(?:" (tramp-remote-file-name-spec-regexp) - tramp-postfix-hop-regexp "\\)+" "\\)?" - (tramp-remote-file-name-spec-regexp) (tramp-postfix-host-regexp) - "\\(" tramp-localname-regexp "\\)") - 5 6 7 8 1))) - -(defconst tramp-file-name-structure-alist - `((default . ,(tramp-build-file-name-structure 'default)) - (simplified . ,(tramp-build-file-name-structure 'simplified)) - (separate . ,(tramp-build-file-name-structure 'separate))) - "Alist mapping Tramp syntax to the file name structure for that syntax.") - -(defun tramp-file-name-structure () + (list + (concat + tramp-prefix-regexp + "\\(" "\\(?:" tramp-remote-file-name-spec-regexp + tramp-postfix-hop-regexp "\\)+" "\\)?" + tramp-remote-file-name-spec-regexp tramp-postfix-host-regexp + "\\(" tramp-localname-regexp "\\)") + 5 6 7 8 1)) + +(defvar tramp-file-name-structure (tramp-build-file-name-structure) "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \ the Tramp file name structure. @@ -969,25 +961,22 @@ cascade of several hops. These numbers are passed directly to `match-string', which see. That means the opening parentheses are counted to identify the pair. -See also `tramp-file-name-regexp'." - (tramp-lookup-syntax tramp-file-name-structure-alist)) +See also `tramp-file-name-regexp'.") -(defun tramp-file-name-regexp () - "Regular expression matching file names handled by Tramp. -This regexp should match Tramp file names but no other file names." - (car (tramp-file-name-structure))) +(defun tramp-build-file-name-regexp () + (car tramp-file-name-structure)) ;;;###autoload (defconst tramp-initial-file-name-regexp "\\`/.+:.*:" "Value for `tramp-file-name-regexp' for autoload. It must match the initial `tramp-syntax' settings.") -;; External packages use constant `tramp-file-name-regexp'. In order -;; not to break them, we still provide it. It is a variable now. ;;;###autoload (defvar tramp-file-name-regexp tramp-initial-file-name-regexp - "Value for `tramp-file-name-regexp' for autoload. -It must match the initial `tramp-syntax' settings.") + "Regular expression matching file names handled by Tramp. +This regexp should match Tramp file names but no other file +names. When calling `tramp-register-file-name-handlers', the +initial value is overwritten by the car of `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-completion-file-name-regexp-default @@ -1031,7 +1020,17 @@ On W32 systems, the volume letter must be ignored.") "Value for `tramp-completion-file-name-regexp' for separate remoting. See `tramp-file-name-structure' for more explanations.") -(defun tramp-completion-file-name-regexp () +(defconst tramp-completion-file-name-regexp-alist + `((default . ,tramp-completion-file-name-regexp-default) + (simplified . ,tramp-completion-file-name-regexp-simplified) + (separate . ,tramp-completion-file-name-regexp-separate)) + "Alist mapping incomplete Tramp file names.") + +(defun tramp-build-completion-file-name-regexp () + (tramp-lookup-syntax tramp-completion-file-name-regexp-alist)) + +(defvar tramp-completion-file-name-regexp + (tramp-build-completion-file-name-regexp) "Regular expression matching file names handled by Tramp completion. This regexp should match partial Tramp file names only. @@ -1040,14 +1039,7 @@ this file \(tramp.el) is loaded. This means that this variable must be set before loading tramp.el. Alternatively, `file-name-handler-alist' can be updated after changing this variable. -Also see `tramp-file-name-structure'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) - tramp-completion-file-name-regexp-default) - ((eq (tramp-compat-tramp-syntax) 'simplified) - tramp-completion-file-name-regexp-simplified) - ((eq (tramp-compat-tramp-syntax) 'separate) - tramp-completion-file-name-regexp-separate) - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) +Also see `tramp-file-name-structure'.") ;;;###autoload (defconst tramp-initial-completion-file-name-regexp @@ -1284,7 +1276,7 @@ entry does not exist, return nil." (if (memq system-type '(cygwin windows-nt)) "^/[[:alpha:]]?:" "^/:") name)) - (string-match (tramp-file-name-regexp) name)))) + (string-match tramp-file-name-regexp name)))) (defun tramp-find-method (method user host) "Return the right method string to use. @@ -1356,13 +1348,13 @@ values." (save-match-data (unless (tramp-tramp-file-p name) (tramp-compat-user-error nil "Not a Tramp file name: \"%s\"" name)) - (if (not (string-match (nth 0 (tramp-file-name-structure)) name)) + (if (not (string-match (nth 0 tramp-file-name-structure) name)) (error "`tramp-file-name-structure' didn't match!") - (let ((method (match-string (nth 1 (tramp-file-name-structure)) name)) - (user (match-string (nth 2 (tramp-file-name-structure)) name)) - (host (match-string (nth 3 (tramp-file-name-structure)) name)) - (localname (match-string (nth 4 (tramp-file-name-structure)) name)) - (hop (match-string (nth 5 (tramp-file-name-structure)) name)) + (let ((method (match-string (nth 1 tramp-file-name-structure) name)) + (user (match-string (nth 2 tramp-file-name-structure) name)) + (host (match-string (nth 3 tramp-file-name-structure) name)) + (localname (match-string (nth 4 tramp-file-name-structure) name)) + (hop (match-string (nth 5 tramp-file-name-structure) name)) domain port) (when user (when (string-match tramp-user-with-domain-regexp user) @@ -1373,9 +1365,9 @@ values." (when (string-match tramp-host-with-port-regexp host) (setq port (match-string 2 host) host (match-string 1 host))) - (when (string-match (tramp-prefix-ipv6-regexp) host) + (when (string-match tramp-prefix-ipv6-regexp host) (setq host (replace-match "" nil t host))) - (when (string-match (tramp-postfix-ipv6-regexp) host) + (when (string-match tramp-postfix-ipv6-regexp host) (setq host (replace-match "" nil t host)))) (unless nodefault @@ -1400,42 +1392,41 @@ values." (method user domain host port localname &optional hop) "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. When not nil, optional DOMAIN, PORT and HOP are used." - (concat (tramp-prefix-format) hop + (concat tramp-prefix-format hop (unless (or (zerop (length method)) - (zerop (length (tramp-postfix-method-format)))) - (concat method (tramp-postfix-method-format))) + (zerop (length tramp-postfix-method-format))) + (concat method tramp-postfix-method-format)) user (unless (zerop (length domain)) (concat tramp-prefix-domain-format domain)) (unless (zerop (length user)) - tramp-postfix-user-format) + tramp-postfix-user-format) (when host (if (string-match tramp-ipv6-regexp host) - (concat - (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format)) + (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host)) (unless (zerop (length port)) (concat tramp-prefix-port-format port)) - (tramp-postfix-host-format) + tramp-postfix-host-format (when localname localname))) (defun tramp-completion-make-tramp-file-name (method user host localname) "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. It must not be a complete Tramp file name, but as long as there are necessary only. This function will be used in file name completion." - (concat (tramp-prefix-format) + (concat tramp-prefix-format (unless (or (zerop (length method)) - (zerop (length (tramp-postfix-method-format)))) - (concat method (tramp-postfix-method-format))) + (zerop (length tramp-postfix-method-format))) + (concat method tramp-postfix-method-format)) (unless (zerop (length user)) (concat user tramp-postfix-user-format)) (unless (zerop (length host)) (concat (if (string-match tramp-ipv6-regexp host) (concat - (tramp-prefix-ipv6-format) host (tramp-postfix-ipv6-format)) + tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) host) - (tramp-postfix-host-format))) + tramp-postfix-host-format)) (when localname localname))) (defun tramp-get-buffer (vec) @@ -1947,7 +1938,7 @@ special handling of `substitute-in-file-name'." 'tramp-rfn-eshadow-setup-minibuffer))) (defun tramp-rfn-eshadow-update-overlay-regexp () - (format "[^%s/~]*\\(/\\|~\\)" (tramp-postfix-host-format))) + (format "[^%s/~]*\\(/\\|~\\)" tramp-postfix-host-format)) (defun tramp-rfn-eshadow-update-overlay () "Update `rfn-eshadow-overlay' to cover shadowed part of minibuffer input. @@ -2365,11 +2356,11 @@ remote file names." ;; property of `tramp-file-name-handler', this shall be done by the ;; respective foreign handlers. (add-to-list 'file-name-handler-alist - (cons (tramp-file-name-regexp) 'tramp-file-name-handler)) + (cons tramp-file-name-regexp 'tramp-file-name-handler)) (put 'tramp-file-name-handler 'safe-magic t) (add-to-list 'file-name-handler-alist - (cons (tramp-completion-file-name-regexp) + (cons tramp-completion-file-name-regexp 'tramp-completion-file-name-handler)) (put 'tramp-completion-file-name-handler 'safe-magic t) ;; Mark `operations' the handler is responsible for. @@ -2473,8 +2464,8 @@ not in completion mode." ;; Suppress hop from completion. (when (string-match (concat - (tramp-prefix-regexp) - "\\(" "\\(" (tramp-remote-file-name-spec-regexp) + tramp-prefix-regexp + "\\(" "\\(" tramp-remote-file-name-spec-regexp tramp-postfix-hop-regexp "\\)+" "\\)") fullname) @@ -2519,9 +2510,8 @@ not in completion mode." ;; Unify list, add hop, remove nil elements. (dolist (elt result) (when elt - (string-match (tramp-prefix-regexp) elt) - (setq elt - (replace-match (concat (tramp-prefix-format) hop) nil nil elt)) + (string-match tramp-prefix-regexp elt) + (setq elt (replace-match (concat tramp-prefix-format hop) nil nil elt)) (push (substring elt (length (tramp-drop-volume-letter directory))) result1))) @@ -2569,58 +2559,58 @@ They are collected by `tramp-completion-dissect-file-name1'." (tramp-completion-ipv6-regexp (format "[^%s]*" - (if (zerop (length (tramp-postfix-ipv6-format))) - (tramp-postfix-host-format) - (tramp-postfix-ipv6-format)))) + (if (zerop (length tramp-postfix-ipv6-format)) + tramp-postfix-host-format + tramp-postfix-ipv6-format))) ;; "/method" "/[method" (tramp-completion-file-name-structure1 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) x-nil "\\)$") + tramp-prefix-regexp + "\\(" tramp-method-regexp x-nil "\\)$") 1 nil nil nil)) ;; "/method:user" "/[method/user" (tramp-completion-file-name-structure2 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(" tramp-user-regexp x-nil "\\)$") + tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + "\\(" tramp-user-regexp x-nil "\\)$") 1 2 nil nil)) ;; "/method:host" "/[method/host" (tramp-completion-file-name-structure3 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(" tramp-host-regexp x-nil "\\)$") + tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + "\\(" tramp-host-regexp x-nil "\\)$") 1 nil 2 nil)) ;; "/method:[ipv6" "/[method/ipv6" (tramp-completion-file-name-structure4 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - (tramp-prefix-ipv6-regexp) + tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + tramp-prefix-ipv6-regexp "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") 1 nil 2 nil)) ;; "/method:user@host" "/[method/user@host" (tramp-completion-file-name-structure5 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - "\\(" tramp-host-regexp x-nil "\\)$") + tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp + "\\(" tramp-host-regexp x-nil "\\)$") 1 2 3 nil)) ;; "/method:user@[ipv6" "/[method/user@ipv6" (tramp-completion-file-name-structure6 (list (concat - (tramp-prefix-regexp) - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp - (tramp-prefix-ipv6-regexp) + tramp-prefix-regexp + "\\(" tramp-method-regexp "\\)" tramp-postfix-method-regexp + "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp + tramp-prefix-ipv6-regexp "\\(" tramp-completion-ipv6-regexp x-nil "\\)$") 1 2 3 nil))) (delq @@ -4479,10 +4469,10 @@ Invokes `password-read' if available, `read-passwd' else." (tramp-clear-passwd (tramp-dissect-file-name (concat - (tramp-prefix-format) + tramp-prefix-format (replace-regexp-in-string (concat tramp-postfix-hop-regexp "$") - (tramp-postfix-host-format) hop))))) + tramp-postfix-host-format hop))))) (auth-source-forget `(:max 1 ,(and user-domain :user) ,user-domain :host ,host-port :port ,method)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4139d50ff0..13e2e30cab 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2852,16 +2852,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-change-syntax syntax) (let ;; This is needed for the `simplified' syntax. ((method-marker - (if (zerop (length (tramp-method-regexp))) + (if (zerop (length tramp-method-regexp)) "" tramp-default-method-marker)) ;; This is needed for the `separate' syntax. - (prefix-format (substring (tramp-prefix-format) 1))) + (prefix-format (substring tramp-prefix-format 1))) ;; Complete method name. (unless (or (zerop (length method)) - (zerop (length (tramp-method-regexp)))) + (zerop (length tramp-method-regexp))) (should (member - (concat prefix-format method (tramp-postfix-method-format)) + (concat prefix-format method tramp-postfix-method-format) (file-name-all-completions (concat prefix-format (substring method 0 1)) "/")))) ;; Complete host name for default method. With gvfs @@ -2873,25 +2873,25 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (member (concat - prefix-format method-marker (tramp-postfix-method-format) - host (tramp-postfix-host-format)) + prefix-format method-marker tramp-postfix-method-format + host tramp-postfix-host-format) (file-name-all-completions (concat - prefix-format method-marker (tramp-postfix-method-format) + prefix-format method-marker tramp-postfix-method-format (substring host 0 1)) "/"))))) ;; Complete host name. (unless (or (zerop (length method)) - (zerop (length (tramp-method-regexp))) + (zerop (length tramp-method-regexp)) (zerop (length host)) (tramp--test-gvfs-p method)) (should (member (concat - prefix-format method (tramp-postfix-method-format) - host (tramp-postfix-host-format)) + prefix-format method tramp-postfix-method-format + host tramp-postfix-host-format) (file-name-all-completions - (concat prefix-format method (tramp-postfix-method-format)) + (concat prefix-format method tramp-postfix-method-format) "/")))))) ;; Cleanup. commit 29963648dd11d53088f753e4f9b0491a7b981c0f Author: Paul Eggert Date: Sun Sep 10 23:04:10 2017 -0700 Port tramp-tests to new copy-directory behavior * test/lisp/net/tramp-tests.el (tramp-test15-copy-directory): Use directory name as arg for copy-directory when we want the special behavior. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 735211c3da..4139d50ff0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2117,7 +2117,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (should (file-directory-p tmp-name2)) (should (file-exists-p tmp-name5)) ;; Target directory does exist already. - (copy-directory tmp-name1 tmp-name2) + (copy-directory tmp-name1 (file-name-as-directory tmp-name2)) (should (file-directory-p tmp-name3)) (should (file-exists-p tmp-name6))) @@ -2140,7 +2140,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Target directory does exist already. (delete-file tmp-name5) (should-not (file-exists-p tmp-name5)) - (copy-directory tmp-name1 tmp-name2 nil 'parents 'contents) + (copy-directory tmp-name1 (file-name-as-directory tmp-name2) + nil 'parents 'contents) (should (file-directory-p tmp-name2)) (should (file-exists-p tmp-name5)) (should-not (file-directory-p tmp-name3)) commit 2aa028825920207cca2bacb581111ab780e5d9ee Author: Paul Eggert Date: Sun Sep 10 22:28:08 2017 -0700 Adjust thumbs to new rename-file behavior * etc/NEWS: Mention this. * lisp/thumbs.el (thumbs-rename-images): Treat the destination as special only if it is a directory name. When there is a marked list, turn the destination into a directory name if it is not already. diff --git a/etc/NEWS b/etc/NEWS index fc40a3a55e..3f1df23ec3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1287,7 +1287,7 @@ can be written as (rename-file C (file-name-as-directory D)), a formulation portable to both older and newer versions of Emacs. Affected functions include add-name-to-file, copy-directory, copy-file, format-write-file, gnus-copy-file, make-symbolic-link, -rename-file, and write-file. +rename-file, thumbs-rename-images, and write-file. * Lisp Changes in Emacs 26.1 diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 0665429246..d0b5e22414 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -523,23 +523,16 @@ Open another window." (interactive "FRename to file or directory: ") (let ((files (or thumbs-marked-list (list (thumbs-current-image)))) failures) - (if (and (not (file-directory-p newfile)) - thumbs-marked-list) - (if (file-exists-p newfile) - (error "Renaming marked files to file name `%s'" newfile) - (make-directory newfile t))) + (when thumbs-marked-list + (make-directory newfile t) + (setq newfile (file-name-as-directory newfile))) (if (yes-or-no-p (format "Really rename %d files? " (length files))) (let ((thumbs-file-list (thumbs-file-alist)) (inhibit-read-only t)) (dolist (file files) (let (failure) (condition-case () - (if (file-directory-p newfile) - (rename-file file - (expand-file-name - (file-name-nondirectory file) - newfile)) - (rename-file file newfile)) + (rename-file file newfile) (file-error (setq failure t) (push file failures))) (unless failure commit 74b8615fcceba7b92c4938e1bcc92015f10ae899 Author: Paul Eggert Date: Sun Sep 10 22:22:55 2017 -0700 Adjust ob-tangle to new copy-file behavior * lisp/org/ob-tangle.el (org-babel-tangle-publish): Port to new copy-file behavior. diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 3b0533261c..2dc55caf89 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -197,6 +197,7 @@ Return a list whose CAR is the tangled file name." "Tangle FILENAME and place the results in PUB-DIR." (unless (file-exists-p pub-dir) (make-directory pub-dir t)) + (setq pub-dir (file-name-as-directory pub-dir)) (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload commit 739593d68742f45e4e35dfc99573c47a5031b646 Author: Paul Eggert Date: Sun Sep 10 22:21:20 2017 -0700 Make gnus-copy-file act like copy-file etc. * etc/NEWS: Mention this. * lisp/gnus/gnus-util.el (gnus-copy-file): Treat the destination as special only if it is a directory name. diff --git a/etc/NEWS b/etc/NEWS index 4da4c37a3c..fc40a3a55e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1286,8 +1286,8 @@ call like (rename-file C D) that used the old, undocumented behavior can be written as (rename-file C (file-name-as-directory D)), a formulation portable to both older and newer versions of Emacs. Affected functions include add-name-to-file, copy-directory, -copy-file, format-write-file, make-symbolic-link, rename-file, and -write-file. +copy-file, format-write-file, gnus-copy-file, make-symbolic-link, +rename-file, and write-file. * Lisp Changes in Emacs 26.1 diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b509d8ad44..93541f0db6 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -594,9 +594,6 @@ If N, return the Nth ancestor instead." (read-file-name "Copy file to: " default-directory))) (unless to (setq to (read-file-name "Copy file to: " default-directory))) - (when (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) (copy-file file to)) (defvar gnus-work-buffer " *gnus work*") commit 61946d991b663c9d35a50b758d0108c3cbf8027b Author: Paul Eggert Date: Sun Sep 10 22:19:01 2017 -0700 Make write-file act like copy-file etc. Change write-file to be consistent with the new behavior of copy-file, etc. * etc/NEWS: Mention this. * lisp/files.el (write-file): Treat the destination as special only if it is a directory name. diff --git a/etc/NEWS b/etc/NEWS index 136d458254..4da4c37a3c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1286,7 +1286,8 @@ call like (rename-file C D) that used the old, undocumented behavior can be written as (rename-file C (file-name-as-directory D)), a formulation portable to both older and newer versions of Emacs. Affected functions include add-name-to-file, copy-directory, -copy-file, make-symbolic-link, and rename-file. +copy-file, format-write-file, make-symbolic-link, rename-file, and +write-file. * Lisp Changes in Emacs 26.1 diff --git a/lisp/files.el b/lisp/files.el index 7ab6f769a8..611a4c5a6f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4212,10 +4212,10 @@ Interactively, confirmation is required unless you supply a prefix argument." (not current-prefix-arg))) (or (null filename) (string-equal filename "") (progn - ;; If arg is just a directory, + ;; If arg is a directory name, ;; use the default file name, but in that directory. - (if (file-directory-p filename) - (setq filename (concat (file-name-as-directory filename) + (if (directory-name-p filename) + (setq filename (concat filename (file-name-nondirectory (or buffer-file-name (buffer-name)))))) (and confirm commit e22794867d878d53675fcc91d2ef1ad2494a2ff2 Author: Paul Eggert Date: Sun Sep 10 22:07:30 2017 -0700 Make copy-directory act like copy-file etc. Do the special dance with the destination only if it is a directory name, for consistency with copy-file etc. (Bug#27986). * doc/emacs/files.texi (Copying and Naming): * doc/lispref/files.texi (Create/Delete Dirs): * etc/NEWS: Document this. * lisp/files.el (copy-directory): Treat NEWNAME as special only if it is a directory name. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 0cf46b6df1..ca4f223953 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1572,10 +1572,10 @@ file @var{new}. @findex copy-directory @kbd{M-x copy-directory} copies directories, similar to the -@command{cp -r} shell command. If @var{new} is an existing directory, -it creates a copy of the @var{old} directory and puts it in @var{new}. -If @var{new} is not an existing directory, it copies all the contents -of @var{old} into a new directory named @var{new}. +@command{cp -r} shell command. If @var{new} is a directory name, it +creates a copy of the @var{old} directory and puts it in @var{new}. +Otherwise it copies all the contents of @var{old} into a new directory +named @var{new}. @cindex renaming files @findex rename-file diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index eacaf04637..901382fe9b 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2976,8 +2976,9 @@ if they don't already exist. @deffn Command copy-directory dirname newname &optional keep-time parents copy-contents This command copies the directory named @var{dirname} to -@var{newname}. If @var{newname} names an existing directory, +@var{newname}. If @var{newname} is a directory name, @var{dirname} will be copied to a subdirectory there. +@xref{Directory Names}. It always sets the file modes of the copied files to match the corresponding original file. @@ -2992,7 +2993,7 @@ this happens by default. The fifth argument @var{copy-contents}, if non-@code{nil}, means to copy the contents of @var{dirname} directly into @var{newname} if the -latter is an existing directory, instead of copying @var{dirname} into +latter is a directory name, instead of copying @var{dirname} into it as a subdirectory. @end deffn diff --git a/etc/NEWS b/etc/NEWS index 4187dd8a30..136d458254 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1285,8 +1285,8 @@ documentation and had inherent races that led to security holes. A call like (rename-file C D) that used the old, undocumented behavior can be written as (rename-file C (file-name-as-directory D)), a formulation portable to both older and newer versions of Emacs. -Affected functions include add-name-to-file, copy-file, -make-symbolic-link, and rename-file. +Affected functions include add-name-to-file, copy-directory, +copy-file, make-symbolic-link, and rename-file. * Lisp Changes in Emacs 26.1 diff --git a/lisp/files.el b/lisp/files.el index 85e649fbb5..7ab6f769a8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5501,10 +5501,10 @@ Noninteractively, the last argument PARENTS says whether to create parent directories if they don't exist. Interactively, this happens by default. -If NEWNAME names an existing directory, copy DIRECTORY as a -subdirectory there. However, if called from Lisp with a non-nil -optional argument COPY-CONTENTS, copy the contents of DIRECTORY -directly into NEWNAME instead." +If NEWNAME is a directory name, copy DIRECTORY as a subdirectory +there. However, if called from Lisp with a non-nil optional +argument COPY-CONTENTS, copy the contents of DIRECTORY directly +into NEWNAME instead." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -5526,19 +5526,17 @@ directly into NEWNAME instead." ;; Compute target name. (setq directory (directory-file-name (expand-file-name directory)) - newname (directory-file-name (expand-file-name newname))) + newname (expand-file-name newname)) - (cond ((not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; + (cond ((not (directory-name-p newname)) + ;; If NEWNAME is not a directory name, create it; ;; that is where we will copy the files of DIRECTORY. (make-directory newname parents)) - ;; If NEWNAME is an existing directory and COPY-CONTENTS + ;; If NEWNAME is a directory name and COPY-CONTENTS ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. ((not copy-contents) - (setq newname (concat - (file-name-as-directory newname) - (file-name-nondirectory - (directory-file-name directory)))) + (setq newname (concat newname + (file-name-nondirectory directory))) (and (file-exists-p newname) (not (file-directory-p newname)) (error "Cannot overwrite non-directory %s with a directory" commit cf9891e14e48a93bca2065fdd7998f5f677786dc Author: Paul Eggert Date: Sun Sep 10 20:37:17 2017 -0700 Fix some make-directory bugs * lisp/files.el (files--ensure-directory): New function. (make-directory): Use it to avoid bugs when (make-directory FOO t) is invoked on a non-directory, or on a directory hierarchy that is being built by some other process while Emacs is running. * test/lisp/files-tests.el (files-tests--make-directory): New test. diff --git a/lisp/files.el b/lisp/files.el index 43aec8173d..85e649fbb5 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5320,6 +5320,14 @@ instance of such commands." (rename-buffer (generate-new-buffer-name base-name)) (force-mode-line-update)))) +(defun files--ensure-directory (dir) + "Make directory DIR if it is not already a directory. Return nil." + (condition-case err + (make-directory-internal dir) + (file-already-exists + (unless (file-directory-p dir) + (signal (car err) (cdr err)))))) + (defun make-directory (dir &optional parents) "Create the directory DIR and optionally any nonexistent parent dirs. If DIR already exists as a directory, signal an error, unless @@ -5348,18 +5356,19 @@ raised." (if (not parents) (make-directory-internal dir) (let ((dir (directory-file-name (expand-file-name dir))) - create-list) - (while (and (not (file-exists-p dir)) - ;; If directory is its own parent, then we can't - ;; keep looping forever - (not (equal dir - (directory-file-name - (file-name-directory dir))))) + create-list parent) + (while (progn + (setq parent (directory-file-name + (file-name-directory dir))) + (condition-case err + (files--ensure-directory dir) + (file-missing + ;; Do not loop if root does not exist (Bug#2309). + (not (string= dir parent))))) (setq create-list (cons dir create-list) - dir (directory-file-name (file-name-directory dir)))) - (while create-list - (make-directory-internal (car create-list)) - (setq create-list (cdr create-list)))))))) + dir parent)) + (dolist (dir create-list) + (files--ensure-directory dir))))))) (defconst directory-files-no-dot-files-regexp "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*" diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index a2f2b74312..b52965a02b 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -344,6 +344,27 @@ be invoked with the right arguments." (cdr path-res) (insert-directory-wildcard-in-dir-p (car path-res))))))) +(ert-deftest files-tests--make-directory () + (let* ((dir (make-temp-file "files-mkdir-test" t)) + (dirname (file-name-as-directory dir)) + (file (concat dirname "file")) + (subdir1 (concat dirname "subdir1")) + (subdir2 (concat dirname "subdir2")) + (a/b (concat dirname "a/b"))) + (write-region "" nil file) + (should-error (make-directory "/")) + (should-not (make-directory "/" t)) + (should-error (make-directory dir)) + (should-not (make-directory dir t)) + (should-error (make-directory dirname)) + (should-not (make-directory dirname t)) + (should-error (make-directory file)) + (should-error (make-directory file t)) + (should-not (make-directory subdir1)) + (should-not (make-directory subdir2 t)) + (should-error (make-directory a/b)) + (should-not (make-directory a/b t)))) + (provide 'files-tests) ;;; files-tests.el ends here commit 01c885f21f343045783eb9ad1ff5f9b83d6cd789 Author: Paul Eggert Date: Sun Sep 10 15:39:24 2017 -0700 Fix race with rename-file etc. with dir NEWNAME This changes the behavior of rename-file etc. slightly. The old behavior mostly disagreed with the documentation, and had a race condition bug that could allow attackers to modify victims' write-protected directories (Bug#27986). * doc/lispref/files.texi (Changing Files): Document that in rename-file etc., NEWFILE is special if it is a directory name. * etc/NEWS: Document the change in behavior. * src/fileio.c (directory_like): Remove. All uses removed. (expand_cp_target): Test only whether NEWNAME is a directory name, not whether it is currently a directory. This avoids a race. (Fcopy_file, Frename_file, Fadd_name_to_file, Fmake_symbolic_link): Document behavior if NEWNAME is a directory name. (Frename_file): Simplify now that the destdir behavior occurs only when NEWNAME is a directory name. * test/lisp/net/tramp-tests.el (tramp-test11-copy-file) (tramp-test12-rename-file, tramp--test-check-files): Adjust tests to match new behavior. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index b9bfbd72ce..0cf46b6df1 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1558,7 +1558,8 @@ In all these commands, if the argument @var{new} is just a directory name, the real new name is in that directory, with the same non-directory component as @var{old}. For example, the command @w{@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp/ @key{RET}}} -renames @file{~/foo} to @file{/tmp/foo}. @xref{Directory Names,,, +renames @file{~/foo} to @file{/tmp/foo}. On GNU and other POSIX-like +systems, directory names end in @samp{/}. @xref{Directory Names,,, elisp, the Emacs Lisp Reference Manual}. All these commands ask for confirmation when the new file name already diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index edee30e5ad..eacaf04637 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1563,15 +1563,15 @@ a @code{file-missing} error instead. made by these functions instead of writing them immediately to secondary storage. @xref{Files and Storage}. -@c FIXME: This paragraph is purposely silent on what happens if -@c @var{newname} is not a directory name but happens to name a -@c directory. See Bug#27986 for discussion on how to clear this up. In the functions that have an argument @var{newname}, if this argument is a directory name it is treated as if the nondirectory part of the source name were appended. Typically, a directory name is one that ends in @samp{/} (@pxref{Directory Names}). For example, if the old name is @file{a/b/c}, the @var{newname} @file{d/e/f/} is treated -as if it were @file{d/e/f/c}. +as if it were @file{d/e/f/c}. This special treatment does not apply +if @var{newname} is not a directory name but names a file that is a +directory; for example, the @var{newname} @file{d/e/f} is left as-is +even if @file{d/e/f} happens to be a directory. In the functions that have an argument @var{newname}, if a file by the name of @var{newname} already exists, the actions taken depend on the diff --git a/etc/NEWS b/etc/NEWS index 3f7feba6dd..4187dd8a30 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1271,6 +1271,23 @@ handlers now. gtk_window_move for moving frames and ignores the value of the variable 'x-gtk-use-window-move'. The variable is now obsolete. ++++ +** Several functions that create or rename files now treat their +destination argument specially only when it is a directory name, i.e., +when it ends in '/' on GNU and other POSIX-like systems. When the +destination argument D of one of these functions is an existing +directory and the intent is to act on an entry in that directory, D +should now be a directory name. For example, (rename-file "e" "f/") +renames to 'f/e'. Although this formerly happened sometimes even when +D was not a directory name, as in (rename-file "e" "f") where 'f' +happened to be a directory, the old behavior often contradicted the +documentation and had inherent races that led to security holes. A +call like (rename-file C D) that used the old, undocumented behavior +can be written as (rename-file C (file-name-as-directory D)), a +formulation portable to both older and newer versions of Emacs. +Affected functions include add-name-to-file, copy-file, +make-symbolic-link, and rename-file. + * Lisp Changes in Emacs 26.1 diff --git a/src/fileio.c b/src/fileio.c index a1cea94c0b..3195348a8c 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -595,24 +595,16 @@ DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0, return IS_DIRECTORY_SEP (c) ? Qt : Qnil; } -/* Return true if NAME must be that of a directory if it exists. - When NAME is a directory name, this avoids system calls compared to - just calling Ffile_directory_p. */ - -static bool -directory_like (Lisp_Object name) -{ - return !NILP (Fdirectory_name_p (name)) || !NILP (Ffile_directory_p (name)); -} - -/* Return the expansion of NEWNAME, except that if NEWNAME is like a - directory then return the expansion of FILE's basename under - NEWNAME. This is like how 'cp FILE NEWNAME' works. */ +/* Return the expansion of NEWNAME, except that if NEWNAME is a + directory name then return the expansion of FILE's basename under + NEWNAME. This resembles how 'cp FILE NEWNAME' works, except that + it requires NEWNAME to be a directory name (typically, by ending in + "/"). */ static Lisp_Object expand_cp_target (Lisp_Object file, Lisp_Object newname) { - return (directory_like (newname) + return (!NILP (Fdirectory_name_p (newname)) ? Fexpand_file_name (Ffile_name_nondirectory (file), newname) : Fexpand_file_name (newname, Qnil)); } @@ -1833,7 +1825,8 @@ clone_file (int dest, int source) DEFUN ("copy-file", Fcopy_file, Scopy_file, 2, 6, "fCopy file: \nGCopy %s to file: \np\nP", doc: /* Copy FILE to NEWNAME. Both args must be strings. -If NEWNAME names a directory, copy FILE there. +If NEWNAME is a directory name, copy FILE to a like-named file under +NEWNAME. This function always sets the file modes of the output file to match the input file. @@ -2257,6 +2250,9 @@ DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, "fRename file: \nGRename %s to file: \np", doc: /* Rename FILE as NEWNAME. Both args must be strings. If file has names other than FILE, it continues to have those names. +If NEWNAME is a directory name, rename FILE to a like-named file under +NEWNAME. + Signal a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. An integer third arg means request confirmation if NEWNAME already exists. @@ -2265,7 +2261,6 @@ This is what happens in interactive use with M-x. */) { Lisp_Object handler; Lisp_Object encoded_file, encoded_newname, symlink_target; - int dirp = -1; file = Fexpand_file_name (file, Qnil); @@ -2339,22 +2334,21 @@ This is what happens in interactive use with M-x. */) if (rename_errno != EXDEV) report_file_errno ("Renaming", list2 (file, newname), rename_errno); - symlink_target = Ffile_symlink_p (file); - if (!NILP (symlink_target)) - Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); + bool dirp = !NILP (Fdirectory_name_p (file)); + if (dirp) + call4 (Qcopy_directory, file, newname, Qt, Qnil); else { - if (dirp < 0) - dirp = directory_like (file); - if (dirp) - call4 (Qcopy_directory, file, newname, Qt, Qnil); + symlink_target = Ffile_symlink_p (file); + if (!NILP (symlink_target)) + Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); else Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); } ptrdiff_t count = SPECPDL_INDEX (); specbind (Qdelete_by_moving_to_trash, Qnil); - if (dirp && NILP (symlink_target)) + if (dirp) call2 (Qdelete_directory, file, Qt); else Fdelete_file (file, Qnil); @@ -2364,6 +2358,9 @@ This is what happens in interactive use with M-x. */) DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, "fAdd name to file: \nGName to add to %s: \np", doc: /* Give FILE additional name NEWNAME. Both args must be strings. +If NEWNAME is a directory name, give FILE a like-named new name under +NEWNAME. + Signal a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. An integer third arg means request confirmation if NEWNAME already exists. @@ -2412,11 +2409,13 @@ This is what happens in interactive use with M-x. */) DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, "FMake symbolic link to file: \nGMake symbolic link to file %s: \np", - doc: /* Make a symbolic link to TARGET, named LINKNAME. -Both args must be strings. -Signal a `file-already-exists' error if a file LINKNAME already exists + doc: /* Make a symbolic link to TARGET, named NEWNAME. +If NEWNAME is a directory name, make a like-named symbolic link under +NEWNAME. + +Signal a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -An integer third arg means request confirmation if LINKNAME already +An integer third arg means request confirmation if NEWNAME already exists, and expand leading "~" or strip leading "/:" in TARGET. This happens for interactive use with M-x. */) (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index c61e5dc9eb..735211c3da 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1903,7 +1903,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-error (copy-file tmp-name1 tmp-name2)) (copy-file tmp-name1 tmp-name2 'ok) (make-directory tmp-name3) - (copy-file tmp-name1 tmp-name3) + (copy-file tmp-name1 (file-name-as-directory tmp-name3)) (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name3)))) @@ -1925,7 +1925,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-error (copy-file tmp-name1 tmp-name4)) (copy-file tmp-name1 tmp-name4 'ok) (make-directory tmp-name5) - (copy-file tmp-name1 tmp-name5) + (copy-file tmp-name1 (file-name-as-directory tmp-name5)) (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name1) tmp-name5)))) @@ -1947,7 +1947,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-error (copy-file tmp-name4 tmp-name1)) (copy-file tmp-name4 tmp-name1 'ok) (make-directory tmp-name3) - (copy-file tmp-name4 tmp-name3) + (copy-file tmp-name4 (file-name-as-directory tmp-name3)) (should (file-exists-p (expand-file-name (file-name-nondirectory tmp-name4) tmp-name3)))) @@ -1986,7 +1986,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name3) - (rename-file tmp-name1 tmp-name3) + (rename-file tmp-name1 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name1)) (should (file-exists-p @@ -2013,7 +2013,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name1)) (write-region "foo" nil tmp-name1) (make-directory tmp-name5) - (rename-file tmp-name1 tmp-name5) + (rename-file tmp-name1 (file-name-as-directory tmp-name5)) (should-not (file-exists-p tmp-name1)) (should (file-exists-p @@ -2040,7 +2040,7 @@ This checks also `file-name-as-directory', `file-name-directory', (should-not (file-exists-p tmp-name4)) (write-region "foo" nil tmp-name4 nil 'nomessage) (make-directory tmp-name3) - (rename-file tmp-name4 tmp-name3) + (rename-file tmp-name4 (file-name-as-directory tmp-name3)) (should-not (file-exists-p tmp-name4)) (should (file-exists-p @@ -3681,11 +3681,11 @@ This requires restrictions of file name syntax." (should (string-equal (buffer-string) elt))) ;; Copy file both directions. - (copy-file file1 tmp-name2) + (copy-file file1 (file-name-as-directory tmp-name2)) (should (file-exists-p file2)) (delete-file file1) (should-not (file-exists-p file1)) - (copy-file file2 tmp-name1) + (copy-file file2 (file-name-as-directory tmp-name1)) (should (file-exists-p file1)) (tramp--test-ignore-make-symbolic-link-error commit 52739ffe773eb403f58a6223b7ef64175df58dd7 Author: Eli Zaretskii Date: Sun Sep 10 22:10:33 2017 +0300 Extend --debug printouts in etags * lib-src/etags.c (regex_tag_multiline, readline): Under "--debug", print tags found via regexps. diff --git a/lib-src/etags.c b/lib-src/etags.c index 1d0fa29207..df51c0b4f8 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -6553,9 +6553,16 @@ regex_tag_multiline (void) else /* make a named tag */ name = substitute (buffer, rp->name, &rp->regs); if (rp->force_explicit_name) - /* Force explicit tag name, if a name is there. */ - pfnote (name, true, buffer + linecharno, - charno - linecharno + 1, lineno, linecharno); + { + /* Force explicit tag name, if a name is there. */ + pfnote (name, true, buffer + linecharno, + charno - linecharno + 1, lineno, linecharno); + + if (debug) + fprintf (stderr, "%s on %s:%d: %s\n", + name ? name : "(unnamed)", curfdp->taggedfname, + lineno, buffer + linecharno); + } else make_tag (name, strlen (name), true, buffer + linecharno, charno - linecharno + 1, lineno, linecharno); @@ -6876,8 +6883,14 @@ readline (linebuffer *lbp, FILE *stream) else /* make a named tag */ name = substitute (lbp->buffer, rp->name, &rp->regs); if (rp->force_explicit_name) - /* Force explicit tag name, if a name is there. */ - pfnote (name, true, lbp->buffer, match, lineno, linecharno); + { + /* Force explicit tag name, if a name is there. */ + pfnote (name, true, lbp->buffer, match, lineno, linecharno); + if (debug) + fprintf (stderr, "%s on %s:%d: %s\n", + name ? name : "(unnamed)", curfdp->taggedfname, + lineno, lbp->buffer); + } else make_tag (name, strlen (name), true, lbp->buffer, match, lineno, linecharno); commit 4b86cf5668ef70b9ee71975e5c3f5d47b08f4e37 Author: Eli Zaretskii Date: Sun Sep 10 19:46:00 2017 +0300 Add --debug option to etags * lib-src/etags.c (make_tag): Print found tags under --debug. (longopts): Add --debug. diff --git a/lib-src/etags.c b/lib-src/etags.c index 38be60e9cb..1d0fa29207 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -462,6 +462,7 @@ static bool cplusplus; /* .[hc] means C++, not C (undocumented) */ static bool ignoreindent; /* -I: ignore indentation in C */ static int packages_only; /* --packages-only: in Ada, only tag packages*/ static int class_qualify; /* -Q: produce class-qualified tags in C++/Java */ +static int debug; /* --debug */ /* STDIN is defined in LynxOS system headers */ #ifdef STDIN @@ -479,6 +480,7 @@ static struct option longopts[] = { "append", no_argument, NULL, 'a' }, { "packages-only", no_argument, &packages_only, 1 }, { "c++", no_argument, NULL, 'C' }, + { "debug", no_argument, &debug, 1 }, { "declarations", no_argument, &declarations, 1 }, { "no-line-directive", no_argument, &no_line_directive, 1 }, { "no-duplicates", no_argument, &no_duplicates, 1 }, @@ -1917,6 +1919,10 @@ make_tag (const char *name, /* tag name, or NULL if unnamed */ bool named = (name != NULL && namelen > 0); char *nname = NULL; + if (debug) + fprintf (stderr, "%s on %s:%d: %s\n", + named ? name : "(unnamed)", curfdp->taggedfname, lno, linestart); + if (!CTAGS && named) /* maybe set named to false */ /* Let's try to make an implicit tag name, that is, create an unnamed tag such that etags.el can guess a name from it. */ commit cdef84fb6893f69ffee1a99fe82a262e02e59bf5 Author: Paul Eggert Date: Sun Sep 10 09:20:27 2017 -0700 Spelling fixes * lisp/progmodes/cc-langs.el: (c-ambiguous-overloadable-or-identifier-prefixes): Rename from c-ambiguous-overloadable-or-identifier-prefices. Caller changed. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 067ae7bbc5..44fcb94f97 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -7641,7 +7641,7 @@ javascript:location.href='org-protocol://open-source?&url='+ @vindex org-protocol-project-alist The variable @code{org-protocol-project-alist} maps URLs to local file names, by stripping URL parameters from the end and replacing the @code{:base-url} -with @code{:working-diretory} and @code{:online-suffix} with +with @code{:working-directory} and @code{:online-suffix} with @code{:working-suffix}. For example, assuming you own a local copy of @url{http://orgmode.org/worg/} contents at @file{/home/user/worg}, you can set @code{org-protocol-project-alist} to the following diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index ffd99f7438..fb5aee17a7 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -20919,7 +20919,7 @@ (ses-formula-references): Robustify against self-referring cells. (ses-mode): Use ses-set-localvars. (ses-command-hook): Add call to ses-initialize-Dijkstra-attempt - before lauching the update processing. + before launching the update processing. (ses-initialize-Dijkstra-attempt): New function. (ses-recalculate-cell): Update for cycle detection based on Dijkstra algorithm. diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index 6dfddf72e8..5c415de047 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -14161,7 +14161,7 @@ 2014-01-10 Eric S. Raymond - * version.el (emacs-bzr-get-version): Restore compatibilty with + * version.el (emacs-bzr-get-version): Restore compatibility with 24.3 (Tested). 2014-01-10 Bozhidar Batsov diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index d4eae06f29..8a4adf1f7f 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1185,7 +1185,7 @@ This regexp is assumed to not match any non-operator identifier." (make-obsolete-variable 'c-opt-op-identitier-prefix 'c-opt-op-identifier-prefix "CC Mode 5.31.4, 2006-04-14") -(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefices +(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefixes ;; A list of strings which can be either overloadable operators or ;; identifier prefixes. t (c--intersection @@ -1199,7 +1199,7 @@ This regexp is assumed to not match any non-operator identifier." ;; A regexp matching strings which can be either overloadable operators ;; or identifier prefixes. t (c-make-keywords-re - t (c-lang-const c-ambiguous-overloadable-or-identifier-prefices))) + t (c-lang-const c-ambiguous-overloadable-or-identifier-prefixes))) (c-lang-defvar c-ambiguous-overloadable-or-identifier-prefix-re (c-lang-const c-ambiguous-overloadable-or-identifier-prefix-re)) diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index 7c040e7495..ebdb516de1 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -228,8 +228,8 @@ executable." (and argument (string< "" argument) " ") argument)) - ;; For backward compatibilty, allow `executable-prefix-env' to be - ;; overriden by custom `executable-prefix'. + ;; For backward compatibility, allow `executable-prefix-env' to be + ;; overridden by custom `executable-prefix'. (if (string-match "#!\\([ \t]*/usr/bin/env[ \t]*\\)?$" executable-prefix) (if executable-prefix-env (setq argument (concat "/usr/bin/env " diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 4b7fa47989..beca972aad 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -43,7 +43,7 @@ ;; Skip if emacsclient was compiled with -pg (bug#28319). ;; Use ert--skip-unless rather than skip-unless to silence compiler. (ert--skip-unless (not (and (stringp stat) - (string-match-p "rofiling" stat)))) + (string-match-p "Profiling" stat)))) (should (eq 0 stat)))) (ert-deftest emacsclient-test-alternate-editor-allows-arguments () diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 3c460d0151..1f6e060832 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -380,7 +380,7 @@ (ert-deftest dired-test-bug27940 () "Test for http://debbugs.gnu.org/27940 ." - ;; If just empty dirs we shouln't be prompted. + ;; If just empty dirs we shouldn't be prompted. (dired-test-with-temp-dirs 'just-empty-dirs (let (asked) diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el index d24b30e5f2..1698e0967d 100644 --- a/test/lisp/ls-lisp-tests.el +++ b/test/lisp/ls-lisp-tests.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Free Software Foundation, Inc. -;; Author: Tino Calacha +;; Author: Tino Calancha ;; Keywords: ;; This file is part of GNU Emacs. diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el index 0425bc0e0f..2e31602b12 100644 --- a/test/lisp/register-tests.el +++ b/test/lisp/register-tests.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Free Software Foundation, Inc. -;; Author: Tino Calacha +;; Author: Tino Calancha ;; Keywords: ;; This file is part of GNU Emacs. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 729001bdf3..7cb7107ced 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -505,7 +505,7 @@ See Bug#21722." (setq-local fill-prefix " ") (set-fill-column 5) ;; Shouldn't break after 'foo' (3 characters) when the next - ;; line is indented >= to that, that woudln't result in shorter + ;; line is indented >= to that, that wouldn't result in shorter ;; lines. (insert "foo bar") (do-auto-fill) commit 4973788c6aa2636407b34da840088f635ba6914a Author: Mark Oteiza Date: Sun Sep 10 12:20:06 2017 -0400 ; Add to last commit * lisp/xdg.el (xdg-desktop-entry-regexp): Add a commented capture group for future reference. diff --git a/lisp/xdg.el b/lisp/xdg.el index 8a475ce7d9..183d050cc6 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -163,6 +163,7 @@ This should be called at the beginning of a line." ;; notion of l10n/i18n (defconst xdg-desktop-entry-regexp (rx (group-n 1 (+ (in "A-Za-z0-9-"))) + ;; (? "[" (group-n 3 (+ nonl)) "]") (* blank) "=" (* blank) (group-n 2 (* nonl))) "Regexp matching desktop file entry key-value pairs.") commit 6ae845637bddc0c8da5b96478f4910363de88a9e Author: Eli Zaretskii Date: Sun Sep 10 19:01:16 2017 +0300 ; * configure.ac: Fix last change. diff --git a/configure.ac b/configure.ac index ba6c5af79d..d294412dc4 100644 --- a/configure.ac +++ b/configure.ac @@ -170,7 +170,7 @@ Defaulting to $host.]) # 'eval' pacifies strict POSIX non-MinGW shells (Bug#18612). # We downcase the drive letter to avoid warnings when # generating autoloads. - eval 'srcdir=/`echo ${srcdir:0:1} | sed "y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/`"${srcdir:2}"' + eval 'srcdir=/`echo ${srcdir:0:1} | sed "y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/"`"${srcdir:2}"' ;; esac;; esac commit b079ee72ac25590cd8b7b185b32ea5d2d43a9909 Author: Paul Eggert Date: Sun Sep 10 08:39:55 2017 -0700 Merge from gnulib This incorporates: 2017-09-08 stddef: Avoid conflict with system-defined max_align_t 2017-08-24 warnings: fix compilation with old autoconf 2017-08-23 glob: merge from glibc with Zanella glob changes 2017-08-17 random: Fix test compilation failure on Cygwin 1.5.25 * doc/misc/texinfo.tex, lib/flexmember.h, lib/stddef.in.h: * lib/stdlib.in.h, m4/manywarnings.m4, m4/stdlib_h.m4: * m4/warnings.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 3844333fae..a774790c51 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2017-07-04.16} +\def\texinfoversion{2017-08-23.19} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -5696,10 +5696,13 @@ \advance\dimen@ii by 1\dimen@i \ifdim\wd\boxA > \dimen@ii % If the entry doesn't fit in one line \ifdim\dimen@ > 0.8\dimen@ii % due to long index text - \dimen@ = 0.7\dimen@ % Try to split the text roughly evenly + % Try to split the text roughly evenly. \dimen@ will be the length of + % the first line. + \dimen@ = 0.7\dimen@ \dimen@ii = \hsize \ifnum\dimen@>\dimen@ii - % If the entry is too long, use the whole line + % If the entry is too long (for example, if it needs more than + % two lines), use all the space in the first line. \dimen@ = \dimen@ii \fi \advance\leftskip by 0pt plus 1fill % ragged right @@ -5709,8 +5712,9 @@ % instead of using \parshape with explicit line lengths, but TeX % doesn't seem to provide a way to do such a thing. % - \leftskip = 1em - \parindent = -1em + % Indent all lines but the first one. + \advance\leftskip by 1em + \advance\parindent by -1em \fi\fi \indent % start paragraph \unhbox\boxA @@ -6943,7 +6947,15 @@ % exist, with an empty box. Let's hope all the numbers have the same width. % Also ignore the page number, which is conventionally not printed. \def\numeralbox{\setbox0=\hbox{8}\hbox to \wd0{\hfil}} -\def\partentry#1#2#3#4{\dochapentry{\numeralbox\labelspace#1}{}} +\def\partentry#1#2#3#4{% + % Add stretch and a bonus for breaking the page before the part heading. + % This reduces the chance of the page being broken immediately after the + % part heading, before a following chapter heading. + \vskip 0pt plus 5\baselineskip + \penalty-300 + \vskip 0pt plus -5\baselineskip + \dochapentry{\numeralbox\labelspace#1}{}% +} % % Parts, in the short toc. \def\shortpartentry#1#2#3#4{% diff --git a/lib/flexmember.h b/lib/flexmember.h index c71ea65103..7405c41838 100644 --- a/lib/flexmember.h +++ b/lib/flexmember.h @@ -2,18 +2,21 @@ Copyright 2016-2017 Free Software Foundation, Inc. - This program 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. + This file is part of the GNU C Library. - This program is distributed in the hope that it will be useful, + The GNU C Library 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. + + The GNU C Library 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. + 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 this program. If not, see . + You should have received a copy of the GNU General Public + License along with the GNU C Library; if not, see + . Written by Paul Eggert. */ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index b6eb0f6953..fdf87433e5 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -369,12 +369,14 @@ HAVE_DECL_GETPAGESIZE = @HAVE_DECL_GETPAGESIZE@ HAVE_DECL_GETUSERSHELL = @HAVE_DECL_GETUSERSHELL@ HAVE_DECL_IMAXABS = @HAVE_DECL_IMAXABS@ HAVE_DECL_IMAXDIV = @HAVE_DECL_IMAXDIV@ +HAVE_DECL_INITSTATE = @HAVE_DECL_INITSTATE@ HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@ HAVE_DECL_MEMMEM = @HAVE_DECL_MEMMEM@ HAVE_DECL_MEMRCHR = @HAVE_DECL_MEMRCHR@ HAVE_DECL_OBSTACK_PRINTF = @HAVE_DECL_OBSTACK_PRINTF@ HAVE_DECL_SETENV = @HAVE_DECL_SETENV@ HAVE_DECL_SETHOSTNAME = @HAVE_DECL_SETHOSTNAME@ +HAVE_DECL_SETSTATE = @HAVE_DECL_SETSTATE@ HAVE_DECL_SNPRINTF = @HAVE_DECL_SNPRINTF@ HAVE_DECL_STRDUP = @HAVE_DECL_STRDUP@ HAVE_DECL_STRERROR_R = @HAVE_DECL_STRERROR_R@ @@ -2359,6 +2361,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ + -e 's|@''HAVE_DECL_INITSTATE''@|$(HAVE_DECL_INITSTATE)|g' \ -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \ -e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \ -e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \ @@ -2376,6 +2379,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ -e 's|@''HAVE_SECURE_GETENV''@|$(HAVE_SECURE_GETENV)|g' \ -e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \ + -e 's|@''HAVE_DECL_SETSTATE''@|$(HAVE_DECL_SETSTATE)|g' \ -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \ -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \ -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ diff --git a/lib/stddef.in.h b/lib/stddef.in.h index 5b496a6832..16e72bd1e0 100644 --- a/lib/stddef.in.h +++ b/lib/stddef.in.h @@ -85,24 +85,28 @@ a hack in case the configure-time test was done with g++ even though we are currently compiling with gcc. */ #if ! (@HAVE_MAX_ALIGN_T@ || defined _GCC_MAX_ALIGN_T) +# if !GNULIB_defined_max_align_t /* On the x86, the maximum storage alignment of double, long, etc. is 4, but GCC's C11 ABI for x86 says that max_align_t has an alignment of 8, and the C11 standard allows this. Work around this problem by using __alignof__ (which returns 8 for double) rather than _Alignof (which returns 4), and align each union member accordingly. */ -# ifdef __GNUC__ -# define _GL_STDDEF_ALIGNAS(type) \ - __attribute__ ((__aligned__ (__alignof__ (type)))) -# else -# define _GL_STDDEF_ALIGNAS(type) /* */ -# endif +# ifdef __GNUC__ +# define _GL_STDDEF_ALIGNAS(type) \ + __attribute__ ((__aligned__ (__alignof__ (type)))) +# else +# define _GL_STDDEF_ALIGNAS(type) /* */ +# endif typedef union { char *__p _GL_STDDEF_ALIGNAS (char *); double __d _GL_STDDEF_ALIGNAS (double); long double __ld _GL_STDDEF_ALIGNAS (long double); long int __i _GL_STDDEF_ALIGNAS (long int); -} max_align_t; +} rpl_max_align_t; +# define max_align_t rpl_max_align_t +# define GNULIB_defined_max_align_t 1 +# endif #endif # endif /* _@GUARD_PREFIX@_STDDEF_H */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index c6e68fddc4..ef41c992df 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -597,7 +597,7 @@ _GL_WARN_ON_USE (srandom, "srandom is unportable - " #endif #if @GNULIB_RANDOM@ -# if !@HAVE_RANDOM@ +# if !@HAVE_RANDOM@ || !@HAVE_DECL_INITSTATE@ _GL_FUNCDECL_SYS (initstate, char *, (unsigned int seed, char *buf, size_t buf_size) _GL_ARG_NONNULL ((2))); @@ -614,7 +614,7 @@ _GL_WARN_ON_USE (initstate, "initstate is unportable - " #endif #if @GNULIB_RANDOM@ -# if !@HAVE_RANDOM@ +# if !@HAVE_RANDOM@ || !@HAVE_DECL_SETSTATE@ _GL_FUNCDECL_SYS (setstate, char *, (char *arg_state) _GL_ARG_NONNULL ((1))); # endif _GL_CXXALIAS_SYS (setstate, char *, (char *arg_state)); diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index a3d255a940..eb89325519 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 11 +# manywarnings.m4 serial 12 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -39,7 +39,8 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], [_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) # Specialization for _AC_LANG = C. -AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], +# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. +m4_defun([gl_MANYWARN_ALL_GCC(C)], [ AC_LANG_PUSH([C]) @@ -316,7 +317,8 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], ]) # Specialization for _AC_LANG = C++. -AC_DEFUN([gl_MANYWARN_ALL_GCC(C++)], +# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. +m4_defun([gl_MANYWARN_ALL_GCC(C++)], [ gl_MANYWARN_ALL_GCC_CXX_IMPL([$1]) ]) diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index ec4a058154..3537346368 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -1,4 +1,4 @@ -# stdlib_h.m4 serial 43 +# stdlib_h.m4 serial 44 dnl Copyright (C) 2007-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -78,6 +78,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG]) HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT]) HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT]) + HAVE_DECL_INITSTATE=1; AC_SUBST([HAVE_DECL_INITSTATE]) HAVE_MKDTEMP=1; AC_SUBST([HAVE_MKDTEMP]) HAVE_MKOSTEMP=1; AC_SUBST([HAVE_MKOSTEMP]) HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS]) @@ -96,6 +97,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_SECURE_GETENV=1; AC_SUBST([HAVE_SECURE_GETENV]) HAVE_SETENV=1; AC_SUBST([HAVE_SETENV]) HAVE_DECL_SETENV=1; AC_SUBST([HAVE_DECL_SETENV]) + HAVE_DECL_SETSTATE=1; AC_SUBST([HAVE_DECL_SETSTATE]) HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD]) HAVE_STRTOLL=1; AC_SUBST([HAVE_STRTOLL]) HAVE_STRTOULL=1; AC_SUBST([HAVE_STRTOULL]) diff --git a/m4/warnings.m4 b/m4/warnings.m4 index aa2735b77f..870472b624 100644 --- a/m4/warnings.m4 +++ b/m4/warnings.m4 @@ -1,4 +1,4 @@ -# warnings.m4 serial 12 +# warnings.m4 serial 13 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -59,7 +59,8 @@ AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS], [_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) # Specialization for _AC_LANG = C. This macro can be AC_REQUIREd. -AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], +# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. +m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], [ AC_LANG_PUSH([C]) gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL @@ -67,7 +68,8 @@ AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], ]) # Specialization for _AC_LANG = C++. This macro can be AC_REQUIREd. -AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], +# Use of m4_defun rather than AC_DEFUN works around a bug in autoconf < 2.63b. +m4_defun([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], [ AC_LANG_PUSH([C++]) gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL commit c990f8d93dcc78aa98e58b89bddb666efcea2710 Author: Ken Brown Date: Sun Sep 10 11:00:35 2017 -0400 Implement renameat_noreplace on recent Cygwin * src/sysdep.c [CYGWIN]: Include cygwin/fs.h. (renameat_noreplace) [RENAME_NOREPLACE]: Use renameat2. (Bug#27986) diff --git a/src/sysdep.c b/src/sysdep.c index b66a745317..f5050e60f4 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -42,6 +42,10 @@ along with GNU Emacs. If not, see . */ # include #endif +#ifdef CYGWIN +# include +#endif + #if defined DARWIN_OS || defined __FreeBSD__ # include #endif @@ -2685,6 +2689,8 @@ renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { #if defined SYS_renameat2 && defined RENAME_NOREPLACE return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); +#elif defined RENAME_NOREPLACE /* Cygwin >= 2.9.0. */ + return renameat2 (srcfd, src, dstfd, dst, RENAME_NOREPLACE); #elif defined RENAME_EXCL return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL); #else commit 43779f9b97f3a1a66c8a32f126ce2c40af921429 Author: Eli Zaretskii Date: Sun Sep 10 17:52:41 2017 +0300 Avoid warnings about file names in autoloads on MS-Windows * configure.ac (srcdir) [mingw32]: Downcase the drive letter, to avoid warnings from find-file-noselect when making autoloads. For the details, see http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00049.html. diff --git a/configure.ac b/configure.ac index 8ffc7cfff3..ba6c5af79d 100644 --- a/configure.ac +++ b/configure.ac @@ -168,7 +168,9 @@ Defaulting to $host.]) # format ("c:/foo/bar"). srcdir=`cd "${srcdir}" && pwd -W` # 'eval' pacifies strict POSIX non-MinGW shells (Bug#18612). - eval 'srcdir="/${srcdir:0:1}${srcdir:2}"' + # We downcase the drive letter to avoid warnings when + # generating autoloads. + eval 'srcdir=/`echo ${srcdir:0:1} | sed "y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/`"${srcdir:2}"' ;; esac;; esac commit e716538911227e1bedb48978b8025106abce3734 Author: Mark Oteiza Date: Sat Sep 9 23:12:47 2017 -0400 Avoid looking at localized strings * lisp/xdg.el (xdg-desktop-read-group): Add condition to catch localized strings. * test/lisp/xdg-tests.el (xdg-desktop-parsing): Add test to ensure parsing l10n strings doesn't error but is essentially a no-op. diff --git a/lisp/xdg.el b/lisp/xdg.el index 102e34cb0c..8a475ce7d9 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -177,6 +177,8 @@ This should be called at the beginning of a line." ((= (following-char) ?#)) ((looking-at xdg-desktop-entry-regexp) (puthash (match-string 1) (match-string 2) res)) + ;; Filter localized strings + ((looking-at (rx (group-n 1 (+ (in alnum "-"))) (* blank) "["))) (t (error "Malformed line: %s" (buffer-substring (point) (point-at-eol))))) (forward-line)) diff --git a/test/data/xdg/l10n.desktop b/test/data/xdg/l10n.desktop new file mode 100644 index 0000000000..42da83910d --- /dev/null +++ b/test/data/xdg/l10n.desktop @@ -0,0 +1,5 @@ +# localized strings +[Desktop Entry] +Comment=Cheers +Comment[en_US@piglatin]=Eerschay +Comment[sv]=Skål diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index 4822a05c1e..2630e1e824 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -45,7 +45,18 @@ (expand-file-name "wrong.desktop" xdg-tests-data-dir))) (should-error (xdg-desktop-read-file - (expand-file-name "malformed.desktop" xdg-tests-data-dir)))) + (expand-file-name "malformed.desktop" xdg-tests-data-dir))) + (let ((tab (xdg-desktop-read-file + (expand-file-name "l10n.desktop" xdg-tests-data-dir))) + (env (getenv "LC_MESSAGES"))) + (unwind-protect + (progn + (setenv "LC_MESSAGES" nil) + (should (equal (gethash "Comment" tab) "Cheers")) + ;; l10n omitted + (setenv "LC_MESSAGES" "sv_SE.UTF-8") + (should-not (equal (gethash "Comment" tab) "Skål"))) + (setenv "LC_MESSAGES" env)))) (ert-deftest xdg-desktop-strings-type () "Test desktop \"string(s)\" type: strings delimited by \";\"." commit 3ef0c1648488c18f71b266bea2f3bfa8dbc68c98 Author: Paul Eggert Date: Sat Sep 9 00:50:53 2017 -0700 * etc/NEWS.25: Document 25.3 changes. diff --git a/etc/NEWS.25 b/etc/NEWS.25 index 539e56e42a..db448fd61a 100644 --- a/etc/NEWS.25 +++ b/etc/NEWS.25 @@ -16,6 +16,37 @@ You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing C-u C-h C-n. +* Changes in Emacs 25.3 + +This is mainly a release to fix security-relevant bugs. + +** Enriched text mode no longer supports the 'FUNCTION' and 'display' +translations, and Gnus no longer processes enriched text when +inlining. This fixes bugs introduced in Emacs 19.29. To work around +these bugs in Emacs versions 19.29 through 25.2, append the following +to your ~/.emacs file: + + (provide 'enriched) + (defun enriched-mode (&optional arg)) + (defun enriched-decode (from to)) + +Thanks to Charles A. Roelli for reporting this bug; see: +https://bugs.gnu.org/28350 + +** TLS/SSL connections no longer fall back on the openssl s_client +command to set up SSL connections in some hopefully-unlikely cases. +This fixes a bug introduced in Emacs 22.1. To work around this bug in +Emacs versions 22.1 through 25.2, append the following to your +~/.emacs file: + + (setq tls-program '("gnutls-cli --x509cafile %t -p %p %h")) + +You may need to omit the "--x509cafile %t" on older installations. + +Thanks to Kurt Roeckx for reporting this bug to Debian; see: +https://bugs.debian.org/766397 + + * Changes in Emacs 25.2 This is mainly a bug-fix release, but there are some other changes. commit 19584f13b1e2e4a778602a8302619ef5c675e68b Author: Lars Ingebrigtsen Date: Fri Sep 8 20:23:31 2017 -0700 Remove unsafe enriched mode translations * lisp/gnus/mm-view.el (mm-inline-text): Do not worry about enriched or richtext type. * lisp/textmodes/enriched.el (enriched-translations): Remove translations for FUNCTION, display (Bug#28350). (enriched-handle-display-prop, enriched-decode-display-prop): Remove. diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 9ff581da99..3698f4d9cf 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -362,10 +362,6 @@ (goto-char (point-max)))) (save-restriction (narrow-to-region b (point)) - (when (member type '("enriched" "richtext")) - (set-text-properties (point-min) (point-max) nil) - (ignore-errors - (enriched-decode (point-min) (point-max)))) (mm-handle-set-undisplayer handle `(lambda () diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index 7ace2a5048..eba7c4ddd8 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -117,12 +117,7 @@ expression, which is evaluated to get the string to insert.") (full "flushboth") (center "center")) (PARAMETER (t "param")) ; Argument of preceding annotation - ;; The following are not part of the standard: - (FUNCTION (enriched-decode-foreground "x-color") - (enriched-decode-background "x-bg-color") - (enriched-decode-display-prop "x-display")) (read-only (t "x-read-only")) - (display (nil enriched-handle-display-prop)) (unknown (nil format-annotate-value)) ; (font-size (2 "bigger") ; unimplemented ; (-2 "smaller")) @@ -477,32 +472,5 @@ Return value is \(begin end name positive-p), or nil if none was found." (message "Warning: no color specified for ") nil)) -;;; Handling the `display' property. - - -(defun enriched-handle-display-prop (old new) - "Return a list of annotations for a change in the `display' property. -OLD is the old value of the property, NEW is the new value. Value -is a list `(CLOSE OPEN)', where CLOSE is a list of annotations to -close and OPEN a list of annotations to open. Each of these lists -has the form `(ANNOTATION PARAM ...)'." - (let ((annotation "x-display") - (param (prin1-to-string (or old new)))) - (if (null old) - (cons nil (list (list annotation param))) - (cons (list (list annotation param)) nil)))) - -(defun enriched-decode-display-prop (start end &optional param) - "Decode a `display' property for text between START and END. -PARAM is a `' found for the property. -Value is a list `(START END SYMBOL VALUE)' with START and END denoting -the range of text to assign text property SYMBOL with value VALUE." - (let ((prop (when (stringp param) - (condition-case () - (car (read-from-string param)) - (error nil))))) - (unless prop - (message "Warning: invalid parameter %s" param)) - (list start end 'display prop))) ;;; enriched.el ends here commit 743b95cc635b1af1490e2834ec1c418c3c1242c0 Author: Paul Eggert Date: Sat Sep 9 13:39:22 2017 -0700 Be more consistent about "directory name" in manual This clarifies the documentation, partly in response to the discussion in Bug#27986. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index cc79eae777..87ac61bac3 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -1389,7 +1389,7 @@ Loading,,, elisp, the Emacs Lisp Reference Manual}. @vindex load-path The Emacs Lisp load path is specified by the variable -@code{load-path}. Its value should be a list of directory names +@code{load-path}. Its value should be a list of directories (strings). These directories are searched, in the specified order, by the @kbd{M-x load-library} command, the lower-level @code{load} function, and other Emacs functions that find Emacs Lisp libraries. A diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index a1807ad9dd..819459e0af 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -466,7 +466,7 @@ variables to be set, but it uses their values if they are set. @item CDPATH @vindex CDPATH, environment variable Used by the @code{cd} command to search for the directory you specify, -when you specify a relative directory name. +when you specify a relative directory, @item DBUS_SESSION_BUS_ADDRESS @vindex DBUS_SESSION_BUS_ADDRESS, environment variable Used by D-Bus when Emacs is compiled with it. Usually, there is no diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 824fb6ede2..3e17696342 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -587,7 +587,7 @@ too.) @vindex custom-theme-load-path If you want Emacs to look for Custom themes in some other directory, -add the directory name to the list variable +add the directory to the list variable @code{custom-theme-load-path}. Its default value is @code{(custom-theme-directory t)}; here, the symbol @code{custom-theme-directory} has the special meaning of the value of @@ -1321,7 +1321,7 @@ Each alist entry consists of a variable name and the directory-local value to assign to that variable, when the specified major mode is enabled. Instead of a mode name, you can specify @samp{nil}, which means that the alist applies to any mode; or you can specify a -subdirectory name (a string), in which case the alist applies to all +subdirectory (a string), in which case the alist applies to all files in that subdirectory. Here's an example of a @file{.dir-locals.el} file: @@ -1356,7 +1356,7 @@ Variables}. @findex copy-file-locals-to-dir-locals Instead of editing the @file{.dir-locals.el} file by hand, you can use the command @kbd{M-x add-dir-local-variable}. This prompts for a -mode or subdirectory name, and for variable and value, and adds the +mode or subdirectory, and for variable and value, and adds the entry defining the directory-local variable. @kbd{M-x delete-dir-local-variable} deletes an entry. @kbd{M-x copy-file-locals-to-dir-locals} copies the file-local variables in the diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index c1cc2f8cf9..db5dea329b 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -61,7 +61,7 @@ you to operate on the listed files. @xref{Directories}. @kindex C-x d @vindex dired-listing-switches To invoke Dired, type @kbd{C-x d} (@code{dired}). This reads a -directory name using the minibuffer, and opens a @dfn{Dired buffer} +directory's name using the minibuffer, and opens a @dfn{Dired buffer} listing the files in that directory. You can also supply a wildcard file name pattern as the minibuffer argument, in which case the Dired buffer lists all files matching that pattern. A wildcard may appear @@ -82,7 +82,7 @@ in particular, @kbd{M-n} puts the name of the visited file (if any) in the minibuffer (@pxref{Minibuffer History}). You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file}) -a directory name. +a directory's name. The variable @code{dired-listing-switches} specifies the options to give to @command{ls} for listing the directory; this string @@ -1433,7 +1433,7 @@ rotation is lossless, and uses an external utility called JpegTRAN. @kindex + @r{(Dired)} @findex dired-create-directory The command @kbd{+} (@code{dired-create-directory}) reads a -directory name, and creates that directory. It signals an error if +directory's name, and creates that directory. It signals an error if the directory already exists. @cindex searching multiple files via Dired diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index fa1f9e5316..b9bfbd72ce 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -84,7 +84,7 @@ buffer that is not visiting a file, via a command like @kbd{C-x b}, its default directory is usually copied from the buffer that was current at the time (@pxref{Select Buffer}). You can use the command @kbd{M-x pwd} to see the value of @code{default-directory} in the -current buffer. The command @kbd{M-x cd} prompts for a directory +current buffer. The command @kbd{M-x cd} prompts for a directory's name, and sets the buffer's @code{default-directory} to that directory (doing this does not change the buffer's file name, if any). @@ -1287,7 +1287,7 @@ this, it runs the program specified by @code{directory-free-space-program} with arguments @code{directory-free-space-args}. - The command @kbd{M-x delete-directory} prompts for a directory name + The command @kbd{M-x delete-directory} prompts for a directory's name using the minibuffer, and deletes the directory if it is empty. If the directory is not empty, you will be asked whether you want to delete it recursively. On systems that have a ``Trash'' (or ``Recycle @@ -1557,16 +1557,12 @@ not accept wildcard file names. In all these commands, if the argument @var{new} is just a directory name, the real new name is in that directory, with the same non-directory component as @var{old}. For example, the command -@c FIXME: '/tmp' should be '/tmp/' because '/tmp' -@c is not "just a directory name". -@c And actually the fact that ``directory name'' must end in a slash -@c is not explained anywhere in this manual. Moreover, it many times -@c uses ``directory name'' in contexts where the string it alludes to -@c will clearly _not_ end in a slash -@w{@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp @key{RET}}} -renames @file{~/foo} to @file{/tmp/foo}. All these -commands ask for confirmation when the new file name already exists, -too. +@w{@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp/ @key{RET}}} +renames @file{~/foo} to @file{/tmp/foo}. @xref{Directory Names,,, +elisp, the Emacs Lisp Reference Manual}. + +All these commands ask for confirmation when the new file name already +exists. @findex copy-file @cindex copying files @@ -1976,7 +1972,7 @@ them all. @item M-x file-cache-add-directory-list @key{RET} @var{variable} @key{RET} Add each file name in each directory listed in @var{variable} to the file name cache. @var{variable} should be a Lisp variable whose value -is a list of directory names, like @code{load-path}. +is a list of directories, like @code{load-path}. @item M-x file-cache-clear-cache @key{RET} Clear the cache; that is, remove all file names from it. @end table diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index ee33a6848c..b168effb3a 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -836,8 +836,8 @@ associate the speedbar with a different frame, dismiss it and call The speedbar can operate in various modes. Its default mode is @dfn{File Display} mode, which shows the files in the current directory of the selected window of the attached frame, one file per -line. Clicking on a file name visits that file in the selected window -of the attached frame, and clicking on a directory name shows that +line. Clicking on a non-directory visits that file in the selected window +of the attached frame, and clicking on a directory shows that directory in the speedbar (@pxref{Mouse References}). Each line also has a box, @samp{[+]} or @samp{<+>}, that you can click on to @dfn{expand} the contents of that item. Expanding a directory adds diff --git a/doc/emacs/glossary.texi b/doc/emacs/glossary.texi index 41899e6152..82e7394501 100644 --- a/doc/emacs/glossary.texi +++ b/doc/emacs/glossary.texi @@ -405,6 +405,14 @@ A directory local variable is a local variable (q.v.@:) that applies to all the files within a certain directory. @xref{Directory Variables}. +@item Directory Name +On GNU and other Unix-like systems, directory names are strings that +end in @samp{/}. For example, @file{/no-such-dir/} is a directory +name whereas @file{/tmp} is not, even though @file{/tmp} names a file +that happens to be a directory. On MS-DOS the relationship is more +complicated. @xref{Directory Names,,, elisp, the Emacs Lisp Reference +Manual}. + @item Dired Dired is the Emacs facility that displays the contents of a file directory and allows you to ``edit the directory'', performing @@ -1197,7 +1205,7 @@ string or the next match for a specified regular expression. @xref{Search}. @item Search Path -A search path is a list of directory names, to be used for searching for +A search path is a list of directories, to be used for searching for files for certain purposes. For example, the variable @code{load-path} holds a search path for finding Lisp library files. @xref{Lisp Libraries}. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 431ef35ac7..6a592e2d51 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1125,7 +1125,7 @@ it is used to specify multi-file VC filesets for commands like @kindex C-x v d @findex vc-dir To use the VC Directory buffer, type @kbd{C-x v d} (@code{vc-dir}). -This reads a directory name using the minibuffer, and switches to a VC +This reads a directory's name using the minibuffer, and switches to a VC Directory buffer for that directory. By default, the buffer is named @file{*vc-dir*}. Its contents are described @iftex diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 7602fbb745..6ad5fbafdd 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -661,7 +661,7 @@ available. (either in the @var{cmd} argument to one of the above commands, or in other contexts), Emacs searches for the program in the directories specified by the variable @code{exec-path}. The value of this -variable must be a list of directory names; the default value is +variable must be a list of directories; the default value is initialized from the environment variable @env{PATH} when Emacs is started (@pxref{General Variables}). @@ -2815,7 +2815,7 @@ Find @var{filename}, guessing a default from text around point @code{ffap-alternate-file}, analogous to @code{find-alternate-file}. @item C-x d @var{directory} @key{RET} @kindex C-x d @r{(FFAP)} -Start Dired on @var{directory}, defaulting to the directory name at +Start Dired on @var{directory}, defaulting to the directory at point (@code{dired-at-point}). @item C-x C-d @code{ffap-list-directory}, analogous to @code{list-directory}. diff --git a/doc/emacs/msdos-xtra.texi b/doc/emacs/msdos-xtra.texi index 0d98dc81c1..03250447bb 100644 --- a/doc/emacs/msdos-xtra.texi +++ b/doc/emacs/msdos-xtra.texi @@ -363,7 +363,7 @@ the home directory, as you would on GNU or Unix. You can also set @env{HOME} variable in the environment before starting Emacs; its value will then override the above default behavior. - Emacs on MS-DOS handles the directory name @file{/dev} specially, + Emacs on MS-DOS handles the name @file{/dev} specially, because of a feature in the emulator libraries of DJGPP that pretends I/O devices have names in that directory. We recommend that you avoid using an actual directory named @file{/dev} on any disk. diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index ecc955d3ef..215f50cb40 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -182,7 +182,7 @@ variable @code{package-archives}, whose value is a list of package archives known to Emacs. Each list element must have the form @code{(@var{id} . @var{location})}, where @var{id} is the name of a package archive and @var{location} is the @acronym{HTTP} address or -directory name of the package archive. You can alter this list if you +name of the package archive directory. You can alter this list if you wish to use third party package archives---but do so at your own risk, and use only third parties that you think you can trust! diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi index d1e451175e..ab401c7336 100644 --- a/doc/emacs/text.texi +++ b/doc/emacs/text.texi @@ -1726,8 +1726,8 @@ C-p} (@code{tex-print}) to print a hardcopy of the output file. By default, @kbd{C-c C-b} runs @TeX{} in the current directory. The output of @TeX{} also goes in this directory. To run @TeX{} in a different directory, change the variable @code{tex-directory} to the -desired directory name. If your environment variable @env{TEXINPUTS} -contains relative directory names, or if your files contains +the desired directory. If your environment variable @env{TEXINPUTS} +contains relative names, or if your files contains @samp{\input} commands with relative file names, then @code{tex-directory} @emph{must} be @code{"."} or you will get the wrong results. Otherwise, it is safe to specify some other directory, diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi index 3e2d1f6248..48251c7c51 100644 --- a/doc/lispref/backups.texi +++ b/doc/lispref/backups.texi @@ -129,7 +129,7 @@ its value. Major modes should not set this variable---they should set @defopt backup-directory-alist This variable's value is an alist of filename patterns and backup -directory names. Each element looks like +directories. Each element looks like @smallexample (@var{regexp} . @var{directory}) @end smallexample @@ -145,7 +145,7 @@ truncates the resulting name. For the common case of all backups going into one directory, the alist should contain a single element pairing @samp{"."} with the appropriate -directory name. +directory. If this variable is @code{nil} (the default), or it fails to match a filename, the backup is made in the original file's directory. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 274f8b4706..ff790e6304 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -395,7 +395,7 @@ Completion, Prompt. The position of point, as an integer (@pxref{Point}). No I/O. @item D -A directory name. The default is the current default directory of the +A directory. The default is the current default directory of the current buffer, @code{default-directory} (@pxref{File Name Expansion}). Existing, Completion, Default, Prompt. diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi index 5372728466..ed455828f6 100644 --- a/doc/lispref/customize.texi +++ b/doc/lispref/customize.texi @@ -599,7 +599,7 @@ The value must be a file name for an existing file. The widget provides completion. @item directory -The value must be a directory name. The widget provides completion. +The value must be a directory. The widget provides completion. @item hook The value must be a list of functions. This customization type is diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2ed848adf3..38f4f92e65 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5626,14 +5626,14 @@ This variable's value is a list of locations in which to search for image files. If an element is a string or a variable symbol whose value is a string, the string is taken to be the name of a directory to search. If an element is a variable symbol whose value is a list, -that is taken to be a list of directory names to search. +that is taken to be a list of directories to search. The default is to search in the @file{images} subdirectory of the directory specified by @code{data-directory}, then the directory specified by @code{data-directory}, and finally in the directories in @code{load-path}. Subdirectories are not automatically included in the search, so if you put an image file in a subdirectory, you have to -supply the subdirectory name explicitly. For example, to find the +supply the subdirectory explicitly. For example, to find the image @file{images/foo/bar.xpm} within @code{data-directory}, you should specify the image as follows: diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d04be63d7e..edee30e5ad 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -401,9 +401,7 @@ If @var{confirm} is non-@code{nil}, that means to ask for confirmation before overwriting an existing file. Interactively, confirmation is required, unless the user supplies a prefix argument. -@c FIXME: This disagrees with the doc string, which talks about -@c directory names, not directories. See Bug#27986. -If @var{filename} is an existing directory, or a symbolic link to one, +If @var{filename} is a directory name (@pxref{Directory Names}), @code{write-file} uses the name of the visited file, in directory @var{filename}. If the buffer is not visiting a file, it uses the buffer name instead. @@ -832,16 +830,16 @@ permissions. @defun file-exists-p filename This function returns @code{t} if a file named @var{filename} appears to exist. This does not mean you can necessarily read the file, only -that you can find out its attributes. (On Unix and GNU/Linux, this is -true if the file exists and you have execute permission on the -containing directories, regardless of the permissions of the file -itself.) +that you can find out its attributes. (On GNU and other POSIX-like +systems, this is true if the file exists and you have execute +permission on the containing directories, regardless of the +permissions of the file itself.) If the file does not exist, or if access control policies prevent you from finding its attributes, this function returns @code{nil}. -Directories are files, so @code{file-exists-p} returns @code{t} when -given a directory name. However, because @code{file-exists-p} follows +Directories are files, so @code{file-exists-p} can return @code{t} when +given a directory. However, because @code{file-exists-p} follows symbolic links, it returns @code{t} for a symbolic link name only if the target file exists. @end defun @@ -852,11 +850,11 @@ and you can read it. It returns @code{nil} otherwise. @end defun @defun file-executable-p filename -This function returns @code{t} if a file named @var{filename} exists and -you can execute it. It returns @code{nil} otherwise. On Unix and -GNU/Linux, if the file is a directory, execute permission means you can -check the existence and attributes of files inside the directory, and -open those files if their modes permit. +This function returns @code{t} if a file named @var{filename} exists +and you can execute it. It returns @code{nil} otherwise. On GNU and +other POSIX-like systems, if the file is a directory, execute +permission means you can check the existence and attributes of files +inside the directory, and open those files if their modes permit. @end defun @defun file-writable-p filename @@ -960,10 +958,10 @@ $ ls -l diffs executable file mode bit. So @code{file-modes} considers a file executable if its name ends in one of the standard executable extensions, such as @file{.com}, @file{.bat}, @file{.exe}, and some -others. Files that begin with the Unix-standard @samp{#!} signature, +others. Files that begin with the POSIX-standard @samp{#!} signature, such as shell and Perl scripts, are also considered executable. Directories are also reported as executable, for compatibility with -Unix. These conventions are also followed by @code{file-attributes} +POSIX@. These conventions are also followed by @code{file-attributes} (@pxref{File Attributes}). @end defun @@ -1762,8 +1760,8 @@ multiple names, it continues to exist under the other names. If symbolic link and not its target. A suitable kind of @code{file-error} error is signaled if the file -does not exist, or is not deletable. (On Unix and GNU/Linux, a file -is deletable if its directory is writable.) +does not exist, or is not deletable. (On GNU and other POSIX-like +systems, a file is deletable if its directory is writable.) If the optional argument @var{trash} is non-@code{nil} and the variable @code{delete-by-moving-to-trash} is non-@code{nil}, this @@ -1811,8 +1809,9 @@ This function sets the default permissions for new files created by Emacs and its subprocesses. Every file created with Emacs initially has these permissions, or a subset of them (@code{write-region} will not grant execute permissions even if the default file permissions -allow execution). On Unix and GNU/Linux, the default permissions are -given by the bitwise complement of the @samp{umask} value. +allow execution). On GNU and other POSIX-like systems, the default +permissions are given by the bitwise complement of the @samp{umask} +value. The argument @var{mode} should be an integer which specifies the permissions, similar to @code{set-file-modes} above. Only the lowest @@ -1951,9 +1950,9 @@ directory. @cindex converting file names from/to MS-Windows syntax On MS-DOS and MS-Windows, these functions (like the function that actually operate on files) accept MS-DOS or MS-Windows file-name syntax, -where backslashes separate the components, as well as Unix syntax; but -they always return Unix syntax. This enables Lisp programs to specify -file names in Unix syntax and work properly on all systems without +where backslashes separate the components, as well as POSIX syntax; but +they always return POSIX syntax. This enables Lisp programs to specify +file names in POSIX syntax and work properly on all systems without change.@footnote{In MS-Windows versions of Emacs compiled for the Cygwin environment, you can use the functions @code{cygwin-convert-file-name-to-windows} and @@ -1998,16 +1997,16 @@ This function returns the directory part of @var{filename}, as a directory name (@pxref{Directory Names}), or @code{nil} if @var{filename} does not include a directory part. -On GNU and Unix systems, a string returned by this function always +On GNU and other POSIX-like systems, a string returned by this function always ends in a slash. On MS-DOS it can also end in a colon. @example @group -(file-name-directory "lewis/foo") ; @r{Unix example} +(file-name-directory "lewis/foo") ; @r{GNU example} @result{} "lewis/" @end group @group -(file-name-directory "foo") ; @r{Unix example} +(file-name-directory "foo") ; @r{GNU example} @result{} nil @end group @end example @@ -2121,8 +2120,9 @@ root directory. A file name can specify all the directory names starting from the root of the tree; then it is called an @dfn{absolute} file name. Or it can specify the position of the file in the tree relative to a default directory; then it is called a -@dfn{relative} file name. On Unix and GNU/Linux, an absolute file -name starts with a @samp{/} or a @samp{~} +@dfn{relative} file name. On GNU and other POSIX-like systems, +after any leading @samp{~} has been expanded, an absolute file name +starts with a @samp{/} (@pxref{abbreviate-file-name}), and a relative one does not. On MS-DOS and MS-Windows, an absolute file name starts with a slash or a backslash, or with a drive specification @samp{@var{x}:/}, where @@ -2181,17 +2181,18 @@ form. @cindex directory file name @cindex file name of directory - A @dfn{directory name} is the name of a directory. A directory is -actually a kind of file, so it has a file name (called the -@dfn{directory file name}, which is related to the directory name but -not identical to it. (This is not quite the same as the usual Unix -terminology.) These two different names for the same entity are -related by a syntactic transformation. On GNU and Unix systems, this -is simple: a directory name ends in a slash, whereas the directory -file name lacks that slash. On MS-DOS the relationship is more + A @dfn{directory name} is a string that must name a directory if it +names any file at all. A directory is actually a kind of file, and it +has a file name (called the @dfn{directory file name}, which is +related to the directory name but is typically not identical. (This +is not quite the same as the usual POSIX terminology.) These two +names for the same entity are related by a syntactic transformation. +On GNU and other POSIX-like systems, this is simple: to obtain a +directory name, append a @samp{/} to a directory file name that does +not already end in @samp{/}. On MS-DOS the relationship is more complicated. - The difference between directory name and directory file name is + The difference between a directory name and a directory file name is subtle but crucial. When an Emacs variable or function argument is described as being a directory name, a directory file name is not acceptable. When @code{file-name-directory} returns a string, that is @@ -2219,15 +2220,16 @@ string (if it does not already end in one). @defun directory-name-p filename This function returns non-@code{nil} if @var{filename} ends with a directory separator character. This is the forward slash @samp{/} on -Unix and GNU systems; MS-Windows and MS-DOS recognize both the forward -slash and the backslash @samp{\} as directory separators. +GNU and other POSIX-like systems; MS-Windows and MS-DOS recognize both +the forward slash and the backslash @samp{\} as directory separators. @end defun @defun directory-file-name dirname This function returns a string representing @var{dirname} in a form that the operating system will interpret as the name of a file (a directory file name). On most systems, this means removing the final -slash (or backslash) from the string. +directory separators from the string, unless the string consists +entirely of directory separators. @example @group @@ -2307,7 +2309,7 @@ because it recognizes abbreviations even as part of the name. @dfn{Expanding} a file name means converting a relative file name to an absolute one. Since this is done relative to a default directory, -you must specify the default directory name as well as the file name +you must specify the default directory as well as the file name to be expanded. It also involves expanding abbreviations like @file{~/} @ifnottex @@ -2448,7 +2450,7 @@ results. @c Wordy to avoid overfull hbox. --rjc 15mar92 Here we assume that the environment variable @env{HOME}, which holds -the user's home directory name, has value @samp{/xcssun/users/rms}. +the user's home directory, has value @samp{/xcssun/users/rms}. @example @group @@ -2813,8 +2815,8 @@ located in @file{~/.abbrev_defs}. Here is the definition of This function returns a file name based on @var{filename}, which fits the conventions of the current operating system. -On GNU and Unix systems, this simply returns @var{filename}. On other -operating systems, it may enforce system-specific file name +On GNU and other POSIX-like systems, this simply returns @var{filename}. +On other operating systems, it may enforce system-specific file name conventions; for example, on MS-DOS this function performs a variety of changes to enforce MS-DOS file name limitations, including converting any leading @samp{.} to @samp{_} and truncating to three @@ -2918,7 +2920,7 @@ directory @var{file}, formatted with @code{ls} according to @var{switches} may be a string of options, or a list of strings representing individual options. -The argument @var{file} may be either a directory name or a file +The argument @var{file} may be either a directory or a file specification including wildcard characters. If @var{wildcard} is non-@code{nil}, that means treat @var{file} as a file specification with wildcards. diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 0ab8f89a3f..e4997d98ae 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -280,7 +280,7 @@ in a list of directories specified by the variable @code{load-path}. @defvar load-path The value of this variable is a list of directories to search when loading files with @code{load}. Each element is a string (which must be -a directory name) or @code{nil} (which stands for the current working +a directory) or @code{nil} (which stands for the current working directory). @end defvar @@ -339,7 +339,7 @@ the above initialization procedure. Emacs initializes @code{load-path} based on the value of the environment variable. The syntax of @env{EMACSLOADPATH} is the same as used for @code{PATH}; -directory names are separated by @samp{:} (or @samp{;}, on some +directories are separated by @samp{:} (or @samp{;}, on some operating systems). @ignore @c AFAICS, does not (yet) work right to specify non-absolute elements. diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index e6ec60f923..441fda5d82 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -1037,7 +1037,7 @@ value is @code{":"} for Unix and GNU systems, and @code{";"} for MS systems. @defun parse-colon-path path This function takes a search path string such as the value of the @env{PATH} environment variable, and splits it at the separators, -returning a list of directory names. @code{nil} in this list means +returning a list of directories. @code{nil} in this list means the current directory. Although the function's name says ``colon'', it actually uses the value of @code{path-separator}. diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi index 61ee04e2b5..84669dc4c4 100644 --- a/doc/misc/ebrowse.texi +++ b/doc/misc/ebrowse.texi @@ -253,7 +253,7 @@ of a command pipe. @findex --search-path @item --search-path=@var{paths} This option lets you specify search paths for your input files. -@var{paths} is a list of directory names, separated from each other by a +@var{paths} is a list of directories, separated by either a colon or a semicolon, depending on the operating system. @end table diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index e87ae95f62..a79170179b 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -806,8 +806,8 @@ name is expanded. The include path only affects C/C++ header files. Use the slot @code{:header-match-regexp} to change it. -The @code{:system-include-path} allows you to specify full directory -names to include directories where system header files can be found. +The @code{:system-include-path} allows you to specify absolute names +of include directories where system header files can be found. These will be applied to files in this project only. With @code{:compile-command} you can provide a command which should be diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index c32998411a..8d107e05e4 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3035,7 +3035,7 @@ Xt toolkit. @code{XFILESEARCHPATH} and @code{XUSERFILESEARCHPATH} should be a list of file names separated by colons. @code{XAPPLRESDIR} should be a list -of directory names separated by colons. +of directories separated by colons. Emacs searches for X resources: @@ -3127,7 +3127,7 @@ this behavior, type @kbd{$$} instead. Emacs has no way of knowing when the shell actually changes its directory. This is an intrinsic limitation of Unix. So it tries to guess by recognizing @samp{cd} commands. If you type @kbd{cd} followed -by a directory name with a variable reference (@kbd{cd $HOME/bin}) or +by directory with a variable reference (@kbd{cd $HOME/bin}) or with a shell metacharacter (@kbd{cd ../lib*}), Emacs will fail to correctly guess the shell's new current directory. A huge variety of fixes and enhancements to shell mode for this problem have been written diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 6f5af94b34..45797ce359 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -405,7 +405,7 @@ However, I'd discourage you from doing so, since the directory Emacs chooses will most certainly not be what you want, so let's do it the correct way. The first thing you've got to do is to -create a suitable directory (no blanks in directory name +create a suitable directory (no blanks in names please), e.g., c:\myhome. Then you must set the environment variable HOME to this directory. To do this under Windows 9x or Me include the line diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index fc104104ed..be7e7ac71a 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -43,7 +43,7 @@ file, where this release will store flags for nntp. See a later entry for more information about nntp marks. Note that downgrading isn't safe in general. -@item Incompatibility when switching from Emacs 23 to Emacs 22 +@item Incompatibility when switching from Emacs 23 to Emacs 22 In Emacs 23, Gnus uses Emacs's new internal coding system @code{utf-8-emacs} for saving articles drafts and @file{~/.newsrc.eld}. These files may not be read correctly in Emacs 22 and below. If you want to use Gnus across @@ -59,7 +59,7 @@ will shadow the latest one are detected. You can then remove those shadows manually or remove them using @code{make remove-installed-shadows}. -@item The installation directory name is allowed to have spaces and/or tabs. +@item The installation directory's name is allowed to have spaces and/or tabs. @end itemize @item New packages and libraries within Gnus diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index cd94156df3..3e9b48ec65 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -2601,7 +2601,7 @@ Enter a buffer where you can edit the group info @findex gnus-group-make-directory-group @cindex nndir Make a directory group (@pxref{Directory Groups}). You will be prompted -for a directory name (@code{gnus-group-make-directory-group}). +for the directory's name (@code{gnus-group-make-directory-group}). @item G h @kindex G h (Group) diff --git a/doc/misc/htmlfontify.texi b/doc/misc/htmlfontify.texi index addc3e177b..a04fa43a77 100644 --- a/doc/misc/htmlfontify.texi +++ b/doc/misc/htmlfontify.texi @@ -963,8 +963,9 @@ Is @ref{hfy-optimizations} member @var{symbol} set or not? @end lisp Return everything preceding the last @samp{/} from a relative filename, -on the assumption that this will produce a relative directory name. Hardly -bombproof, but good enough in the context in which it is being used. +on the assumption that this will produce the name of a relative +directory. Hardly bombproof, but good enough in the context in which +it is being used. @item hfy-html-dekludge-buffer @findex hfy-html-dekludge-buffer diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index 95cc0d1b80..7b926e109a 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -939,7 +939,7 @@ is Any environment variables (names of which must have the Unix-style form @code{$NAME}, e.g., @code{$HOME}, @code{$EMACSDATA}, @code{$EMACS_DIR}, regardless of platform) are evaluated first but each element must -evaluate to a @emph{single} directory name. Trailing @file{/}s are +evaluate to a @emph{single} name of a directory. Trailing @file{/}s are ignored. (Specific directories in @code{woman-path} are also searched.) On Microsoft platforms I recommend including drive letters explicitly, @@ -989,7 +989,7 @@ and on other platforms is @code{nil}. Any environment variables (names of which must have the Unix-style form @code{$NAME}, e.g., @code{$HOME}, @code{$EMACSDATA}, @code{$EMACS_DIR}, regardless of platform) are evaluated first but each element must -evaluate to a @emph{single} directory name (regexp, see above). For +evaluate to a @emph{single} name of a directory (regexp, see above). For example @lisp commit ad7ba0fbf16edfaf6f59310ccd56088a656964d0 Author: Eli Zaretskii Date: Sat Sep 9 22:15:30 2017 +0300 Remove more compilation warnings in MinGW64 build * src/w32.c (faccessat, map_w32_filename): * src/w32fns.c (w32_wnd_proc): * src/w32term.c (w32_horizontal_scroll_bar_handle_click) (w32_scroll_bar_handle_click): Use FALLTHROUGH to avoid compiler warnings with GCC 7 and later. diff --git a/src/w32.c b/src/w32.c index 131361d7dc..f583d5e76c 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3379,6 +3379,7 @@ map_w32_filename (const char * name, const char ** pPath) if ( ! left ) str[-1] = c; /* replace last character of part */ /* FALLTHRU */ + FALLTHROUGH; default: if ( left && 'A' <= c && c <= 'Z' ) { @@ -3958,6 +3959,7 @@ faccessat (int dirfd, const char * path, int mode, int flags) goto check_attrs; } /* FALLTHROUGH */ + FALLTHROUGH; case ERROR_FILE_NOT_FOUND: case ERROR_BAD_NETPATH: errno = ENOENT; diff --git a/src/w32fns.c b/src/w32fns.c index 60682ae3a1..6b93afa8b8 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4414,6 +4414,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) goto dflt; } /* Fall through */ + FALLTHROUGH; case WM_SYSCHAR: case WM_CHAR: @@ -4676,6 +4677,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) if (w32_pass_extra_mouse_buttons_to_system) goto dflt; /* else fall through and process them. */ + FALLTHROUGH; case WM_MBUTTONDOWN: case WM_MBUTTONUP: handle_plain_button: @@ -4781,6 +4783,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) track_mouse_event_fn (&tme); track_mouse_window = hwnd; } + FALLTHROUGH; case WM_HSCROLL: case WM_VSCROLL: if (w32_mouse_move_interval <= 0 @@ -4822,6 +4825,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) if (w32_pass_multimedia_buttons_to_system) goto dflt; /* Otherwise, pass to lisp, the same way we do with mousehwheel. */ + FALLTHROUGH; /* FIXME!!! This is never reached so what's the purpose? If the non-zero return remark below is right we're doing it wrong all @@ -5084,6 +5088,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) case WM_MOUSELEAVE: /* No longer tracking mouse. */ track_mouse_window = NULL; + FALLTHROUGH; case WM_ACTIVATEAPP: case WM_ACTIVATE: @@ -5124,6 +5129,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) menu_free_timer = 0; } } + FALLTHROUGH; case WM_MOVE: case WM_SIZE: command: @@ -5162,6 +5168,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) fails (see bug#25875). But if it fails, we want to find out about it, so let's leave 1000 for now. */ sleep (1000); + FALLTHROUGH; case WM_WINDOWPOSCHANGING: /* Don't restrict the sizing of any kind of frames. If the window diff --git a/src/w32term.c b/src/w32term.c index 2785ae2b52..e62ae7e842 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -4346,6 +4346,7 @@ w32_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg, SetScrollInfo (SCROLL_BAR_W32_WINDOW (bar), SB_CTL, &si, TRUE); } /* fall through */ + FALLTHROUGH; default: emacs_event->kind = NO_EVENT; return FALSE; @@ -4460,6 +4461,7 @@ w32_horizontal_scroll_bar_handle_click (struct scroll_bar *bar, W32Msg *msg, SetScrollInfo (SCROLL_BAR_W32_WINDOW (bar), SB_CTL, &si, TRUE); } /* fall through */ + FALLTHROUGH; default: emacs_event->kind = NO_EVENT; return FALSE; commit d63123542ffd60dbec0c9038144329b99f0f1d65 Author: Paul Eggert Date: Sat Sep 9 11:10:35 2017 -0700 Improve --enable-gcc-warnings for MinGW64 This partially reverts my 2016-05-30 patch. Apparently MinGW64 still requires pacifications that GCC 7.1.1 x86-64 (Fedora 26) does not. Also, pacify tparam.c, which isn’t used on Fedora. * lib-src/etags.c (process_file_name, TeX_commands): * src/buffer.c (fix_overlays_before): * src/data.c (Fmake_variable_buffer_local, cons_to_unsigned) (cons_to_signed): * src/editfns.c (Ftranslate_region_internal): Prefer UNINIT to some stray value, as this simplifies code-reading later. * src/eval.c (CACHEABLE): New macro. (internal_lisp_condition_case): Use it. * src/tparam.c (tparam1): Use FALLTHROUGH to pacify GCC. diff --git a/lib-src/etags.c b/lib-src/etags.c index 724cce6395..38be60e9cb 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1528,7 +1528,7 @@ process_file_name (char *file, language *lang) fdesc *fdp; compressor *compr; char *compressed_name, *uncompressed_name; - char *ext, *real_name = NULL, *tmp_name; + char *ext, *real_name UNINIT, *tmp_name; int retval; canonicalize_filename (file); @@ -5594,7 +5594,7 @@ TeX_commands (FILE *inf) linebuffer *key; char TEX_esc = '\0'; - char TEX_opgrp = 0, TEX_clgrp = 0; + char TEX_opgrp UNINIT, TEX_clgrp UNINIT; /* Initialize token table once from environment. */ if (TEX_toktab == NULL) diff --git a/src/buffer.c b/src/buffer.c index 0827e9ba44..f2689b61fd 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3764,7 +3764,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) /* If parent is nil, replace overlays_before; otherwise, parent->next. */ struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair; Lisp_Object tem; - ptrdiff_t end = prev; + ptrdiff_t end UNINIT; /* After the insertion, the several overlays may be in incorrect order. The possibility is that, in the list `overlays_before', diff --git a/src/data.c b/src/data.c index 87010e3fb2..c9818b6b20 100644 --- a/src/data.c +++ b/src/data.c @@ -1823,7 +1823,7 @@ The function `default-value' gets the default value and `set-default' sets it. struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; union Lisp_Val_Fwd valcontents; - bool forwarded = false; + bool forwarded UNINIT; CHECK_SYMBOL (variable); sym = XSYMBOL (variable); @@ -2607,7 +2607,7 @@ uintmax_t cons_to_unsigned (Lisp_Object c, uintmax_t max) { bool valid = false; - uintmax_t val = max; + uintmax_t val UNINIT; if (INTEGERP (c)) { valid = XINT (c) >= 0; @@ -2661,7 +2661,7 @@ intmax_t cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { bool valid = false; - intmax_t val = max; + intmax_t val UNINIT; if (INTEGERP (c)) { val = XINT (c); diff --git a/src/editfns.c b/src/editfns.c index 95f35549e4..d54c9c1aba 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3612,8 +3612,9 @@ It returns the number of characters changed. */) cnt = 0; for (; pos < end_pos; ) { - register unsigned char *p = BYTE_POS_ADDR (pos_byte); - unsigned char *str = tt, buf[MAX_MULTIBYTE_LENGTH]; + unsigned char *p = BYTE_POS_ADDR (pos_byte); + unsigned char *str UNINIT; + unsigned char buf[MAX_MULTIBYTE_LENGTH]; int len, str_len; int oc; Lisp_Object val; diff --git a/src/eval.c b/src/eval.c index c2cd6c60ea..a6612b93e2 100644 --- a/src/eval.c +++ b/src/eval.c @@ -30,6 +30,15 @@ along with GNU Emacs. If not, see . */ #include "dispextern.h" #include "buffer.h" +/* CACHEABLE is ordinarily nothing, except it is 'volatile' if + necessary to cajole GCC into not warning incorrectly that a + variable should be volatile. */ +#if defined GCC_LINT || defined lint +# define CACHEABLE volatile +#else +# define CACHEABLE /* empty */ +#endif + /* Chain of condition and catch handlers currently in effect. */ /* struct handler *handlerlist; */ @@ -1226,7 +1235,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { struct handler *oldhandlerlist = handlerlist; - volatile ptrdiff_t clausenb = 0; + ptrdiff_t CACHEABLE clausenb = 0; CHECK_SYMBOL (var); diff --git a/src/tparam.c b/src/tparam.c index 7a4adc2dc9..92fa5b19df 100644 --- a/src/tparam.c +++ b/src/tparam.c @@ -125,6 +125,7 @@ tparam1 (const char *string, char *outstring, int len, goto onedigit; if (tem < 100) goto twodigit; + FALLTHROUGH; case '3': /* %3 means output in decimal, 3 digits. */ if (tem > 999) { @@ -132,6 +133,7 @@ tparam1 (const char *string, char *outstring, int len, tem %= 1000; } *op++ = tem / 100 + '0'; + FALLTHROUGH; case '2': /* %2 means output in decimal, 2 digits. */ twodigit: tem %= 100; @@ -140,10 +142,12 @@ tparam1 (const char *string, char *outstring, int len, *op++ = tem % 10 + '0'; argp++; break; + case 'p': /* %pN means use param N for next subst. */ tem = fixed_argp[(*p++) - '1']; explicit_param_p = true; break; + case 'C': /* For c-100: print quotient of value by 96, if nonzero, then do like %+. */ @@ -152,8 +156,10 @@ tparam1 (const char *string, char *outstring, int len, *op++ = tem / 96; tem %= 96; } + FALLTHROUGH; case '+': /* %+x means add character code of char x. */ tem += *p++; + FALLTHROUGH; case '.': /* %. means output as character. */ if (left) { @@ -173,6 +179,7 @@ tparam1 (const char *string, char *outstring, int len, } } *op++ = tem ? tem : 0200; + FALLTHROUGH; case 'f': /* %f means discard next arg. */ argp++; break; commit 715f0835b5a0c17f2fcb43d1e75d55adce1639a5 Author: Eli Zaretskii Date: Sat Sep 9 21:04:31 2017 +0300 Fix font-lock in Compilation mode * lisp/progmodes/compile.el (compilation-face): Restore function lost during recent changes. (Bug#28349) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index f0935cd2ad..8c84398792 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -905,6 +905,16 @@ from a different message." (and (cdr type) (match-end (cdr type)) 0) 2)) +(defun compilation-face (type) + (let ((typ (compilation-type type))) + (cond + ((eq typ 1) + compilation-warning-face) + ((eq typ 0) + compilation-info-face) + ((eq typ 2) + compilation-error-face)))) + ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil) ;; COLUMN and LINE are numbers parsed from an error message. COLUMN and maybe commit 4131f9785e30f2a31745125c714e922892113c62 Author: Mark Oteiza Date: Sat Sep 9 11:55:09 2017 -0400 Add function to read all entries in a group Use that to extend xdg-desktop-read-file. Also fix a bug where all entries in all groups were read and returned by xdg-desktop-read-file. * lisp/xdg.el (xdg-desktop-read-group): New function. (xdg-desktop-read-file): Use it. * test/data/xdg/malformed.desktop: New file. * test/data/xdg/test.desktop: Add another section. * test/lisp/xdg-tests.el (xdg-desktop-parsing): Test presence of a key in another group. Test reading a prescribed group. Test detecting a malformed key=value. diff --git a/lisp/xdg.el b/lisp/xdg.el index c700021948..102e34cb0c 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -167,33 +167,41 @@ This should be called at the beginning of a line." (group-n 2 (* nonl))) "Regexp matching desktop file entry key-value pairs.") -(defun xdg--desktop-parse-line () - (skip-chars-forward "[:blank:]") - (when (/= (following-char) ?#) - (cond - ((looking-at xdg-desktop-entry-regexp) - (cons (match-string 1) (match-string 2))) - ((looking-at xdg-desktop-group-regexp) - (match-string 1))))) - -(defun xdg-desktop-read-file (filename) - "Return \"Desktop Entry\" contents of desktop file FILENAME as a hash table." - (let ((res (make-hash-table :test #'equal)) - elt group) - (with-temp-buffer - (insert-file-contents-literally filename) - (goto-char (point-min)) - (while (or (= (following-char) ?#) - (string-blank-p (buffer-substring (point) (point-at-eol)))) - (forward-line)) - (unless (equal (setq group (xdg--desktop-parse-line)) "Desktop Entry") - (error "Wrong first section: %s" group)) - (while (not (eobp)) - (when (consp (setq elt (xdg--desktop-parse-line))) - (puthash (car elt) (cdr elt) res)) - (forward-line))) +(defun xdg-desktop-read-group () + "Return hash table of group of desktop entries in the current buffer." + (let ((res (make-hash-table :test #'equal))) + (while (not (or (eobp) (looking-at xdg-desktop-group-regexp))) + (skip-chars-forward "[:blank:]") + (cond + ((eolp)) + ((= (following-char) ?#)) + ((looking-at xdg-desktop-entry-regexp) + (puthash (match-string 1) (match-string 2) res)) + (t (error "Malformed line: %s" + (buffer-substring (point) (point-at-eol))))) + (forward-line)) res)) +(defun xdg-desktop-read-file (filename &optional group) + "Return group contents of desktop file FILENAME as a hash table. +Optional argument GROUP defaults to the string \"Desktop Entry\"." + (with-temp-buffer + (insert-file-contents-literally filename) + (goto-char (point-min)) + (while (and (skip-chars-forward "[:blank:]" (line-end-position)) + (or (eolp) (= (following-char) ?#))) + (forward-line)) + (unless (looking-at xdg-desktop-group-regexp) + (error "Expected group name! Instead saw: %s" + (buffer-substring (point) (point-at-eol)))) + (unless (equal (match-string 1) "Desktop Entry") + (error "Wrong first group: %s" (match-string 1))) + (when group + (while (and (re-search-forward xdg-desktop-group-regexp nil t) + (not (equal (match-string 1) group))))) + (forward-line) + (xdg-desktop-read-group))) + (defun xdg-desktop-strings (value) "Partition VALUE into elements delimited by unescaped semicolons." (let (res) diff --git a/test/data/xdg/malformed.desktop b/test/data/xdg/malformed.desktop new file mode 100644 index 0000000000..144a3f719d --- /dev/null +++ b/test/data/xdg/malformed.desktop @@ -0,0 +1,4 @@ +# unacceptable key=value format +[Desktop Entry] +Key=value +aowef faoweif of diff --git a/test/data/xdg/test.desktop b/test/data/xdg/test.desktop index b6dda62774..b848cef5b0 100644 --- a/test/data/xdg/test.desktop +++ b/test/data/xdg/test.desktop @@ -1,3 +1,5 @@ # this is a comment [Desktop Entry] Name=Test +[Another Section] +Exec=frobnicate diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index 59c850b07a..4822a05c1e 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -32,12 +32,20 @@ (ert-deftest xdg-desktop-parsing () "Test `xdg-desktop-read-file' parsing of .desktop files." - (let ((tab (xdg-desktop-read-file - (expand-file-name "test.desktop" xdg-tests-data-dir)))) - (should (equal (gethash "Name" tab) "Test"))) + (let ((tab1 (xdg-desktop-read-file + (expand-file-name "test.desktop" xdg-tests-data-dir))) + (tab2 (xdg-desktop-read-file + (expand-file-name "test.desktop" xdg-tests-data-dir) + "Another Section"))) + (should (equal (gethash "Name" tab1) "Test")) + (should (eq 'default (gethash "Exec" tab1 'default))) + (should (equal "frobnicate" (gethash "Exec" tab2)))) (should-error (xdg-desktop-read-file - (expand-file-name "wrong.desktop" xdg-tests-data-dir)))) + (expand-file-name "wrong.desktop" xdg-tests-data-dir))) + (should-error + (xdg-desktop-read-file + (expand-file-name "malformed.desktop" xdg-tests-data-dir)))) (ert-deftest xdg-desktop-strings-type () "Test desktop \"string(s)\" type: strings delimited by \";\"." commit 68b7ecbac1dcb5bfcace5505a4d354777147dd54 Author: Gemini Lasswell Date: Wed Aug 30 07:11:41 2017 -0700 Reduce Tramp's memory usage Construct Tramp syntax strings and regular expressions once instead of every time they are used, and store them in alists keyed by Tramp syntax. * tramp.el (tramp-build-remote-file-name-spec-regexp) (tramp-build-file-name-structure): New functions. (tramp-prefix-format-alist, tramp-prefix-regexp-alist) (tramp-method-regexp-alist) (tramp-postfix-method-format-alist) (tramp-postfix-method-regexp-alist) (tramp-prefix-ipv6-format-alist, tramp-prefix-ipv6-regexp-alist) (tramp-postfix-ipv6-format-alist) (tramp-postfix-ipv6-regexp-alist) (tramp-postfix-host-format-alist) (tramp-postfix-host-regexp-alist) (tramp-remote-file-name-spec-regexp-alist) (tramp-file-name-structure-alist): New constants. (tramp-lookup-syntax): New function. (tramp-prefix-format, tramp-prefix-regexp, tramp-method-regexp) (tramp-postfix-method-format, tramp-postfix-method-regexp) (tramp-prefix-ipv6-format, tramp-prefix-ipv6-regexp) (tramp-postfix-ipv6-format, tramp-postfix-ipv6-regexp) (tramp-postfix-host-format, tramp-postfix-host-regexp) (tramp-remote-file-name-spec-regexp, tramp-file-name-structure): Use it. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index f4b69dbc66..118960be5e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -700,40 +700,69 @@ Do not change the value by `setq', it must be changed only by (setq values (mapcar 'last values) values (mapcar 'car values)))) +(defun tramp-lookup-syntax (alist) + "Look up a syntax string in ALIST according to `tramp-compat-tramp-syntax.' +Raise an error if `tramp-syntax' is invalid." + (or (cdr (assq (tramp-compat-tramp-syntax) alist)) + (error "Wrong `tramp-syntax' %s" tramp-syntax))) + +(defconst tramp-prefix-format-alist + '((default . "/") + (simplified . "/") + (separate . "/[")) + "Alist mapping Tramp syntax to strings beginning Tramp file names.") + (defun tramp-prefix-format () "String matching the very beginning of Tramp file names. Used in `tramp-make-tramp-file-name'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) "/") - ((eq (tramp-compat-tramp-syntax) 'simplified) "/") - ((eq (tramp-compat-tramp-syntax) 'separate) "/[") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-prefix-format-alist)) + +(defconst tramp-prefix-regexp-alist + (mapcar (lambda (x) + (cons (car x) (concat "^" (regexp-quote (cdr x))))) + tramp-prefix-format-alist) + "Alist of regexps matching the beginnings of Tramp file names. +Keyed by Tramp syntax. Derived from `tramp-prefix-format-alist'.") (defun tramp-prefix-regexp () "Regexp matching the very beginning of Tramp file names. Should always start with \"^\". Derived from `tramp-prefix-format'." - (concat "^" (regexp-quote (tramp-prefix-format)))) + (tramp-lookup-syntax tramp-prefix-regexp-alist)) + +(defconst tramp-method-regexp-alist + '((default . "[a-zA-Z0-9-]+") + (simplified . "") + (separate . "[a-zA-Z0-9-]*")) + "Alist mapping Tramp syntax to regexps matching methods identifiers.") (defun tramp-method-regexp () "Regexp matching methods identifiers. The `ftp' syntax does not support methods." - (cond ((eq (tramp-compat-tramp-syntax) 'default) "[a-zA-Z0-9-]+") - ((eq (tramp-compat-tramp-syntax) 'simplified) "") - ((eq (tramp-compat-tramp-syntax) 'separate) "[a-zA-Z0-9-]*") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-method-regexp-alist)) + +(defconst tramp-postfix-method-format-alist + '((default . ":") + (simplified . "") + (separate . "/")) + "Alist mapping Tramp syntax to the delimiter after the method.") (defun tramp-postfix-method-format () "String matching delimiter between method and user or host names. The `ftp' syntax does not support methods. Used in `tramp-make-tramp-file-name'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) ":") - ((eq (tramp-compat-tramp-syntax) 'simplified) "") - ((eq (tramp-compat-tramp-syntax) 'separate) "/") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-postfix-method-format-alist)) + +(defconst tramp-postfix-method-regexp-alist + (mapcar (lambda (x) + (cons (car x) (regexp-quote (cdr x)))) + tramp-postfix-method-format-alist) + "Alist mapping Tramp syntax to regexp matching delimiter after method. +Derived from `tramp-postfix-method-format-alist'.") (defun tramp-postfix-method-regexp () "Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'." - (regexp-quote (tramp-postfix-method-format))) + (tramp-lookup-syntax tramp-postfix-method-regexp-alist)) (defconst tramp-user-regexp "[^/|: \t]+" "Regexp matching user names.") @@ -769,18 +798,28 @@ Derived from `tramp-postfix-user-format'.") (defconst tramp-host-regexp "[a-zA-Z0-9_.-]+" "Regexp matching host names.") +(defconst tramp-prefix-ipv6-format-alist + '((default . "[") + (simplified . "[") + (separate . "")) + "Alist mapping Tramp syntax to strings prefixing IPv6 addresses.") + (defun tramp-prefix-ipv6-format () "String matching left hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) "[") - ((eq (tramp-compat-tramp-syntax) 'simplified) "[") - ((eq (tramp-compat-tramp-syntax) 'separate) "") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-prefix-ipv6-format-alist)) + +(defconst tramp-prefix-ipv6-regexp-alist + (mapcar (lambda (x) + (cons (car x) (regexp-quote (cdr x)))) + tramp-prefix-ipv6-format-alist) + "Alist mapping Tramp syntax to regexp matching prefix of IPv6 addresses. +Derived from `tramp-prefix-ipv6-format-alist'") (defun tramp-prefix-ipv6-regexp () "Regexp matching left hand side of IPv6 addresses. Derived from `tramp-prefix-ipv6-format'." - (regexp-quote (tramp-prefix-ipv6-format))) + (tramp-lookup-syntax tramp-prefix-ipv6-regexp-alist)) ;; The following regexp is a bit sloppy. But it shall serve our ;; purposes. It covers also IPv4 mapped IPv6 addresses, like in @@ -789,18 +828,28 @@ Derived from `tramp-prefix-ipv6-format'." "\\(?:\\(?:[a-zA-Z0-9]+\\)?:\\)+[a-zA-Z0-9.]+" "Regexp matching IPv6 addresses.") +(defconst tramp-postfix-ipv6-format-alist + '((default . "]") + (simplified . "]") + (separate . "")) + "Alist mapping Tramp syntax to suffix for IPv6 addresses.") + (defun tramp-postfix-ipv6-format () "String matching right hand side of IPv6 addresses. Used in `tramp-make-tramp-file-name'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) "]") - ((eq (tramp-compat-tramp-syntax) 'simplified) "]") - ((eq (tramp-compat-tramp-syntax) 'separate) "") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) + +(defconst tramp-postfix-ipv6-regexp-alist + (mapcar (lambda (x) + (cons (car x) (regexp-quote (cdr x)))) + tramp-postfix-ipv6-format-alist) + "Alist mapping Tramp syntax to regexps matching IPv6 suffixes. +Derived from `tramp-postfix-ipv6-format-alist'.") (defun tramp-postfix-ipv6-regexp () "Regexp matching right hand side of IPv6 addresses. Derived from `tramp-postfix-ipv6-format'." - (regexp-quote (tramp-postfix-ipv6-format))) + (tramp-lookup-syntax tramp-postfix-ipv6-format-alist)) (defconst tramp-prefix-port-format "#" "String matching delimiter between host names and port numbers.") @@ -827,18 +876,28 @@ Derived from `tramp-prefix-port-format'.") "Regexp matching delimiter after ad-hoc hop definitions. Derived from `tramp-postfix-hop-format'.") +(defconst tramp-postfix-host-format-alist + '((default . ":") + (simplified . ":") + (separate . "]")) + "Alist mapping Tramp syntax to strings between host and local names.") + (defun tramp-postfix-host-format () "String matching delimiter between host names and localnames. Used in `tramp-make-tramp-file-name'." - (cond ((eq (tramp-compat-tramp-syntax) 'default) ":") - ((eq (tramp-compat-tramp-syntax) 'simplified) ":") - ((eq (tramp-compat-tramp-syntax) 'separate) "]") - (t (error "Wrong `tramp-syntax' %s" tramp-syntax)))) + (tramp-lookup-syntax tramp-postfix-host-format-alist)) + +(defconst tramp-postfix-host-regexp-alist + (mapcar (lambda (x) + (cons (car x) (regexp-quote (cdr x)))) + tramp-postfix-host-format-alist) + "Alist mapping Tramp syntax to regexp matching name delimiters. +Derived from `tramp-postfix-host-format-alist'.") (defun tramp-postfix-host-regexp () "Regexp matching delimiter between host names and localnames. Derived from `tramp-postfix-host-format'." - (regexp-quote (tramp-postfix-host-format))) + (tramp-lookup-syntax tramp-postfix-host-regexp-alist)) (defconst tramp-localname-regexp ".*$" "Regexp matching localnames.") @@ -851,16 +910,46 @@ Derived from `tramp-postfix-host-format'." ;;; File name format: +(defun tramp-build-remote-file-name-spec-regexp (syntax) + "Construct a regexp matching a Tramp file name for a Tramp SYNTAX." + (let ((tramp-syntax syntax)) + (concat + "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) + "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" + "\\(" "\\(?:" tramp-host-regexp "\\|" + (tramp-prefix-ipv6-regexp) + "\\(?:" tramp-ipv6-regexp "\\)?" + (tramp-postfix-ipv6-regexp) "\\)?" + "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?"))) + +(defconst tramp-remote-file-name-spec-regexp-alist + `((default . ,(tramp-build-remote-file-name-spec-regexp 'default)) + (simplified . ,(tramp-build-remote-file-name-spec-regexp 'simplified)) + (separate . ,(tramp-build-remote-file-name-spec-regexp 'separate))) + "Alist mapping Tramp syntax to regexps matching Tramp file names.") + (defun tramp-remote-file-name-spec-regexp () "Regular expression matching a Tramp file name between prefix and postfix." - (concat - "\\(" (tramp-method-regexp) "\\)" (tramp-postfix-method-regexp) - "\\(?:" "\\(" tramp-user-regexp "\\)" tramp-postfix-user-regexp "\\)?" - "\\(" "\\(?:" tramp-host-regexp "\\|" - (tramp-prefix-ipv6-regexp) - "\\(?:" tramp-ipv6-regexp "\\)?" - (tramp-postfix-ipv6-regexp) "\\)?" - "\\(?:" tramp-prefix-port-regexp tramp-port-regexp "\\)?" "\\)?")) + (tramp-lookup-syntax tramp-remote-file-name-spec-regexp-alist)) + +(defun tramp-build-file-name-structure (syntax) + "Construct the Tramp file name structure for SYNTAX. +See `tramp-file-name-structure'." + (let ((tramp-syntax syntax)) + (list + (concat + (tramp-prefix-regexp) + "\\(" "\\(?:" (tramp-remote-file-name-spec-regexp) + tramp-postfix-hop-regexp "\\)+" "\\)?" + (tramp-remote-file-name-spec-regexp) (tramp-postfix-host-regexp) + "\\(" tramp-localname-regexp "\\)") + 5 6 7 8 1))) + +(defconst tramp-file-name-structure-alist + `((default . ,(tramp-build-file-name-structure 'default)) + (simplified . ,(tramp-build-file-name-structure 'simplified)) + (separate . ,(tramp-build-file-name-structure 'separate))) + "Alist mapping Tramp syntax to the file name structure for that syntax.") (defun tramp-file-name-structure () "List of six elements (REGEXP METHOD USER HOST FILE HOP), detailing \ @@ -881,14 +970,7 @@ These numbers are passed directly to `match-string', which see. That means the opening parentheses are counted to identify the pair. See also `tramp-file-name-regexp'." - (list - (concat - (tramp-prefix-regexp) - "\\(" "\\(?:" (tramp-remote-file-name-spec-regexp) - tramp-postfix-hop-regexp "\\)+" "\\)?" - (tramp-remote-file-name-spec-regexp) (tramp-postfix-host-regexp) - "\\(" tramp-localname-regexp "\\)") - 5 6 7 8 1)) + (tramp-lookup-syntax tramp-file-name-structure-alist)) (defun tramp-file-name-regexp () "Regular expression matching file names handled by Tramp. commit 2b84c1666274edcb6b810649fa0d6fc09e9e7a66 Author: Eli Zaretskii Date: Sat Sep 9 18:50:50 2017 +0300 Fix compilation warnings in MinGW64 build using GCC 7 Reported by Richard Copley . * src/w32heap.c (init_heap): Declare enable_lfh only for mingw.org's MinGW build. * src/w32console.c (w32con_write_glyphs): * src/unexw32.c (get_section_info, COPY_CHUNK, unexec): Fix some mismatches of data type vs format spec. * src/w32fns.c (compute_tip_xy): * src/w32proc.c (stop_timer_thread): * src/w32notify.c (remove_watch): * src/eval.c (internal_lisp_condition_case): * src/editfns.c (Ftranslate_region_internal): * src/data.c (Fmake_variable_buffer_local, cons_to_unsigned) (cons_to_signed): * src/buffer.c (fix_overlays_before): Initialize variables to avoid compiler warnings. * lib-src/etags.c (TeX_commands, process_file_name): Initialize variables to avoid compilation warnings. diff --git a/lib-src/etags.c b/lib-src/etags.c index 5e05c19c62..724cce6395 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -1528,7 +1528,7 @@ process_file_name (char *file, language *lang) fdesc *fdp; compressor *compr; char *compressed_name, *uncompressed_name; - char *ext, *real_name, *tmp_name; + char *ext, *real_name = NULL, *tmp_name; int retval; canonicalize_filename (file); @@ -5594,7 +5594,7 @@ TeX_commands (FILE *inf) linebuffer *key; char TEX_esc = '\0'; - char TEX_opgrp, TEX_clgrp; + char TEX_opgrp = 0, TEX_clgrp = 0; /* Initialize token table once from environment. */ if (TEX_toktab == NULL) diff --git a/src/buffer.c b/src/buffer.c index 2d508f35cf..0827e9ba44 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3764,7 +3764,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) /* If parent is nil, replace overlays_before; otherwise, parent->next. */ struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair; Lisp_Object tem; - ptrdiff_t end; + ptrdiff_t end = prev; /* After the insertion, the several overlays may be in incorrect order. The possibility is that, in the list `overlays_before', diff --git a/src/data.c b/src/data.c index 559844b03f..87010e3fb2 100644 --- a/src/data.c +++ b/src/data.c @@ -1823,7 +1823,7 @@ The function `default-value' gets the default value and `set-default' sets it. struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; union Lisp_Val_Fwd valcontents; - bool forwarded; + bool forwarded = false; CHECK_SYMBOL (variable); sym = XSYMBOL (variable); @@ -2607,7 +2607,7 @@ uintmax_t cons_to_unsigned (Lisp_Object c, uintmax_t max) { bool valid = false; - uintmax_t val; + uintmax_t val = max; if (INTEGERP (c)) { valid = XINT (c) >= 0; @@ -2661,7 +2661,7 @@ intmax_t cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { bool valid = false; - intmax_t val; + intmax_t val = max; if (INTEGERP (c)) { val = XINT (c); diff --git a/src/editfns.c b/src/editfns.c index d599fcfec8..95f35549e4 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -3613,7 +3613,7 @@ It returns the number of characters changed. */) for (; pos < end_pos; ) { register unsigned char *p = BYTE_POS_ADDR (pos_byte); - unsigned char *str, buf[MAX_MULTIBYTE_LENGTH]; + unsigned char *str = tt, buf[MAX_MULTIBYTE_LENGTH]; int len, str_len; int oc; Lisp_Object val; diff --git a/src/eval.c b/src/eval.c index e3e7d8e26b..c2cd6c60ea 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1226,7 +1226,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { struct handler *oldhandlerlist = handlerlist; - ptrdiff_t clausenb = 0; + volatile ptrdiff_t clausenb = 0; CHECK_SYMBOL (var); diff --git a/src/unexw32.c b/src/unexw32.c index 904447c3ec..5259b2a52b 100644 --- a/src/unexw32.c +++ b/src/unexw32.c @@ -357,7 +357,7 @@ get_section_info (file_data *p_infile) /* Check the NT header signature ... */ if (nt_header->Signature != IMAGE_NT_SIGNATURE) { - printf ("Invalid IMAGE_NT_SIGNATURE 0x%x in %s...bailing.\n", + printf ("Invalid IMAGE_NT_SIGNATURE 0x%lx in %s...bailing.\n", nt_header->Signature, p_infile->name); exit (1); } @@ -496,7 +496,7 @@ copy_executable_and_dump_data (file_data *p_infile, printf ("%s\n", (message)); \ printf ("\t0x%08x Offset in input file.\n", s - p_infile->file_base); \ printf ("\t0x%08x Offset in output file.\n", dst - p_outfile->file_base); \ - printf ("\t0x%08x Size in bytes.\n", count); \ + printf ("\t0x%08lx Size in bytes.\n", count); \ } \ memcpy (dst, s, count); \ dst += count; \ @@ -739,7 +739,7 @@ unexec (const char *new_name, const char *old_name) /* Open the undumped executable file. */ if (!open_input_file (&in_file, in_filename)) { - printf ("Failed to open %s (%d)...bailing.\n", + printf ("Failed to open %s (%lu)...bailing.\n", in_filename, GetLastError ()); exit (1); } @@ -754,7 +754,7 @@ unexec (const char *new_name, const char *old_name) extra_bss_size_static; if (!open_output_file (&out_file, out_filename, size)) { - printf ("Failed to open %s (%d)...bailing.\n", + printf ("Failed to open %s (%lu)...bailing.\n", out_filename, GetLastError ()); exit (1); } diff --git a/src/w32console.c b/src/w32console.c index 8df6379d40..a4c089fa96 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -333,7 +333,7 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string, coding->produced, cursor_coords, &r)) { - printf ("Failed writing console attributes: %d\n", + printf ("Failed writing console attributes: %lu\n", GetLastError ()); fflush (stdout); } @@ -343,7 +343,7 @@ w32con_write_glyphs (struct frame *f, register struct glyph *string, coding->produced, cursor_coords, &r)) { - printf ("Failed writing console characters: %d\n", + printf ("Failed writing console characters: %lu\n", GetLastError ()); fflush (stdout); } diff --git a/src/w32fns.c b/src/w32fns.c index bf3c1d5d30..60682ae3a1 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4413,7 +4413,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) TranslateMessage (&windows_msg); goto dflt; } - /* Fall through */ case WM_SYSCHAR: @@ -7171,7 +7170,7 @@ compute_tip_xy (struct frame *f, int width, int height, int *root_x, int *root_y) { Lisp_Object left, top, right, bottom; - int min_x = 0, min_y, max_x = 0, max_y; + int min_x = 0, min_y = 0, max_x = 0, max_y = 0; /* User-specified position? */ left = Fcdr (Fassq (Qleft, parms)); diff --git a/src/w32heap.c b/src/w32heap.c index 54de961749..cd1324cc86 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -228,7 +228,9 @@ init_heap (void) { if (using_dynamic_heap) { +#ifndef MINGW_W64 unsigned long enable_lfh = 2; +#endif /* After dumping, use a new private heap. We explicitly enable the low fragmentation heap (LFH) here, for the sake of pre diff --git a/src/w32notify.c b/src/w32notify.c index e8bdef8bdd..7987d9f656 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -423,7 +423,7 @@ remove_watch (struct notification *dirwatch) { int i; BOOL status; - DWORD exit_code = 0, err; + DWORD exit_code = 0, err = 0; /* Only the thread that issued the outstanding I/O call can call CancelIo on it. (CancelIoEx is available only since Vista.) diff --git a/src/w32proc.c b/src/w32proc.c index 085995df58..4459ebe324 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -485,7 +485,7 @@ stop_timer_thread (int which) struct itimer_data *itimer = (which == ITIMER_REAL) ? &real_itimer : &prof_itimer; int i; - DWORD err, exit_code = 255; + DWORD err = 0, exit_code = 255; BOOL status; /* Signal the thread that it should terminate. */ commit e91da7f8f2523057fa93ea4aace36863315abb5b Author: Miles Bader Date: Sat Sep 9 23:28:08 2017 +0900 ; Add a comment for make-text-button in rcirc-markup-urls diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 60af1973cc..6377f791f4 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2499,6 +2499,9 @@ If ARG is given, opens the URL in a new browser window." (end (match-end 0)) (url (match-string-no-properties 0)) (link-text (buffer-substring-no-properties start end))) + ;; Add a button for the URL. Note that we use `make-text-button', + ;; rather than `make-button', as text-buttons are much faster in + ;; large buffers. (make-text-button start end 'face 'rcirc-url 'follow-link t commit d1da8e534db54bb82b6f2b16bba86a6d202ac675 Author: Eli Zaretskii Date: Sat Sep 9 17:20:47 2017 +0300 Avoid infloop when scrolling under scroll-preserve-screen-position * src/window.c (window_scroll_pixel_based): If screen position is to be preserved, make sure its recorded Y coordinate is outside the scroll margin. (Bug#28342) diff --git a/src/window.c b/src/window.c index 857870591f..18adb62538 100644 --- a/src/window.c +++ b/src/window.c @@ -5335,6 +5335,11 @@ window_scroll_pixel_based (Lisp_Object window, int n, bool whole, bool noerror) break; } SET_PT_BOTH (IT_CHARPOS (it), IT_BYTEPOS (it)); + /* Fix up the Y position to preserve, if it is inside the + scroll margin at the window top. */ + if (window_scroll_pixel_based_preserve_y >= 0 + && window_scroll_pixel_based_preserve_y < this_scroll_margin) + window_scroll_pixel_based_preserve_y = this_scroll_margin; } } else if (n < 0) commit af11532bb5f5ff8229b84c3ab6888069764bbddf Author: Michael Albinus Date: Sat Sep 9 12:31:54 2017 +0200 Clarification in tramp-texi * doc/misc/tramp.texi (Connection caching): Two connections are regarded as different now when they differ in the port number only. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 5e0b1d854f..7e8ce75f2d 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1695,18 +1695,6 @@ new one on next Emacs startup. Set @option{tramp-persistency-file-name} to @code{nil} to disable storing connections persistently. -To reuse connection information from the persistent list, -@value{tramp} needs to uniquely identify every host. However in some -cases, two different connections may result in the same persistent -information. For example, connecting to a host using @command{ssh} and -connecting to the same host through @code{sshd} on port 3001. Both -access methods result in nearly identical persistent specifications -@file{@trampfn{ssh,localhost,}} and @file{@trampfn{ssh,localhost#3001,}}. - -Changing host names could avoid duplicates. One way is to add a -@option{Host} section in @file{~/.ssh/config} (@pxref{Frequently Asked -Questions}). Another way is to apply multiple hops (@pxref{Multi-hops}). - When @value{tramp} detects a change in the operating system version in a remote host (via the command @command{uname -sr}), it flushes all connection related information for that host and creates a new entry. commit be9bc8e67d6caf6d61fe4f46ac5b640ada16ba95 Author: Mark Oteiza Date: Sat Sep 9 00:46:41 2017 -0400 ; Fix previous commit See https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00101.html * test/lisp/xdg.el: Remove match data tests. * lisp/xdg.el (xdg-user-dir): Fix docstring. Remove save-match-data. (xdg-desktop-read-file, xdg-desktop-strings): Remove save-match-data. diff --git a/lisp/xdg.el b/lisp/xdg.el index 4b255429db..c700021948 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -143,12 +143,11 @@ This should be called at the beginning of a line." res)) (defun xdg-user-dir (name) - "Return the path of user directory referred to by NAME." + "Return the directory referred to by NAME." (when (null xdg-user-dirs) - (save-match-data - (setq xdg-user-dirs - (xdg--user-dirs-parse-file - (expand-file-name "user-dirs.dirs" (xdg-config-home)))))) + (setq xdg-user-dirs + (xdg--user-dirs-parse-file + (expand-file-name "user-dirs.dirs" (xdg-config-home))))) (let ((dir (cdr (assoc name xdg-user-dirs)))) (when dir (expand-file-name dir)))) @@ -182,27 +181,25 @@ This should be called at the beginning of a line." (let ((res (make-hash-table :test #'equal)) elt group) (with-temp-buffer - (save-match-data - (insert-file-contents-literally filename) - (goto-char (point-min)) - (while (or (= (following-char) ?#) - (string-blank-p (buffer-substring (point) (point-at-eol)))) - (forward-line)) - (unless (equal (setq group (xdg--desktop-parse-line)) "Desktop Entry") - (error "Wrong first section: %s" group)) - (while (not (eobp)) - (when (consp (setq elt (xdg--desktop-parse-line))) - (puthash (car elt) (cdr elt) res)) - (forward-line)))) + (insert-file-contents-literally filename) + (goto-char (point-min)) + (while (or (= (following-char) ?#) + (string-blank-p (buffer-substring (point) (point-at-eol)))) + (forward-line)) + (unless (equal (setq group (xdg--desktop-parse-line)) "Desktop Entry") + (error "Wrong first section: %s" group)) + (while (not (eobp)) + (when (consp (setq elt (xdg--desktop-parse-line))) + (puthash (car elt) (cdr elt) res)) + (forward-line))) res)) (defun xdg-desktop-strings (value) "Partition VALUE into elements delimited by unescaped semicolons." (let (res) - (save-match-data - (setq value (string-trim-left value)) - (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";")) - (push (replace-regexp-in-string "\0" ";" x) res))) + (setq value (string-trim-left value)) + (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";")) + (push (replace-regexp-in-string "\0" ";" x) res)) (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res)) (nreverse res))) diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el index e7e122b54e..59c850b07a 100644 --- a/test/lisp/xdg-tests.el +++ b/test/lisp/xdg-tests.el @@ -3,7 +3,6 @@ ;; Copyright (C) 2017 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org - ;; Author: Mark Oteiza ;; This file is part of GNU Emacs. @@ -31,24 +30,6 @@ (defconst xdg-tests-data-dir (expand-file-name "test/data/xdg" source-directory)) -(ert-deftest xdg-match-data () - "Ensure public functions do not mangle match data." - (let ((data '(1 9))) - (save-match-data - (set-match-data data) - (xdg-user-dir "DOCUMENTS") - (should (equal (match-data) data)))) - (let ((data '(2 9))) - (save-match-data - (set-match-data data) - (xdg-desktop-read-file (expand-file-name "test.desktop" xdg-tests-data-dir)) - (should (equal (match-data) data)))) - (let ((data '(3 9))) - (save-match-data - (set-match-data data) - (xdg-desktop-strings "a;b") - (should (equal (match-data) data))))) - (ert-deftest xdg-desktop-parsing () "Test `xdg-desktop-read-file' parsing of .desktop files." (let ((tab (xdg-desktop-read-file commit ce9640845155c1dd9c11e46104f223af7cd4f7fa Author: Miles Bader Date: Fri Sep 19 15:33:13 2014 +0900 * admin/quick-install-emacs: Tweak configure.ac parsing diff --git a/admin/quick-install-emacs b/admin/quick-install-emacs index a5ec6965b1..76b3c64650 100755 --- a/admin/quick-install-emacs +++ b/admin/quick-install-emacs @@ -172,7 +172,10 @@ test x"$prefix" = x && { prefix="`get_config_var prefix`" || exit 4 ; } test x"$ARCH" = x && { ARCH="`get_config_var host`" || exit 4 ; } VERSION=` - sed -n 's/^AC_INIT(emacs,[ ]*\([^ )]*\).*/\1/p' <$SRC/configure.ac + sed -n 's/^AC_INIT([ ]*emacs[ ]*,[ ]*\([^ ),]*\).*/\1/p' <$SRC/configure.ac +` || exit 4 +test -n "$VERSION" || VERSION=` + sed -n 's/^AC_INIT([ ]*GNU Emacs[ ]*,[ ]*\([^ ),]*\).*/\1/p' <$SRC/configure.ac ` || exit 4 test -n "$VERSION" || { printf '%s\n' >&2 "$me: no version in configure.ac"; exit 4; } commit b464dab2af90b5ebcf1925fcca144a9ed294e6a3 Author: Miles Bader Date: Tue Jul 30 19:21:31 2013 +0900 Use text-property buttons in rcirc-markup-urls * lisp/net/rcirc.el (rcirc-markup-urls): Use `make-text-button' instead of `make-button'; the former is much more efficient in large buffers, and for the purposes of rcirc, changes no functionality. diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index c01ece9641..60af1973cc 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -2499,12 +2499,12 @@ If ARG is given, opens the URL in a new browser window." (end (match-end 0)) (url (match-string-no-properties 0)) (link-text (buffer-substring-no-properties start end))) - (make-button start end - 'face 'rcirc-url - 'follow-link t - 'rcirc-url url - 'action (lambda (button) - (browse-url (button-get button 'rcirc-url)))) + (make-text-button start end + 'face 'rcirc-url + 'follow-link t + 'rcirc-url url + 'action (lambda (button) + (browse-url (button-get button 'rcirc-url)))) ;; record the url if it is not already the latest stored url (when (not (string= link-text (caar rcirc-urls))) (push (cons link-text start) rcirc-urls))))) commit 79150f6086286294c9e5ed56df5b14c87129cde6 Author: Eli Zaretskii Date: Fri Sep 8 16:15:23 2017 +0300 Fix line-pixel-height for lines of variable height * src/xdisp.c (Fline_pixel_height): Start moving from the beginning of the screen line, to capture the full metrics of the line. (Bug#28391) diff --git a/src/xdisp.c b/src/xdisp.c index ad9b29835e..5e8188cacb 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1195,6 +1195,10 @@ Value is the height in pixels of the line at point. */) } SET_TEXT_POS (pt, PT, PT_BYTE); start_display (&it, w, pt); + /* Start from the beginning of the screen line, to make sure we + traverse all of its display elements, and thus capture the + correct metrics. */ + move_it_by_lines (&it, 0); it.vpos = it.current_y = 0; last_height = 0; result = make_number (line_bottom_y (&it)); commit 5f31879e16226382b6d598b6e0a42ab24f255c8f Author: Alex Branham Date: Fri Sep 8 12:36:59 2017 +0300 New variable 'dired-confirm-killing-deleted-buffers' * lisp/dired-x.el (dired-clean-confirm-killing-deleted-buffers): New variable. * lisp/dired.el (dired-clean-up-after-deletion): Kill buffers visiting deleted files without confirming if dired-clean-confirm-killing-deleted-buffers is nil. (Bug#28373) * etc/NEWS: Document the change. Copyright-paperwork-exempt: yes diff --git a/etc/NEWS b/etc/NEWS index 7b06e56a21..3f7feba6dd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -604,6 +604,12 @@ this is controlled by the 'wdired-create-parent-directories' variable. *** 'W' is now bound to 'browse-url-of-dired-file', and is useful for viewing HTML files and the like. +--- +*** New variable 'dired-clean-confirm-killing-deleted-buffers' +controls whether Dired asks to kill buffers visiting deleted files and +directories. The default is t, so Dired asks for confirmation, to +keep previous behavior. + --- ** html2text is now marked obsolete. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 1425278bdc..bfb5574da3 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -243,6 +243,12 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." :type 'boolean :group 'dired-x) +(defcustom dired-clean-confirm-killing-deleted-buffers t + "If nil, don't ask whether to kill buffers visiting deleted files." + :version "26.1" + :type 'boolean + :group 'dired-x) + ;;; KEY BINDINGS. (define-key dired-mode-map "\C-x\M-o" 'dired-omit-mode) diff --git a/lisp/dired.el b/lisp/dired.el index 052f9a5214..c7e28a4e71 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3180,12 +3180,15 @@ non-empty directories is allowed." (dired-clean-up-after-deletion file)) (defvar dired-clean-up-buffers-too) +(defvar dired-clean-confirm-killing-deleted-buffers) (defun dired-clean-up-after-deletion (fn) "Clean up after a deleted file or directory FN. -Removes any expanded subdirectory of deleted directory. -If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil, -also offers to kill buffers visiting deleted files and directories." +Removes any expanded subdirectory of deleted directory. If +`dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil, +kill any buffers visiting those files, prompting for +confirmation. To disable the confirmation, see +`dired-clean-confirm-killing-deleted-buffers'." (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) (dired-kill-subdir))) @@ -3193,15 +3196,17 @@ also offers to kill buffers visiting deleted files and directories." (when (and (featurep 'dired-x) dired-clean-up-buffers-too) (let ((buf (get-file-buffer fn))) (and buf - (funcall #'y-or-n-p - (format "Kill buffer of %s, too? " - (file-name-nondirectory fn))) + (and dired-clean-confirm-killing-deleted-buffers + (funcall #'y-or-n-p + (format "Kill buffer of %s, too? " + (file-name-nondirectory fn)))) (kill-buffer buf))) (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) (and buf-list - (y-or-n-p (format "Kill Dired buffer%s of %s, too? " - (dired-plural-s (length buf-list)) - (file-name-nondirectory fn))) + (and dired-clean-confirm-killing-deleted-buffers + (y-or-n-p (format "Kill Dired buffer%s of %s, too? " + (dired-plural-s (length buf-list)) + (file-name-nondirectory fn)))) (dolist (buf buf-list) (kill-buffer buf)))))) commit 9b9c93053a6691303b2ad73f107576e07cd69db4 Author: Alfred M. Szmidt Date: Fri Sep 8 12:19:24 2017 +0300 Support SVN files with svn:externals property * lisp/vc/vc-svn.el (vc-svn-parse-status): Don't ignore files marked with the svn:externals property. Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index a67c2264d8..f1e8985c16 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -701,8 +701,7 @@ Set file properties accordingly. If FILENAME is non-nil, return its status." (let (multifile file status propstat) (goto-char (point-min)) (while (re-search-forward - ;; Ignore the files with status X. - "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ S]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) + "^\\(?:\\?\\|[ ACDGIMR!~][ MC][ L][ +][ SX]..\\([ *]\\) +\\([-0-9]+\\) +\\([0-9?]+\\) +\\([^ ]+\\)\\) +" nil t) ;; If the username contains spaces, the output format is ambiguous, ;; so don't trust the output's filename unless we have to. (setq file (or (unless multifile filename) commit e3476d293736d8e7d8d3ea47bba407ace15addbc Author: Alfred M. Szmidt Date: Fri Sep 8 12:14:58 2017 +0300 List locally removed files in vc-dir with SVN back-end * lisp/vc/vc-svn.el (vc-svn-after-dir-status): List files marked with ?! as needs-update. Copyright-paperwork-exempt: yes diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index db16eb202d..a67c2264d8 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -184,6 +184,7 @@ switches." (?M . edited) (?D . removed) (?R . removed) + (?! . needs-update) (?? . unregistered) ;; This is what vc-svn-parse-status does. (?~ . edited))) commit f82d9323afff7a51e9303d43d7952f42acef843d Author: Ken Olum Date: Fri Sep 8 12:08:49 2017 +0300 Fix Rmail editing with reapplying encoding to message body * lisp/mail/rmailedit.el (rmail-cease-edit): If no content-type in edited headers, look for one in original headers and add it to edited headers. (Bug #26918) Use a marker to track start of new body, so that content-transfer-encoding gets applied only to body. (Bug #27353). Ensure blank line at end of message after encoding, not before. diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index df1577fa91..e9bb5560df 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -188,10 +188,6 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (beginning-of-line) (insert ">") (forward-line))) - ;; Make sure buffer ends with a blank line so as not to run this - ;; message together with the following one. - (goto-char (point-max)) - (rmail-ensure-blank-line) (let ((old rmail-old-text) (pruned rmail-old-pruned) (mime-state rmail-old-mime-state) @@ -224,10 +220,9 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (setq old nil) (goto-char (point-min)) (search-forward "\n\n") - (setq headers-end (point-marker)) - (goto-char (point-min)) + (setq headers-end (point-marker)) ; first character of body (save-restriction - (narrow-to-region (point) headers-end) + (narrow-to-region (point-min) headers-end) ;; If they changed the message's encoding, rewrite the charset= ;; header for them, so that subsequent rmail-show-message ;; decodes it correctly. @@ -240,6 +235,38 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. 'us-ascii new-coding)))) old-coding mime-beg mime-end content-type) + ;; If there's no content-type in the edited headers, look for one + ;; in the original headers and add it to the edited headers + ;; (Bug #26918) + (unless (mail-fetch-field "Content-Type") + (let (old-content-type + (msgbeg (rmail-msgbeg rmail-current-message)) + (msgend (rmail-msgend rmail-current-message))) + (with-current-buffer rmail-view-buffer ; really the mbox buffer + (save-restriction + (narrow-to-region msgbeg msgend) + (goto-char (point-min)) + (setq limit (search-forward "\n\n")) + (narrow-to-region (point-min) limit) + (goto-char (point-min)) + (when (re-search-forward "^content-type:" limit t) + (forward-line) + (setq old-content-type (buffer-substring + (match-beginning 0) (point)))))) + (when old-content-type + (save-excursion + (goto-char headers-end) ; first char of body + (backward-char) ; add header before second newline + (insert old-content-type) + ;;Add it to rmail-old-headers as though it had been + ;;there originally, to avoid rmail-edit-update-headers + ;;an extra copy + (let ((header (substring old-content-type 0 + (length "content-type")))) + (unless (assoc header rmail-old-headers) + (push (cons header old-content-type) rmail-old-headers))) + )))) + (goto-char (point-min)) (if (re-search-forward rmail-mime-charset-pattern nil 'move) (setq mime-beg (match-beginning 1) mime-end (match-end 1) @@ -281,29 +308,32 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (setq character-coding (downcase character-coding))) (goto-char limit) - (let ((inhibit-read-only t)) - (let ((data-buffer (current-buffer)) - (end (copy-marker (point) t))) - (with-current-buffer rmail-view-buffer - (encode-coding-region headers-end (point-max) coding-system - data-buffer)) - (delete-region end (point-max))) - + (let ((inhibit-read-only t) + (data-buffer (current-buffer)) + (start (copy-marker (point) nil)) ; new body will be between + (end (copy-marker (point) t))) ; these two markers + (with-current-buffer rmail-view-buffer + (encode-coding-region headers-end (point-max) coding-system + data-buffer)) + (delete-region end (point-max)) ;; Apply to the mbox buffer any changes in header fields ;; that the user made while editing in the view buffer. (rmail-edit-update-headers (rmail-edit-diff-headers rmail-old-headers new-headers)) - ;; Re-apply content-transfer-encoding, if any, on the message body. (cond ((string= character-coding "quoted-printable") - (mail-quote-printable-region (point) (point-max))) + (mail-quote-printable-region start (point-max))) ((and (string= character-coding "base64") is-text-message) - (base64-encode-region (point) (point-max))) + (base64-encode-region start (point-max))) ((and (eq character-coding 'uuencode) is-text-message) - (error "uuencoded messages are not supported")))) + (error "uuencoded messages are not supported"))) + ;; After encoding, make sure buffer ends with a blank line so as not to + ;; run this message together with the following one. + (goto-char (point-max)) + (rmail-ensure-blank-line)) (rmail-set-attribute rmail-edited-attr-index t)) - ;;??? BROKEN perhaps. +;;;??? BROKEN perhaps. ;;; (if (boundp 'rmail-summary-vector) ;;; (aset rmail-summary-vector (1- rmail-current-message) nil)) (rmail-show-message) commit 37cde9c6a20a7114ac6fb958c80eedf2c66feb68 Author: Eli Zaretskii Date: Fri Sep 8 12:02:59 2017 +0300 Document last change in dired.el * etc/NEWS (Dired): Document the last change in dired.el. (Bug#27435) diff --git a/etc/NEWS b/etc/NEWS index 2824349a53..7b06e56a21 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -585,6 +585,16 @@ of this option means the file is revisited in a temporary buffer; this temporary buffer is the actual buffer searched: the original buffer visiting the file is not modified. +--- +*** Users can now customize mouse clicks in Dired in a more flexible way. +The new command 'dired-mouse-find-file' can be bound to a mouse click +and used to visit files/directories in Dired in the selected window. +The new command 'dired-mouse-find-file-other-frame' similarly visits +files/directories in another frame. You can write your own commands +that invoke 'dired-mouse-find-file' with non-default optional +arguments, to tailor the effects of mouse clicks on file names in +Dired buffers. + +++ *** In wdired, when editing files to contain slash characters, the resulting directories are automatically created. Whether to do commit 41eb4c518a79050b85add25bf67992e21fa3cd16 Author: Tak Kunihiro Date: Fri Sep 8 11:52:47 2017 +0300 Make mouse clicks in Dired more customizable * lisp/dired.el (dired-mouse-find-file): Allow callers to specify functions to visit file/directory. (dired-mouse-find-file-other-window) (dired-mouse-find-file-other-frame): New functions to visit files in another window/frame. (Bug#27435) diff --git a/lisp/dired.el b/lisp/dired.el index ff62183f09..052f9a5214 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2233,9 +2233,15 @@ directory in another window." ;; Don't override the setting from .emacs. ;;;###autoload (put 'dired-find-alternate-file 'disabled t) -(defun dired-mouse-find-file-other-window (event) - "In Dired, visit the file or directory name you click on." +(defun dired-mouse-find-file (event &optional find-file-func find-dir-func) + "In Dired, visit the file or directory name you click on. +The optional arguments FIND-FILE-FUNC and FIND-DIR-FUNC specify +functions to visit the file and directory, respectively. If +omitted or nil, these arguments default to `find-file' and `dired', +respectively." (interactive "e") + (or find-file-func (setq find-file-func 'find-file)) + (or find-dir-func (setq find-dir-func 'dired)) (let (window pos file) (save-excursion (setq window (posn-window (event-end event)) @@ -2250,9 +2256,19 @@ directory in another window." (dired-goto-subdir file)) (progn (select-window window) - (dired-other-window file))) + (funcall find-dir-func file))) (select-window window) - (find-file-other-window (file-name-sans-versions file t))))) + (funcall find-file-func (file-name-sans-versions file t))))) + +(defun dired-mouse-find-file-other-window (event) + "In Dired, visit the file or directory name you click on in another window." + (interactive "e") + (dired-mouse-find-file event 'find-file-other-window 'dired-other-window)) + +(defun dired-mouse-find-file-other-frame (event) + "In Dired, visit the file or directory name you click on in another frame." + (interactive "e") + (dired-mouse-find-file event 'find-file-other-frame 'dired-other-frame)) (defun dired-view-file () "In Dired, examine a file in view mode, returning to Dired when done. commit be90cd1412c89cae6b2ba41133b888008ee478dc Author: Eli Zaretskii Date: Fri Sep 8 11:00:34 2017 +0300 Avoid compiler warnings on MS-Windows with GCC 6 and 7 * src/w32font.c (SUBRANGE): Use unsigned arithmetic for bit-shifting, to avoid compiler warnings. (w32font_text_extents): Tell GCC NGLYPHS is non-negative, to avoid a warning. For details of the warning, see http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00093.html. * src/term.c (keys) [WINDOWSNT]: Don't define, as it is not used in that build. * src/sound.c (sound_perror): Ifdef away on WINDOWSNT, as this function is not used in that build. * configure.ac: Disable -Wsuggest-attribute=format on MS-Windows. diff --git a/configure.ac b/configure.ac index 250a51725b..8ffc7cfff3 100644 --- a/configure.ac +++ b/configure.ac @@ -976,9 +976,10 @@ AS_IF([test $gl_gcc_warnings = no], nw="$nw -Wmissing-braces" fi - # This causes too much noise in the MinGW build + # These cause too much noise in the MinGW build if test $opsys = mingw32; then nw="$nw -Wpointer-sign" + nw="$nw -Wsuggest-attribute=format" fi gl_MANYWARN_ALL_GCC([ws]) diff --git a/src/sound.c b/src/sound.c index 4714ac1796..75c27a97f4 100644 --- a/src/sound.c +++ b/src/sound.c @@ -293,6 +293,7 @@ static int do_play_sound (const char *, unsigned long); /* BEGIN: Common functions */ +#ifndef WINDOWSNT /* Like perror, but signals an error. */ static _Noreturn void @@ -315,8 +316,6 @@ sound_perror (const char *msg) error ("%s", msg); } - -#ifndef WINDOWSNT /* Display a warning message. */ static void diff --git a/src/term.c b/src/term.c index 87a412666d..c1d7b0483e 100644 --- a/src/term.c +++ b/src/term.c @@ -1210,6 +1210,7 @@ struct fkey_table { const char *cap, *name; }; +#ifndef DOS_NT /* Termcap capability names that correspond directly to X keysyms. Some of these (marked "terminfo") aren't supplied by old-style (Berkeley) termcap entries. They're listed in X keysym order; @@ -1313,7 +1314,6 @@ static const struct fkey_table keys[] = {"!3", "S-undo"} /*shifted undo key*/ }; -#ifndef DOS_NT static char **term_get_fkeys_address; static KBOARD *term_get_fkeys_kboard; static Lisp_Object term_get_fkeys_1 (void); diff --git a/src/w32font.c b/src/w32font.c index 314d7acdcc..9881119202 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -544,6 +544,7 @@ w32font_text_extents (struct font *font, unsigned *code, information. */ /* Make array big enough to hold surrogates. */ + eassume (0 <= nglyphs); /* pacify GCC warning on next line */ wcode = alloca (nglyphs * sizeof (WORD) * 2); for (i = 0; i < nglyphs; i++) { @@ -2188,7 +2189,7 @@ font_supported_scripts (FONTSIGNATURE * sig) /* Match a single subrange. SYM is set if bit N is set in subranges. */ #define SUBRANGE(n,sym) \ - if (subranges[(n) / 32] & (1 << ((n) % 32))) \ + if (subranges[(n) / 32] & (1U << ((n) % 32))) \ supported = Fcons ((sym), supported) /* Match multiple subranges. SYM is set if any MASK bit is set in commit e2a10d7fa8092ef51a3b61a363061e37224e2ca1 Author: Eli Zaretskii Date: Fri Sep 8 10:51:14 2017 +0300 Fix 'directory-file-name' on DOS_NT systems as well * src/fileio.c (directory_file_name) [DOS_NT]: Fix the DOS_NT case to be consistent with last change. * test/src/fileio-tests.el (fileio-tests--odd-symlink-chars): Disable on MS-Windows. (fileio-tests--directory-file-name-dos-nt) (fileio-tests--file-name-as-directory-dos-nt): New tests. diff --git a/src/fileio.c b/src/fileio.c index 9df3b1beda..a1cea94c0b 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -572,7 +572,7 @@ directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte) if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0]))) while (srclen > 1 #ifdef DOS_NT - && !IS_ANY_SEP (src[srclen - 2]) + && !(srclen > 2 && IS_DEVICE_SEP (src[srclen - 2])) #endif && IS_DIRECTORY_SEP (src[srclen - 1])) srclen--; diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index ac5d533e63..7ac70a5896 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -43,6 +43,10 @@ (ert-deftest fileio-tests--odd-symlink-chars () "Check that any non-NULL ASCII character can appear in a symlink. Also check that an encoding error can appear in a symlink." + ;; Some Windows versions don't support symlinks, and those which do + ;; will pop up UAC elevation prompts, so we disable this test on + ;; MS-Windows. + (skip-unless (not (eq system-type 'windows-nt))) (should (equal nil (fileio-tests--symlink-failure)))) (ert-deftest fileio-tests--directory-file-name () @@ -54,6 +58,17 @@ Also check that an encoding error can appear in a symlink." (should (equal (directory-file-name "/abc/") "/abc")) (should (equal (directory-file-name "/abc//") "/abc"))) +(ert-deftest fileio-tests--directory-file-name-dos-nt () + "Like fileio-tests--directory-file-name, but for DOS_NT systems." + (skip-unless (memq system-type '(ms-dos windows-nt))) + (should (equal (directory-file-name "d:/") "d:/")) + (should (equal (directory-file-name "d://") "d:/")) + (should (equal (directory-file-name "d:///") "d:/")) + (should (equal (directory-file-name "d:////") "d:/")) + (should (equal (directory-file-name "d:/abc") "d:/abc")) + (should (equal (directory-file-name "d:/abc/") "d:/abc")) + (should (equal (directory-file-name "d:/abc//") "d:/abc"))) + (ert-deftest fileio-tests--file-name-as-directory () (should (equal (file-name-as-directory "") "./")) (should (equal (file-name-as-directory "/") "/")) @@ -63,3 +78,18 @@ Also check that an encoding error can appear in a symlink." (should (equal (file-name-as-directory "/abc") "/abc/")) (should (equal (file-name-as-directory "/abc/") "/abc/")) (should (equal (file-name-as-directory "/abc//") "/abc//"))) + +(ert-deftest fileio-tests--file-name-as-directory-dos-nt () + "Like fileio-tests--file-name-as-directory, but for DOS_NT systems." + (skip-unless (memq system-type '(ms-dos windows-nt))) + (should (equal (file-name-as-directory "d:/") "d:/")) + (should (equal (file-name-as-directory "d:\\") "d:/")) + (should (equal (file-name-as-directory "d://") "d://")) + (should (equal (file-name-as-directory "d:///") "d:///")) + (should (equal (file-name-as-directory "d:////") "d:////")) + (should (equal (file-name-as-directory "d:\\\\\\\\") "d:////")) + (should (equal (file-name-as-directory "d:/abc") "d:/abc/")) + (should (equal (file-name-as-directory "D:\\abc") "d:/abc/")) + (should (equal (file-name-as-directory "d:/abc/") "d:/abc/")) + (should (equal (file-name-as-directory "D:\\abc/") "d:/abc/")) + (should (equal (file-name-as-directory "D:/abc//") "d:/abc//"))) commit 442fe111436264e1a610fbf5686ccf1314407d4a Author: Wilson Snyder Date: Thu Sep 7 23:24:28 2017 -0400 Fix various verilog-mode.el issues. * lisp/progmodes/verilog-mode.el (verilog-expand-dirnames): Fix expanding "*/*", msg2284. Reported by Jonathan Ferguson. (ignore-errors): Fix ignore-errors error on Emacs 22.3, bug1177. Reported by Victor Lau. (verilog-getopt, verilog-getopt-file) (verilog-library-flags, verilog-substitute-file-name-path): Support -F in verilog getopt files, bug1171. Reported by George Cuan. (verilog-do-indent): Fix misindenting symbols starting with t, bug1169. Reported by Hoai Tran. (verilog-read-auto-template-middle): Fix slow template matching on AUTOINST. Reported by Jeffrey Huynh. (verilog-pretty-expr): The extra whitespace addition before "=" operators is now done only if the whole assignment block contains the 2-character "<=" operator. Remove the unused argument _myre. Use `unless', `save-excursion' and `when' functions where possible. Internal variables refactored for clarity. Follow elisp convention for closing parentheses. By Kaushal Modi. (verilog-get-lineup-indent-2): Update docstring. Internal variables refactored for clarity. Earlier EDPOS argument was expected to be a marker; it is now renamed to END and is now expected to be a position. Use `when' instead of `if'. By Kaushal Modi. (electric-verilog-terminate-line): Remove the unused second argument from `verilog-pretty-expr' call. By Kaushal Modi. (verilog-calc-1): Fix indentation of a virtual class definition after a typedef class, bug1080. By Kaushal Modi. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 2760c4d276..6e79b1a63d 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -4,7 +4,6 @@ ;; Author: Michael McNamara ;; Wilson Snyder -;; X-URL: http://www.verilog.com ;; X-URL: http://www.veripool.org ;; Created: 3 Jan 1996 ;; Keywords: languages @@ -70,7 +69,7 @@ ;; default. ;; You can get step by step help in installing this file by going to -;; +;; ;; The short list of installation instructions are: To set up ;; automatic Verilog mode, put this file in your load path, and put @@ -123,7 +122,7 @@ ;; ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "2017-05-08-b240c8f-vpo-GNU" +(defconst verilog-mode-version "2017-08-07-c085e50-vpo-GNU" "Version of this Verilog mode.") (defconst verilog-mode-release-emacs t "If non-nil, this version of Verilog mode was released with Emacs itself.") @@ -345,6 +344,12 @@ wherever possible, since it is slow." (unless (fboundp 'buffer-chars-modified-tick) ; Emacs 22 added (defmacro buffer-chars-modified-tick () (buffer-modified-tick))) (error nil)) + ;; Added in Emacs 23.1 + (condition-case nil + (unless (fboundp 'ignore-errors) + (defmacro ignore-errors (&rest body) + (declare (debug t) (indent 0)) + `(condition-case nil (progn ,@body) (error nil))))) ;; Added in Emacs 24.1 (condition-case nil (unless (fboundp 'prog-mode) @@ -961,7 +966,8 @@ Only used in XEmacs; GNU Emacs uses `verilog-error-regexp-emacs-alist'.") These arguments are used to find files for `verilog-auto', and match the flags accepted by a standard Verilog-XL simulator. - -f filename Reads more `verilog-library-flags' from the filename. + -f filename Reads absolute `verilog-library-flags' from the filename. + -F filename Reads relative `verilog-library-flags' from the filename. +incdir+dir Adds the directory to `verilog-library-directories'. -Idir Adds the directory to `verilog-library-directories'. -y dir Adds the directory to `verilog-library-directories'. @@ -4034,7 +4040,7 @@ With optional ARG, remove existing end of line comments." (progn (if (or (eq 'all verilog-auto-lineup) (eq 'assignments verilog-auto-lineup)) - (verilog-pretty-expr t "\\(<\\|:\\)?=" )) + (verilog-pretty-expr :quiet)) (newline)) (forward-line 1)) ;; Indent next line @@ -5790,11 +5796,9 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (goto-char here) ; or is clocking, starts a new block (throw 'nesting 'block))))) - ;; need to consider typedef struct here... ((looking-at "\\") ;; *sigh* These words have an optional prefix: ;; extern {virtual|protected}? function a(); - ;; typedef class foo; ;; and we don't want to confuse this with ;; function a(); ;; property @@ -5804,7 +5808,11 @@ Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)." (cond ((looking-at verilog-dpi-import-export-re) (throw 'continue 'foo)) - ((looking-at "\\\\s-+\\\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+") + ((or + (looking-at "\\\\s-+\\\\s-+\\(?:\\<\\(local\\|protected\\|static\\)\\>\\s-+\\)?\\<\\(function\\|task\\)\\>\\s-+") + ;; Do not throw 'defun for class typedefs like + ;; typedef class foo; + (looking-at "\\\\s-+\\(?:\\\\s-+\\)?\\\\s-+")) (throw 'nesting 'statement)) ((looking-at verilog-beg-block-re-ordered) (throw 'nesting 'block)) @@ -6660,7 +6668,7 @@ Only look at a few lines to determine indent level." (let ((val)) (verilog-beg-of-statement-1) (if (and (< (point) here) - (verilog-re-search-forward "=[ \\t]*" here 'move) + (verilog-re-search-forward "=[ \t]*" here 'move) ;; not at a |=>, #=#, or [=n] operator (not (string-match "\\[=.\\|#=#\\||=>" (or (buffer-substring (- (point) 2) (1+ (point))) @@ -6974,106 +6982,97 @@ Be verbose about progress unless optional QUIET set." (forward-line 1)) (unless quiet (message ""))))))) -(defun verilog-pretty-expr (&optional quiet _myre) - "Line up expressions around point, optionally QUIET with regexp _MYRE ignored." +(defun verilog-pretty-expr (&optional quiet) + "Line up expressions around point. +If QUIET is non-nil, do not print messages showing the progress of line-up." (interactive) - (if (not (verilog-in-comment-or-string-p)) - (save-excursion - (let ( (rexp (concat "^\\s-*" verilog-complete-reg)) - (rexp1 (concat "^\\s-*" verilog-basic-complete-re))) - (beginning-of-line) - (if (and (not (looking-at rexp )) + (unless (verilog-in-comment-or-string-p) + (save-excursion + (let ((regexp (concat "^\\s-*" verilog-complete-reg)) + (regexp1 (concat "^\\s-*" verilog-basic-complete-re))) + (beginning-of-line) + (when (and (not (looking-at regexp)) (looking-at verilog-assignment-operation-re) (save-excursion (goto-char (match-end 2)) (and (not (verilog-in-attribute-p)) (not (verilog-in-parameter-p)) (not (verilog-in-comment-or-string-p))))) - (let* ((here (point)) - (e) (r) - (start - (progn - (beginning-of-line) - (setq e (point)) - (verilog-backward-syntactic-ws) - (beginning-of-line) - (while (and (not (looking-at rexp1)) - (looking-at verilog-assignment-operation-re) - (not (bobp)) - ) - (setq e (point)) - (verilog-backward-syntactic-ws) + (let* ((start (save-excursion ; BOL of the first line of the assignment block (beginning-of-line) - ) ;Ack, need to grok `define - e)) - (end - (progn - (goto-char here) + (let ((pt (point))) + (verilog-backward-syntactic-ws) + (beginning-of-line) + (while (and (not (looking-at regexp1)) + (looking-at verilog-assignment-operation-re) + (not (bobp))) + (setq pt (point)) + (verilog-backward-syntactic-ws) + (beginning-of-line)) ; Ack, need to grok `define + pt))) + (end (save-excursion ; EOL of the last line of the assignment block (end-of-line) - (setq e (point)) ;Might be on last line - (verilog-forward-syntactic-ws) - (beginning-of-line) - (while (and - (not (looking-at rexp1 )) - (looking-at verilog-assignment-operation-re) - (progn - (end-of-line) - (not (eq e (point))))) - (setq e (point)) + (let ((pt (point))) ; Might be on last line (verilog-forward-syntactic-ws) (beginning-of-line) - ) - e)) - (endpos (set-marker (make-marker) end)) - (ind) - ) - (goto-char start) - (verilog-do-indent (verilog-calculate-indent)) - (if (and (not quiet) - (> (- end start) 100)) - (message "Lining up expressions..(please stand by)")) - - ;; Set indent to minimum throughout region - (while (< (point) (marker-position endpos)) - (beginning-of-line) - (verilog-just-one-space verilog-assignment-operation-re) - (beginning-of-line) - (verilog-do-indent (verilog-calculate-indent)) - (end-of-line) - (verilog-forward-syntactic-ws) - ) - - ;; Now find biggest prefix - (setq ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start endpos)) - - ;; Now indent each line. - (goto-char start) - (while (progn (setq e (marker-position endpos)) - (setq r (- e (point))) - (> r 0)) - (setq e (point)) - (if (not quiet) (message "%d" r)) - (cond - ((looking-at verilog-assignment-operation-re) - (goto-char (match-beginning 2)) - (if (not (or (verilog-in-parenthesis-p) ; leave attributes and comparisons alone - (verilog-in-coverage-p))) - (if (eq (char-after) ?=) - (indent-to (1+ ind)) ; line up the = of the <= with surrounding = - (indent-to ind) - )) - ) - ((verilog-continued-line-1 start) - (goto-char e) - (indent-line-to ind)) - (t ; Must be comment or white space - (goto-char e) - (verilog-forward-ws&directives) - (forward-line -1)) - ) - (forward-line 1)) - (unless quiet (message "")) - )))))) + (while (and + (not (looking-at regexp1)) + (looking-at verilog-assignment-operation-re) + (progn + (end-of-line) + (not (eq pt (point))))) + (setq pt (point)) + (verilog-forward-syntactic-ws) + (beginning-of-line)) + pt))) + (contains-2-char-operator (string-match "<=" (buffer-substring-no-properties start end))) + (endmark (set-marker (make-marker) end))) + (goto-char start) + (verilog-do-indent (verilog-calculate-indent)) + (when (and (not quiet) + (> (- end start) 100)) + (message "Lining up expressions.. (please stand by)")) + + ;; Set indent to minimum throughout region + ;; Rely on mark rather than on point as the indentation changes can + ;; make the older point reference obsolete + (while (< (point) (marker-position endmark)) + (beginning-of-line) + (save-excursion + (verilog-just-one-space verilog-assignment-operation-re)) + (verilog-do-indent (verilog-calculate-indent)) + (end-of-line) + (verilog-forward-syntactic-ws)) + + (let ((ind (verilog-get-lineup-indent-2 verilog-assignment-operation-re start (marker-position endmark))) ; Find the biggest prefix + e) + ;; Now indent each line. + (goto-char start) + (while (progn + (setq e (marker-position endmark)) + (> e (point))) + (unless quiet + (message " verilog-pretty-expr: %d" (- e (point)))) + (setq e (point)) + (cond + ((looking-at verilog-assignment-operation-re) + (goto-char (match-beginning 2)) + (unless (or (verilog-in-parenthesis-p) ; Leave attributes and comparisons alone + (verilog-in-coverage-p)) + (if (and contains-2-char-operator + (eq (char-after) ?=)) + (indent-to (1+ ind)) ; Line up the = of the <= with surrounding = + (indent-to ind)))) + ((verilog-continued-line-1 start) + (goto-char e) + (indent-line-to ind)) + (t ; Must be comment or white space + (goto-char e) + (verilog-forward-ws&directives) + (forward-line -1))) + (forward-line 1)) + (unless quiet + (message ""))))))))) (defun verilog-just-one-space (myre) "Remove extra spaces around regular expression MYRE." @@ -7180,30 +7179,30 @@ Region is defined by B and EDPOS." ;;(skip-chars-backward " \t") (1+ (current-column)))))) -(defun verilog-get-lineup-indent-2 (myre b edpos) - "Return the indent level that will line up several lines within the region." +(defun verilog-get-lineup-indent-2 (regexp beg end) + "Return the indent level that will line up several lines. +The lineup string is searched using REGEXP within the region between points +BEG and END." (save-excursion - (let ((ind 0) e) - (goto-char b) + (let ((ind 0)) + (goto-char beg) ;; Get rightmost position - (while (progn (setq e (marker-position edpos)) - (< (point) e)) - (if (and (verilog-re-search-forward myre e 'move) - (not (verilog-in-attribute-p))) ; skip attribute exprs - (progn - (goto-char (match-beginning 2)) - (verilog-backward-syntactic-ws) - (if (> (current-column) ind) - (setq ind (current-column))) - (goto-char (match-end 0))) - )) - (if (> ind 0) - (1+ ind) - ;; No lineup-string found - (goto-char b) - (end-of-line) - (skip-chars-backward " \t") - (1+ (current-column)))))) + (while (< (point) end) + (when (and (verilog-re-search-forward regexp end 'move) + (not (verilog-in-attribute-p))) ; skip attribute exprs + (goto-char (match-beginning 2)) + (verilog-backward-syntactic-ws) + (if (> (current-column) ind) + (setq ind (current-column))) + (goto-char (match-end 0)))) + (setq ind (if (> ind 0) + (1+ ind) + ;; No lineup-string found + (goto-char beg) + (end-of-line) + (skip-chars-backward " \t") + (1+ (current-column)))) + ind))) (defun verilog-comment-depth (type val) "A useful mode debugging aide. TYPE and VAL are comments for insertion." @@ -9344,7 +9343,7 @@ Returns REGEXP and list of ( (signal_name connection_name)... )." ;; Regexp form?? ((looking-at ;; Regexp bug in XEmacs disallows ][ inside [], and wants + last - "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]+\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)") + "\\s-*\\.\\(\\([a-zA-Z0-9`_$+@^.*?|---]\\|[][]\\|\\\\[()|]\\)+\\)\\s-*(\\(.*\\))\\s-*\\(,\\|)\\s-*;\\)") (setq rep (match-string-no-properties 3)) (goto-char (match-end 0)) (setq tpl-wild-list @@ -9619,8 +9618,9 @@ Some macros and such are also found and included. For dinotrace.el." ;; Argument file parsing ;; -(defun verilog-getopt (arglist) - "Parse -f, -v etc arguments in ARGLIST list or string." +(defun verilog-getopt (arglist &optional default-dir) + "Parse -f, -v etc arguments in ARGLIST list or string. +Use DEFAULT-DIR to anchor paths if non-nil." (unless (listp arglist) (setq arglist (list arglist))) (let ((space-args '()) arg next-param) @@ -9638,6 +9638,8 @@ Some macros and such are also found and included. For dinotrace.el." space-args (cdr space-args)) (cond ;; Need another arg + ((equal arg "-F") + (setq next-param arg)) ((equal arg "-f") (setq next-param arg)) ((equal arg "-v") @@ -9661,32 +9663,37 @@ Some macros and such are also found and included. For dinotrace.el." ((or (string-match "^\\+incdir\\+\\(.*\\)" arg) ; +incdir+dir (string-match "^-I\\(.*\\)" arg)) ; -Idir (verilog-add-list-unique `verilog-library-directories - (match-string 1 (substitute-in-file-name arg)))) + (substitute-in-file-name (match-string 1 arg)))) ;; Ignore ((equal "+librescan" arg)) ((string-match "^-U\\(.*\\)" arg)) ; -Udefine ;; Second parameters + ((equal next-param "-F") + (setq next-param nil) + (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) + (file-name-directory (verilog-substitute-file-name-path arg default-dir)))) ((equal next-param "-f") (setq next-param nil) - (verilog-getopt-file (substitute-in-file-name arg))) + (verilog-getopt-file (verilog-substitute-file-name-path arg default-dir) nil)) ((equal next-param "-v") (setq next-param nil) (verilog-add-list-unique `verilog-library-files - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ((equal next-param "-y") (setq next-param nil) (verilog-add-list-unique `verilog-library-directories - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ;; Filename ((string-match "^[^-+]" arg) (verilog-add-list-unique `verilog-library-files - (substitute-in-file-name arg))) + (verilog-substitute-file-name-path arg default-dir))) ;; Default - ignore; no warning )))) ;;(verilog-getopt (list "+libext+.a+.b" "+incdir+foodir" "+define+a+aval" "-f" "otherf" "-v" "library" "-y" "dir")) -(defun verilog-getopt-file (filename) - "Read Verilog options from the specified FILENAME." +(defun verilog-getopt-file (filename &optional default-dir) + "Read Verilog options from the specified FILENAME. +Use DEFAULT-DIR to anchor paths if non-nil." (save-excursion (let ((fns (verilog-library-filenames filename (buffer-file-name))) (orig-buffer (current-buffer)) @@ -9702,7 +9709,7 @@ Some macros and such are also found and included. For dinotrace.el." (when (string-match "//" line) (setq line (substring line 0 (match-beginning 0)))) (with-current-buffer orig-buffer ; Variables are buffer-local, so need right context. - (verilog-getopt line)))))) + (verilog-getopt line default-dir)))))) (defun verilog-getopt-flags () "Convert `verilog-library-flags' into standard library variables." @@ -9719,6 +9726,13 @@ Some macros and such are also found and included. For dinotrace.el." ;; Allow user to customize (verilog-run-hooks 'verilog-getopt-flags-hook)) +(defun verilog-substitute-file-name-path (filename default-dir) + "Return FILENAME with environment variables substituted. +Use DEFAULT-DIR to anchor paths if non-nil." + (if default-dir + (expand-file-name (substitute-in-file-name filename) default-dir) + (substitute-in-file-name filename))) + (defun verilog-add-list-unique (varref object) "Append to VARREF list the given OBJECT, unless it is already a member of the variable's list." @@ -9898,42 +9912,44 @@ Or, just the existing dirnames themselves if there are no wildcards." (interactive) (unless dirnames (error "`verilog-library-directories' should include at least `.'")) - (setq dirnames (reverse dirnames)) ; not nreverse - (let ((dirlist nil) - pattern dirfile dirfiles dirname root filename rest basefile) - (while dirnames - (setq dirname (substitute-in-file-name (car dirnames)) - dirnames (cdr dirnames)) - (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root - "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? - "\\(.*\\)") ; rest - dirname) - (setq root (match-string 1 dirname) - filename (match-string 2 dirname) - rest (match-string 3 dirname) - pattern filename) - ;; now replace those * and ? with .+ and . - ;; use ^ and /> to get only whole file names - (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern) - pattern (verilog-string-replace-matches "[?]" "." nil nil pattern) - pattern (concat "^" pattern "$") - dirfiles (verilog-dir-files root)) - (while dirfiles - (setq basefile (car dirfiles) - dirfile (expand-file-name (concat root basefile rest)) - dirfiles (cdr dirfiles)) - (if (and (string-match pattern basefile) - ;; Don't allow abc/*/rtl to match abc/rtl via .. - (not (equal basefile ".")) - (not (equal basefile "..")) - (file-directory-p dirfile)) - (setq dirlist (cons dirfile dirlist))))) - ;; Defaults - (t - (if (file-directory-p dirname) - (setq dirlist (cons dirname dirlist)))))) - dirlist)) -;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v")) + (save-match-data + (setq dirnames (reverse dirnames)) ; not nreverse + (let ((dirlist nil) + pattern dirfile dirfiles dirname root filename rest basefile) + (setq dirnames (mapcar 'substitute-in-file-name dirnames)) + (while dirnames + (setq dirname (car dirnames) + dirnames (cdr dirnames)) + (cond ((string-match (concat "^\\(\\|[/\\]*[^*?]*[/\\]\\)" ; root + "\\([^/\\]*[*?][^/\\]*\\)" ; filename with *? + "\\(.*\\)") ; rest + dirname) + (setq root (match-string 1 dirname) + filename (match-string 2 dirname) + rest (match-string 3 dirname) + pattern filename) + ;; now replace those * and ? with .+ and . + ;; use ^ and /> to get only whole file names + (setq pattern (verilog-string-replace-matches "[*]" ".+" nil nil pattern) + pattern (verilog-string-replace-matches "[?]" "." nil nil pattern) + pattern (concat "^" pattern "$") + dirfiles (verilog-dir-files root)) + (while dirfiles + (setq basefile (car dirfiles) + dirfile (expand-file-name (concat root basefile rest)) + dirfiles (cdr dirfiles)) + (when (and (string-match pattern basefile) + ;; Don't allow abc/*/rtl to match abc/rtl via .. + (not (equal basefile ".")) + (not (equal basefile ".."))) + ;; Might have more wildcards, so process again + (setq dirnames (cons dirfile dirnames))))) + ;; Defaults + (t + (if (file-directory-p dirname) + (setq dirlist (cons dirname dirlist)))))) + dirlist))) +;;(verilog-expand-dirnames (list "." ".." "nonexist" "../*" "/home/wsnyder/*/v" "../*/*")) (defun verilog-library-filenames (filename &optional current check-ext) "Return a search path to find the given FILENAME or module name. @@ -12074,7 +12090,7 @@ This is currently equivalent to: with the below at the bottom of the file // Local Variables: - // verilog-auto-logic-type:\"logic\" + // verilog-auto-wire-type:\"logic\" // End: In the future AUTOLOGIC may declare additional identifiers, @@ -13223,10 +13239,12 @@ Typing \\[verilog-auto] will make this into: Replace the /*AUTOTIEOFF*/ comment with code to wire-tie all unused output signals to deasserted. -/*AUTOTIEOFF*/ is used to make stub modules; modules that have the same -input/output list as another module, but no internals. Specifically, it -finds all outputs in the module, and if that input is not otherwise declared -as a register or wire, creates a tieoff. +/*AUTOTIEOFF*/ is used to make stub modules; modules that have +the same input/output list as another module, but no internals. +Specifically, it finds all outputs in the module, and if that +input is not otherwise declared as a register or wire, nor comes +from a AUTOINST submodule's output, creates a tieoff. AUTOTIEOFF +does not examine assignments to determine what is already driven. AUTORESET ties signals to deasserted, which is presumed to be zero. Signals that match `verilog-active-low-regexp' will be deasserted by tying @@ -14420,7 +14438,7 @@ Files are checked based on `verilog-library-flags'." (with-output-to-temp-buffer "*verilog-mode help*" (princ (format "You are using verilog-mode %s\n" verilog-mode-version)) (princ "\n") - (princ "For new releases, see http://www.verilog.com\n") + (princ "For new releases, see http://www.veripool.com/verilog-mode\n") (princ "\n") (princ "For frequently asked questions, see http://www.veripool.org/verilog-mode-faq.html\n") (princ "\n") commit 9546e1eba584a0c86002ba87c65dd88eff5290ab Author: Katsumi Yamaoka Date: Fri Sep 8 02:16:19 2017 +0000 Don't use summary window to visit group buffer (bugfix) * lisp/gnus/gnus-sum.el (gnus-summary-jump-to-group): Make sure that the window to open the group buffer doesn't visit the summary buffer. This fixes a bug: `gnus-summary-next-article' sometimes causes an error by trying to select nonexistent summary window. diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index f2e51fb225..0259692967 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -6931,7 +6931,7 @@ displayed, no centering will be performed." (save-excursion ;; Take care of tree window mode. (if (get-buffer-window gnus-group-buffer 0) - (pop-to-buffer gnus-group-buffer) + (pop-to-buffer gnus-group-buffer t) (set-buffer gnus-group-buffer)) (gnus-group-jump-to-group newsgroup)))) commit aedc566a94116191d3a8b3f7f9955058316f9fdc Author: Paul Eggert Date: Thu Sep 7 17:46:12 2017 -0700 Fix bug: (directory-file-name "///") returned "//" * src/fileio.c (directory_file_name): For "///" and longer, return "/", not "//", as per POSIX. * test/src/fileio-tests.el (fileio-tests--directory-file-name) (fileio-tests--file-name-as-directory): New tests. diff --git a/src/fileio.c b/src/fileio.c index 0a52982291..9df3b1beda 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -566,15 +566,16 @@ is already present. */) static ptrdiff_t directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte) { - /* Process as Unix format: just remove any final slash. - But leave "/" and "//" unchanged. */ - while (srclen > 1 + /* In Unix-like systems, just remove any final slashes. However, if + they are all slashes, leave "/" and "//" alone, and treat "///" + and longer as if they were "/". */ + if (! (srclen == 2 && IS_DIRECTORY_SEP (src[0]))) + while (srclen > 1 #ifdef DOS_NT - && !IS_ANY_SEP (src[srclen - 2]) + && !IS_ANY_SEP (src[srclen - 2]) #endif - && IS_DIRECTORY_SEP (src[srclen - 1]) - && ! (srclen == 2 && IS_DIRECTORY_SEP (src[0]))) - srclen--; + && IS_DIRECTORY_SEP (src[srclen - 1])) + srclen--; memcpy (dst, src, srclen); dst[srclen] = 0; diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 5103d2f21e..ac5d533e63 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -44,3 +44,22 @@ "Check that any non-NULL ASCII character can appear in a symlink. Also check that an encoding error can appear in a symlink." (should (equal nil (fileio-tests--symlink-failure)))) + +(ert-deftest fileio-tests--directory-file-name () + (should (equal (directory-file-name "/") "/")) + (should (equal (directory-file-name "//") "//")) + (should (equal (directory-file-name "///") "/")) + (should (equal (directory-file-name "////") "/")) + (should (equal (directory-file-name "/abc") "/abc")) + (should (equal (directory-file-name "/abc/") "/abc")) + (should (equal (directory-file-name "/abc//") "/abc"))) + +(ert-deftest fileio-tests--file-name-as-directory () + (should (equal (file-name-as-directory "") "./")) + (should (equal (file-name-as-directory "/") "/")) + (should (equal (file-name-as-directory "//") "//")) + (should (equal (file-name-as-directory "///") "///")) + (should (equal (file-name-as-directory "////") "////")) + (should (equal (file-name-as-directory "/abc") "/abc/")) + (should (equal (file-name-as-directory "/abc/") "/abc/")) + (should (equal (file-name-as-directory "/abc//") "/abc//"))) commit 53830c6336b52d58c315c7e11405181e01ee9a53 Author: Paul Eggert Date: Thu Sep 7 16:34:20 2017 -0700 Remove obsolete vc-mistrust-permissions doc * doc/emacs/vc1-xtra.texi (RCS and SCCS): Remove documentation for vc-mistrust-permissions, which no longer exists. diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 8e5c5d5b61..58e4de027c 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -347,22 +347,9 @@ status by setting @code{vc-consult-headers} to @code{nil}. VC then always uses the file permissions (if it is supposed to trust them), or else checks the master file. -@vindex vc-mistrust-permissions - You can specify the criterion for whether to trust the file -permissions by setting the variable @code{vc-mistrust-permissions}. -Its value can be @code{t} (always mistrust the file permissions and -check the master file), @code{nil} (always trust the file -permissions), or a function of one argument which makes the decision. -The argument is the directory name of the @file{RCS} subdirectory. A -non-@code{nil} value from the function says to mistrust the file -permissions. If you find that the file permissions of work files are -changed erroneously, set @code{vc-mistrust-permissions} to @code{t}. -Then VC always checks the master file to determine the file's status. - VC determines the version control state of files under SCCS much as with RCS@. It does not consider SCCS version headers, though. Thus, -the variable @code{vc-mistrust-permissions} affects SCCS use, but -@code{vc-consult-headers} does not. +the variable @code{vc-consult-headers} does not affect SCCS use. @node CVS Options @subsubsection Options specific for CVS commit d31cd79b40dbd5459b16505a4ee4340210499277 Author: Alan Third Date: Sat Sep 2 18:32:08 2017 +0100 Set frame size to actual requested size (bug#18215) * src/nsterm.m (x_set_window_size): Don't use FRAME_TEXT_TO_PIXEL_WIDTH or FRAME_TEXT_TO_PIXEL_HEIGHT. diff --git a/src/nsterm.m b/src/nsterm.m index ff3329d1ce..be97e94dd5 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1820,8 +1820,8 @@ -(void)remove if (pixelwise) { - pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width); - pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height); + pixelwidth = width; + pixelheight = height; } else { commit 93bab0fe55df0f94144f5a12132639e831961848 Author: Paul Eggert Date: Thu Sep 7 00:10:05 2017 -0700 autogen.sh: omit bogus chatter if no .git Problem reported by Angelo Graziosi in: http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00045.html * autogen.sh (git_config): Do not execut 'git' if $do_git fails. diff --git a/autogen.sh b/autogen.sh index 0d00d56762..b3c5f486e9 100755 --- a/autogen.sh +++ b/autogen.sh @@ -269,23 +269,23 @@ fi git_config () { + $do_git || return + name=$1 value=$2 ovalue=`git config --get "$name"` && test "$ovalue" = "$value" || { - if $do_git; then - if $git_was_ok; then - echo 'Configuring local git repository...' - case $cp_options in - --backup=*) - config=$git_common_dir/config - cp $cp_options --force -- "$config" "$config" || exit;; - esac - fi - echo "git config $name '$value'" - git config "$name" "$value" || exit - fi - git_was_ok=false + if $git_was_ok; then + echo 'Configuring local git repository...' + case $cp_options in + --backup=*) + config=$git_common_dir/config + cp $cp_options --force -- "$config" "$config" || exit;; + esac + fi + echo "git config $name '$value'" + git config "$name" "$value" || exit + git_was_ok=false } } commit a0e3f715fc4882518fa737318c4d07ef7870bd90 Author: Glenn Morris Date: Wed Sep 6 20:06:57 2017 -0400 Skip emacsclient tests if --enable-profiling was used * test/lib-src/emacsclient-tests.el (emacsclient-test-call-emacsclient): Make it a macro. Handle "Profiling timer expired" return from emacsclient. (Bug#28319) (emacsclient-test-alternate-editor-allows-arguments) (emacsclient-test-alternate-editor-allows-quotes): Update for above. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 3a2396f781..4b7fa47989 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -31,26 +31,29 @@ "emacsclient") "The emacsclient binary to test.") -(defun emacsclient-test-call-emacsclient () - "Run emacsclient." - (call-process emacsclient-test-emacs nil nil nil - "--server-file" (expand-file-name "non-existent-file" invocation-directory) - "foo")) +(defmacro emacsclient-test-call-emacsclient (editor) + "Run emacsclient with ALTERNATE_EDITOR set to EDITOR." + `(let* ((process-environment + (cons (concat "ALTERNATE_EDITOR=" ,editor) process-environment)) + (stat (call-process emacsclient-test-emacs nil nil nil + "--server-file" + (expand-file-name "non-existent-file" + invocation-directory) + "foo"))) + ;; Skip if emacsclient was compiled with -pg (bug#28319). + ;; Use ert--skip-unless rather than skip-unless to silence compiler. + (ert--skip-unless (not (and (stringp stat) + (string-match-p "rofiling" stat)))) + (should (eq 0 stat)))) (ert-deftest emacsclient-test-alternate-editor-allows-arguments () - (let ((process-environment process-environment)) - (setenv "ALTERNATE_EDITOR" (concat - (expand-file-name invocation-name invocation-directory) - " --batch")) - (should (eq 0 (emacsclient-test-call-emacsclient))))) + (emacsclient-test-call-emacsclient + (concat (expand-file-name invocation-name invocation-directory) " --batch"))) (ert-deftest emacsclient-test-alternate-editor-allows-quotes () - (let ((process-environment process-environment)) - (setenv "ALTERNATE_EDITOR" (concat - "\"" - (expand-file-name invocation-name invocation-directory) - "\"" " --batch")) - (should (eq 0 (emacsclient-test-call-emacsclient))))) + (emacsclient-test-call-emacsclient + (concat "\"" (expand-file-name invocation-name invocation-directory) + "\"" " --batch"))) (provide 'emacsclient-tests) ;;; emacsclient-tests.el ends here commit 1436ce83d39112c44c434e95d6bd2e2320b5c73d Author: Eli Zaretskii Date: Wed Sep 6 21:00:29 2017 +0300 Fix a minor markup problem in ELisp manual * doc/lispref/functions.texi (Mapping Functions): Fix the order of @example and @group. For the details, see http://lists.gnu.org/archive/html/bug-texinfo/2017-09/msg00007.html. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 0d407ab966..116c2990ba 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -994,16 +994,16 @@ the results (which must be lists), by altering the results (using @code{nconc}; @pxref{Rearrangement}). Like with @code{mapcar}, @var{sequence} can be of any type except a char-table. -@group @example +@group ;; @r{Contrast this:} (mapcar 'list '(a b c d)) @result{} ((a) (b) (c) (d)) ;; @r{with this:} (mapcan 'list '(a b c d)) @result{} (a b c d) -@end example @end group +@end example @end defun @defun mapc function sequence commit 9604f9cd33bcbc921fd18e894fdd8a98012fd09d Author: Mark Oteiza Date: Wed Sep 6 13:17:05 2017 -0400 Add XDG desktop file parsing and tests * lisp/xdg.el: Add support for Desktop Entry Specification. (xdg--user-dirs-parse-line): Check if file is readable. (xdg-desktop-group-regexp, xdg-desktop-entry-regexp): New variables. (xdg--desktop-parse-line, xdg-desktop-read-file, xdg-desktop-strings): New functions. * test/lisp/xdg-tests.el: * test/data/xdg/test.desktop: * test/data/xdg/wrong.desktop: New files. diff --git a/lisp/xdg.el b/lisp/xdg.el index 916de00d5e..4b255429db 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -29,9 +29,13 @@ ;; - XDG Base Directory Specification ;; - Thumbnail Managing Standard ;; - xdg-user-dirs configuration +;; - Desktop Entry Specification ;;; Code: +(eval-when-compile + (require 'subr-x)) + ;; XDG Base Directory Specification ;; https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html @@ -128,13 +132,14 @@ This should be called at the beginning of a line." (defun xdg--user-dirs-parse-file (filename) "Return alist of xdg-user-dirs from FILENAME." (let (elt res) - (with-temp-buffer - (insert-file-contents filename) - (goto-char (point-min)) - (while (not (eobp)) - (setq elt (xdg--user-dirs-parse-line)) - (when (consp elt) (push elt res)) - (forward-line))) + (when (file-readable-p filename) + (with-temp-buffer + (insert-file-contents filename) + (goto-char (point-min)) + (while (not (eobp)) + (setq elt (xdg--user-dirs-parse-line)) + (when (consp elt) (push elt res)) + (forward-line)))) res)) (defun xdg-user-dir (name) @@ -147,6 +152,60 @@ This should be called at the beginning of a line." (let ((dir (cdr (assoc name xdg-user-dirs)))) (when dir (expand-file-name dir)))) + +;; Desktop Entry Specification +;; https://specifications.freedesktop.org/desktop-entry-spec/desktop-entry-spec-1.1.html + +(defconst xdg-desktop-group-regexp + (rx "[" (group-n 1 (+? (in " -Z\\^-~"))) "]") + "Regexp matching desktop file group header names.") + +;; TODO Localized strings left out intentionally, as Emacs has no +;; notion of l10n/i18n +(defconst xdg-desktop-entry-regexp + (rx (group-n 1 (+ (in "A-Za-z0-9-"))) + (* blank) "=" (* blank) + (group-n 2 (* nonl))) + "Regexp matching desktop file entry key-value pairs.") + +(defun xdg--desktop-parse-line () + (skip-chars-forward "[:blank:]") + (when (/= (following-char) ?#) + (cond + ((looking-at xdg-desktop-entry-regexp) + (cons (match-string 1) (match-string 2))) + ((looking-at xdg-desktop-group-regexp) + (match-string 1))))) + +(defun xdg-desktop-read-file (filename) + "Return \"Desktop Entry\" contents of desktop file FILENAME as a hash table." + (let ((res (make-hash-table :test #'equal)) + elt group) + (with-temp-buffer + (save-match-data + (insert-file-contents-literally filename) + (goto-char (point-min)) + (while (or (= (following-char) ?#) + (string-blank-p (buffer-substring (point) (point-at-eol)))) + (forward-line)) + (unless (equal (setq group (xdg--desktop-parse-line)) "Desktop Entry") + (error "Wrong first section: %s" group)) + (while (not (eobp)) + (when (consp (setq elt (xdg--desktop-parse-line))) + (puthash (car elt) (cdr elt) res)) + (forward-line)))) + res)) + +(defun xdg-desktop-strings (value) + "Partition VALUE into elements delimited by unescaped semicolons." + (let (res) + (save-match-data + (setq value (string-trim-left value)) + (dolist (x (split-string (replace-regexp-in-string "\\\\;" "\0" value) ";")) + (push (replace-regexp-in-string "\0" ";" x) res))) + (when (null (string-match-p "[^[:blank:]]" (car res))) (pop res)) + (nreverse res))) + (provide 'xdg) ;;; xdg.el ends here diff --git a/test/data/xdg/test.desktop b/test/data/xdg/test.desktop new file mode 100644 index 0000000000..b6dda62774 --- /dev/null +++ b/test/data/xdg/test.desktop @@ -0,0 +1,3 @@ +# this is a comment +[Desktop Entry] +Name=Test diff --git a/test/data/xdg/wrong.desktop b/test/data/xdg/wrong.desktop new file mode 100644 index 0000000000..e0b4c221cf --- /dev/null +++ b/test/data/xdg/wrong.desktop @@ -0,0 +1,2 @@ +# the first section must be "Desktop Entry" +[Why] diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el new file mode 100644 index 0000000000..e7e122b54e --- /dev/null +++ b/test/lisp/xdg-tests.el @@ -0,0 +1,71 @@ +;;; xdg-tests.el --- tests for xdg.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; Author: Mark Oteiza + +;; 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: + +;;; Code: + +(require 'ert) +(require 'xdg) + +(defconst xdg-tests-data-dir + (expand-file-name "test/data/xdg" source-directory)) + +(ert-deftest xdg-match-data () + "Ensure public functions do not mangle match data." + (let ((data '(1 9))) + (save-match-data + (set-match-data data) + (xdg-user-dir "DOCUMENTS") + (should (equal (match-data) data)))) + (let ((data '(2 9))) + (save-match-data + (set-match-data data) + (xdg-desktop-read-file (expand-file-name "test.desktop" xdg-tests-data-dir)) + (should (equal (match-data) data)))) + (let ((data '(3 9))) + (save-match-data + (set-match-data data) + (xdg-desktop-strings "a;b") + (should (equal (match-data) data))))) + +(ert-deftest xdg-desktop-parsing () + "Test `xdg-desktop-read-file' parsing of .desktop files." + (let ((tab (xdg-desktop-read-file + (expand-file-name "test.desktop" xdg-tests-data-dir)))) + (should (equal (gethash "Name" tab) "Test"))) + (should-error + (xdg-desktop-read-file + (expand-file-name "wrong.desktop" xdg-tests-data-dir)))) + +(ert-deftest xdg-desktop-strings-type () + "Test desktop \"string(s)\" type: strings delimited by \";\"." + (should (equal (xdg-desktop-strings " a") '("a"))) + (should (equal (xdg-desktop-strings "a;b") '("a" "b"))) + (should (equal (xdg-desktop-strings "a;b;") '("a" "b"))) + (should (equal (xdg-desktop-strings "\\;") '(";"))) + (should (equal (xdg-desktop-strings ";") '(""))) + (should (equal (xdg-desktop-strings " ") nil)) + (should (equal (xdg-desktop-strings "a; ;") '("a" " ")))) + +;;; xdg-tests.el ends here commit da3e1016349b2f552f149ccf577b60e377c3095a Author: Mark Oteiza Date: Wed Sep 6 11:20:21 2017 -0400 ; Try not to affect match data * lisp/xdg.el (xdg-user-dir): Use save-match-data. diff --git a/lisp/xdg.el b/lisp/xdg.el index 4973065f91..916de00d5e 100644 --- a/lisp/xdg.el +++ b/lisp/xdg.el @@ -140,9 +140,10 @@ This should be called at the beginning of a line." (defun xdg-user-dir (name) "Return the path of user directory referred to by NAME." (when (null xdg-user-dirs) - (setq xdg-user-dirs - (xdg--user-dirs-parse-file - (expand-file-name "user-dirs.dirs" (xdg-config-home))))) + (save-match-data + (setq xdg-user-dirs + (xdg--user-dirs-parse-file + (expand-file-name "user-dirs.dirs" (xdg-config-home)))))) (let ((dir (cdr (assoc name xdg-user-dirs)))) (when dir (expand-file-name dir)))) commit 01a82957d25e7fc3fe4ec799f3c05f22a4278428 Author: Glenn Morris Date: Tue Sep 5 20:53:57 2017 -0400 ; * lisp/emacs-lisp/ert.el (ert-batch-backtrace-right-margin): Fix tag. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 323576effe..9cc764d78e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -76,7 +76,7 @@ (defcustom ert-batch-backtrace-right-margin 70 "Maximum length of lines in ERT backtraces in batch mode. Use nil for no limit (caution: backtrace lines can be very long)." - :type '(choice (const nil :tag "No truncation") integer)) + :type '(choice (const :tag "No truncation" nil) integer)) (defface ert-test-result-expected '((((class color) (background light)) :background "green1") commit d48f30057f50b69e3afff308c56836344c0f55d4 Author: Glenn Morris Date: Tue Sep 5 20:46:38 2017 -0400 Allow for adjusting line length of test backtraces * test/Makefile.in (TEST_BACKTRACE_LINE_LENGTH): New option. (%.log): Respect backtrace line length. diff --git a/test/Makefile.in b/test/Makefile.in index d4395e69bb..e32920fb8b 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -97,6 +97,16 @@ TEST_LOCALE = C # this by default since it gives nicer stacktraces. TEST_LOAD_EL ?= yes +# Maximum length of lines in ert backtraces; nil for no limit. +# (if empty, use the default ert-batch-backtrace-right-margin). +TEST_BACKTRACE_LINE_LENGTH = + +ifeq (${TEST_BACKTRACE_LINE_LENGTH},) +ert_opts = +else +ert_opts = --eval '(setq ert-batch-backtrace-right-margin ${TEST_BACKTRACE_LINE_LENGTH})' +endif + ifeq (@HAVE_MODULES@, yes) MODULES_EMACSOPT := --module-assertions else @@ -147,7 +157,8 @@ endif %.log: %.elc $(AM_V_at)${MKDIR_P} $(dir $@) - $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ + $(AM_V_GEN)HOME=/nonexistent $(emacs) \ + -l ert ${ert_opts} -l $(testloadfile) \ --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} ifeq (@HAVE_MODULES@, yes) commit 52c9c6b9d80942766ad81183a5d0495bb77eb832 Author: Glenn Morris Date: Tue Sep 5 20:40:10 2017 -0400 Allow customizing line length of ert backtraces in batch mode * lisp/emacs-lisp/ert.el (ert-batch-backtrace-right-margin): Make it a user option. (ert-run-tests-batch): Handle ert-batch-backtrace-right-margin nil. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index c232b08bd1..323576effe 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -73,6 +73,11 @@ :prefix "ert-" :group 'lisp) +(defcustom ert-batch-backtrace-right-margin 70 + "Maximum length of lines in ERT backtraces in batch mode. +Use nil for no limit (caution: backtrace lines can be very long)." + :type '(choice (const nil :tag "No truncation") integer)) + (defface ert-test-result-expected '((((class color) (background light)) :background "green1") (((class color) (background dark)) @@ -1329,9 +1334,6 @@ RESULT must be an `ert-test-result-with-condition'." ;;; Running tests in batch mode. -(defvar ert-batch-backtrace-right-margin 70 - "The maximum line length for printing backtraces in `ert-run-tests-batch'.") - ;;;###autoload (defun ert-run-tests-batch (&optional selector) "Run the tests specified by SELECTOR, printing results to the terminal. @@ -1405,15 +1407,20 @@ Returns the stats object." (ert--print-backtrace (ert-test-result-with-condition-backtrace result) nil) - (goto-char (point-min)) - (while (not (eobp)) - (let ((start (point)) - (end (progn (end-of-line) (point)))) - (setq end (min end - (+ start ert-batch-backtrace-right-margin))) - (message "%s" (buffer-substring-no-properties - start end))) - (forward-line 1))) + (if (not ert-batch-backtrace-right-margin) + (message "%s" + (buffer-substring-no-properties (point-min) + (point-max))) + (goto-char (point-min)) + (while (not (eobp)) + (let ((start (point)) + (end (line-end-position))) + (setq end (min end + (+ start + ert-batch-backtrace-right-margin))) + (message "%s" (buffer-substring-no-properties + start end))) + (forward-line 1)))) (with-temp-buffer (ert--insert-infos result) (insert " ") commit a2cf4d49f1548b438ce7dd1e99bb2bb8e4e99092 Author: Glenn Morris Date: Tue Sep 5 18:55:49 2017 -0400 Minor emacsclient-tests simplification * test/lib-src/emacsclient-tests.el (emacsclient-test-emacs): Simplify. Also work when running installed. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 61ead4f0f3..3a2396f781 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -26,12 +26,10 @@ (require 'ert) (defconst emacsclient-test-emacs - (expand-file-name "emacsclient" (concat - (file-name-directory - (directory-file-name - (file-name-directory invocation-directory))) - "lib-src")) - "Path to emacsclient binary in build tree.") + (if installation-directory + (expand-file-name "lib-src/emacsclient" installation-directory) + "emacsclient") + "The emacsclient binary to test.") (defun emacsclient-test-call-emacsclient () "Run emacsclient." commit 732fdeb341e3b53568548254ef37c7413c4343bb Author: Alan Third Date: Tue Sep 5 23:40:46 2017 +0100 Revert "Force screen update after drawing cursor glyph (bug#23774)" This reverts commit 1b492fa5456e2b6face8d0856f11d17e432693b0. See bug#28358 diff --git a/src/nsterm.m b/src/nsterm.m index 6b0e18bf43..ff3329d1ce 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3143,16 +3143,7 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. /* draw the character under the cursor */ if (cursor_type != NO_CURSOR) - { - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); - -#ifdef NS_IMPL_COCOA - /* The glyph under the cursor isn't displayed when switching - spaces, so force an update. This seems to be related to the - use of NSDisableScreenUpdates. */ - [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; -#endif - } + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); #ifdef NS_IMPL_COCOA NSEnableScreenUpdates (); commit 964d672a7fce9ae2091d765ae9eb62559607b858 Author: Mark Oteiza Date: Tue Sep 5 16:39:21 2017 -0400 Refactor some loops in mailcap.el * lisp/net/mailcap.el (mailcap-mime-types): (mailcap-file-default-commands): Convert nested maps to loops. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 0b79521b7a..f943015e18 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1007,20 +1007,13 @@ If FORCE, re-parse even if already parsed." (delete-dups (nconc (mapcar 'cdr mailcap-mime-extensions) - (apply - 'nconc - (mapcar - (lambda (l) - (delq nil - (mapcar - (lambda (m) - (let ((type (cdr (assq 'type (cdr m))))) - (if (equal (cadr (split-string type "/")) - "*") - nil - type))) - (cdr l)))) - mailcap-mime-data))))) + (let (res type) + (dolist (data mailcap-mime-data) + (dolist (info (cdr data)) + (setq type (cdr (assq 'type (cdr info)))) + (unless (string-match-p "\\*" type) + (push type res)))) + (nreverse res))))) ;;; ;;; Useful supplementary functions @@ -1047,32 +1040,31 @@ If FORCE, re-parse even if already parsed." ;; Intersection of mime-infos from different mime-types; ;; or just the first MIME info for a single MIME type (if (cdr all-mime-info) - (delq nil (mapcar (lambda (mi1) - (unless (memq nil (mapcar - (lambda (mi2) - (member mi1 mi2)) - (cdr all-mime-info))) - mi1)) - (car all-mime-info))) - (car all-mime-info))) - (commands - ;; Command strings from `viewer' field of the MIME info - (delete-dups - (delq nil (mapcar - (lambda (mime-info) - (let ((command (cdr (assoc 'viewer mime-info)))) - (if (stringp command) - (replace-regexp-in-string - ;; Replace mailcap's `%s' placeholder - ;; with dired's `?' placeholder - "%s" "?" - (replace-regexp-in-string - ;; Remove the final filename placeholder - "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" - command nil t) - nil t)))) - common-mime-info))))) - commands)) + (let (res) + (dolist (mi1 (car all-mime-info)) + (dolist (mi2 (cdr all-mime-info)) + (when (member mi1 mi2) + (push mi1 res)))) + (nreverse res)) + (car all-mime-info)))) + ;; Command strings from `viewer' field of the MIME info + (delete-dups + (let (res command) + (dolist (mime-info common-mime-info) + (setq command (cdr (assq 'viewer mime-info))) + (when (stringp command) + (push + (replace-regexp-in-string + ;; Replace mailcap's `%s' placeholder + ;; with dired's `?' placeholder + "%s" "?" + (replace-regexp-in-string + ;; Remove the final filename placeholder + "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" + command nil t) + nil t) + res))) + (nreverse res))))) (defun mailcap-view-mime (type) "View the data in the current buffer that has MIME type TYPE. commit df4940c8dd2b5517fad411a8fb6d23d058eea764 Author: Glenn Morris Date: Tue Sep 5 16:01:11 2017 -0400 emacsclient-tests: remove some debug statements * test/lib-src/emacsclient-tests.el (emacsclient-test-call-emacsclient): Remove debug statements. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index dce1c89f86..61ead4f0f3 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -35,9 +35,6 @@ (defun emacsclient-test-call-emacsclient () "Run emacsclient." - (when (getenv "EMACS_HYDRA_CI") - (message "emacsclient-test-emacs: %s" emacsclient-test-emacs) - (message "ALTERNATE_EDITOR: %s" (getenv "ALTERNATE_EDITOR"))) (call-process emacsclient-test-emacs nil nil nil "--server-file" (expand-file-name "non-existent-file" invocation-directory) "foo")) commit fca62384537e1a32e867f4d3181e0b2b79396383 Author: Simen Heggestøyl Date: Wed Aug 9 15:34:34 2017 +0200 Handle non-zero exit status from psql more gracefully * lisp/progmodes/sql.el (sql-postgres-list-databases): Handle non-zero exit statuses from `psql -ltX' more gracefully by returning nil. * test/lisp/progmodes/sql-tests.el (sql-tests-postgres-list-databases-error): New test. diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index b176e52950..48e21605a3 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -1095,9 +1095,10 @@ add your name with a \"-U\" prefix (such as \"-Umark\") to the list." "Return a list of available PostgreSQL databases." (when (executable-find sql-postgres-program) (let ((res '())) - (dolist (row (process-lines sql-postgres-program "-ltX")) - (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) - (push (match-string 1 row) res))) + (ignore-errors + (dolist (row (process-lines sql-postgres-program "-ltX")) + (when (string-match "^ \\([[:alnum:]-_]+\\) +|.*" row) + (push (match-string 1 row) res)))) (nreverse res)))) ;; Customization for Interbase diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 27a72aa2c2..f75005f737 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -43,5 +43,15 @@ (should (equal (sql-postgres-list-databases) '("db-name-1" "db_name_2"))))) +(ert-deftest sql-tests-postgres-list-databases-error () + "Test that nil is returned when `psql -ltX' fails." + (cl-letf + (((symbol-function 'executable-find) + (lambda (_command) t)) + ((symbol-function 'process-lines) + (lambda (_program &rest _args) + (error)))) + (should-not (sql-postgres-list-databases)))) + (provide 'sql-tests) ;;; sql-tests.el ends here commit 25a49f64963d1c2a392ebaa66676042b55e0e3c1 Author: Eli Zaretskii Date: Tue Sep 5 20:33:40 2017 +0300 Avoid losing Ctrl-C keystrokes in compilation mode on MS-Windows * src/w32proc.c (sys_kill): Preserve the up/down state of the Ctrl key across the simulated Ctrl-C keystroke. (Bug#28348) diff --git a/src/w32proc.c b/src/w32proc.c index 71bd28d3c2..085995df58 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -2638,6 +2638,12 @@ sys_kill (pid_t pid, int sig) /* Set the foreground window to the child. */ if (SetForegroundWindow (cp->hwnd)) { + /* Record the state of the Ctrl key: the user could + have it depressed while we are simulating Ctrl-C, + in which case we will have to leave the state of + Ctrl depressed when we are done. */ + short ctrl_state = GetKeyState (VK_CONTROL) & 0x8000; + /* Generate keystrokes as if user had typed Ctrl-Break or Ctrl-C. */ keybd_event (VK_CONTROL, control_scan_code, 0, 0); @@ -2654,6 +2660,9 @@ sys_kill (pid_t pid, int sig) Sleep (100); SetForegroundWindow (foreground_window); + /* If needed, restore the state of Ctrl. */ + if (ctrl_state != 0) + keybd_event (VK_CONTROL, control_scan_code, 0, 0); } /* Detach from the foreground and child threads now that the foreground switching is over. */ commit 4eae60395c6270ed69b0d311e68382d2c723cb9a Author: Andreas Schwab Date: Tue Sep 5 18:58:37 2017 +0200 * src/image.c (Fimagemagick_types): Doc fix. diff --git a/src/image.c b/src/image.c index 76a19a68b0..7f5cf1a966 100644 --- a/src/image.c +++ b/src/image.c @@ -8918,7 +8918,7 @@ their descriptions (http://www.imagemagick.org/script/formats.php). You can also try the shell command: `identify -list format'. Note that ImageMagick recognizes many file-types that Emacs does not -recognize as images, such as C. See `imagemagick-types-enable' +recognize as images, such as C. See `imagemagick-enabled-types' and `imagemagick-types-inhibit'. */) (void) { commit 485e25312d56b6bdf59da6ade1ec08f8caaa240a Author: Mark Oteiza Date: Tue Sep 5 12:03:10 2017 -0400 Move soundex.el test to a proper test * test/lisp/soundex-tests.el: New file. * lisp/soundex.el: Use lexical-binding. Remove commented test. diff --git a/lisp/soundex.el b/lisp/soundex.el index e0d83303e3..a83bab8a91 100644 --- a/lisp/soundex.el +++ b/lisp/soundex.el @@ -1,4 +1,4 @@ -;;; soundex.el --- implement Soundex algorithm +;;; soundex.el --- implement Soundex algorithm -*- lexical-binding: t -*- ;; Copyright (C) 1993, 2001-2017 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ ;;; Code: -(defvar soundex-alist +(defconst soundex-alist '((?B . "1") (?F . "1") (?P . "1") (?V . "1") (?C . "2") (?G . "2") (?J . "2") (?K . "2") (?Q . "2") (?S . "2") (?X . "2") (?Z . "2") (?D . "3") (?T . "3") (?L . "4") (?M . "5") @@ -60,15 +60,6 @@ and Searching\", Addison-Wesley (1973), pp. 391-392." (substring (concat key "000") 0 4) key))) -;(defvar soundex-test -; '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz" -; "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous") -; "\n Knuth's names to demonstrate the Soundex algorithm.") -; -;(mapcar 'soundex soundex-test) -;("E460" "G200" "H416" "K530" "L300" "L222" -; "E460" "G200" "H416" "K530" "L300" "L222") - (provide 'soundex) ;;; soundex.el ends here diff --git a/test/lisp/soundex-tests.el b/test/lisp/soundex-tests.el new file mode 100644 index 0000000000..d1bc99d811 --- /dev/null +++ b/test/lisp/soundex-tests.el @@ -0,0 +1,43 @@ +;;; soundex-tests.el --- tests for soundex.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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: + +;; Test `soundex-test-names' originally adapted from code in +;; soundex.el by Christian Plaunt + +;;; Code: + +(require 'ert) +(require 'soundex) + +(defconst soundex-test-name-list + '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz" + "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous") + "Knuth's names to demonstrate the Soundex algorithm.") + +(ert-deftest soundex-test-names () + (should + (equal (mapcar #'soundex soundex-test-name-list) + '("E460" "G200" "H416" "K530" "L300" "L222" + "E460" "G200" "H416" "K530" "L300" "L222")))) + +;;; soundex-tests.el ends here commit 9f64d59ae6d87f38276fe05254094113a171fb0e Author: Mark Oteiza Date: Tue Sep 5 11:53:37 2017 -0400 Add tests for mailcap.el * test/data/mailcap/mime.types: New file. * test/lisp/net/mailcap-tests.el: New file. diff --git a/test/data/mailcap/mime.types b/test/data/mailcap/mime.types new file mode 100644 index 0000000000..4bedfaf970 --- /dev/null +++ b/test/data/mailcap/mime.types @@ -0,0 +1,5 @@ +# this is a comment + +audio/ogg opus +audio/flac flac +audio/x-wav wav diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el new file mode 100644 index 0000000000..9e32931ff7 --- /dev/null +++ b/test/lisp/net/mailcap-tests.el @@ -0,0 +1,69 @@ +;;; mailcap-tests.el --- tests for mailcap.el -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Mark Oteiza + +;; 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: + +;;; Code: + +(require 'ert) +(require 'mailcap) + +(defconst mailcap-tests-data-dir + (expand-file-name "test/data/mailcap" source-directory)) + +(defconst mailcap-tests-path + (expand-file-name "mime.types" mailcap-tests-data-dir) + "String used as PATH argument of `mailcap-parse-mimetypes'.") + +(defconst mailcap-tests-mime-extensions (copy-alist mailcap-mime-extensions)) + +(defconst mailcap-tests-path-extensions + '((".wav" . "audio/x-wav") + (".flac" . "audio/flac") + (".opus" . "audio/ogg")) + "Alist of MIME associations in `mailcap-tests-path'.") + +(ert-deftest mailcap-mimetypes-parsed-p () + (should (null mailcap-mimetypes-parsed-p))) + +(ert-deftest mailcap-parse-empty-path () + "If PATH is empty, this should be a noop." + (mailcap-parse-mimetypes "file/that/should/not/exist" t) + (should mailcap-mimetypes-parsed-p) + (should (equal mailcap-mime-extensions mailcap-tests-mime-extensions))) + +(ert-deftest mailcap-parse-path () + (let ((mimetypes (getenv "MIMETYPES"))) + (unwind-protect + (progn + (setenv "MIMETYPES" mailcap-tests-path) + (mailcap-parse-mimetypes nil t)) + (setenv "MIMETYPES" mimetypes))) + (should (equal mailcap-mime-extensions + (append mailcap-tests-path-extensions + mailcap-tests-mime-extensions))) + ;; Already parsed this, should be a noop + (mailcap-parse-mimetypes mailcap-tests-path) + (should (equal mailcap-mime-extensions + (append mailcap-tests-path-extensions + mailcap-tests-mime-extensions)))) + +;;; mailcap-tests.el ends here commit 8d251607e08e1ea4df201928b5bee21782a6526e Author: Michael Albinus Date: Tue Sep 5 15:32:03 2017 +0200 Doc precisment about remote link targets * doc/lispref/files.texi (Truenames): Explain handling of targets of `file-truename' and `make-symbolic-link', which look like a remote file name. * etc/NEWS: Precise examples for symlinks which look like remote file names. MUSTBENEW of `write-region' is not propagated to file name handlers. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 06466c9bba..d04be63d7e 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1116,8 +1116,11 @@ file name component immediately preceding @samp{..} will be simplified away before @code{file-truename} is called. To eliminate the need for a call to @code{expand-file-name}, @code{file-truename} handles @samp{~} in the same way that -@code{expand-file-name} does. @xref{File Name Expansion,, Functions -that Expand Filenames}. +@code{expand-file-name} does. + +If the target of a symbolic links has remote file name syntax, +@code{file-truename} returns it quoted. @xref{File Name Expansion,, +Functions that Expand Filenames}. @end defun @defun file-chase-links filename &optional limit @@ -1736,10 +1739,15 @@ is treated only as a string; it need not name an existing file. If @var{ok-if-already-exists} is an integer, indicating interactive use, then leading @samp{~} is expanded and leading @samp{/:} is stripped in the @var{target} string. + If @var{target} is a relative file name, the resulting symbolic link is interpreted relative to the directory containing the symbolic link. @xref{Relative File Names}. +If both @var{target} and @var{newname} have remote file name syntax, +and if both remote identifications are equal, the symbolic link points +to the local file name part of @var{target}. + This function is not available on systems that don't support symbolic links. @end deffn diff --git a/etc/NEWS b/etc/NEWS index 2b0c86d7af..2824349a53 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1210,23 +1210,35 @@ The following changes are involved. --- *** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to symbolic links whose targets begin with "/" and contain ":". For -example, if a symbolic link "x" has a target "/y:z", (file-symlink-p -"x") now returns "/y:z" rather than "/:/y:z". +example, if a symbolic link "x" has a target "/y:z:", '(file-symlink-p +"x")' now returns "/y:z:" rather than "/:/y:z:". --- -*** 'make-symbolic-link' no longer looks for file name handlers when -creating a local symbolic link. For example, (make-symbolic-link -"/y:z" "x") now creates a symlink to "/y:z" instead of failing. +*** 'make-symbolic-link' no longer looks for file name handlers of +target when creating a symbolic link. For example, +'(make-symbolic-link "/y:z:" "x")' now creates a symbolic link to +"/y:z:" instead of failing. + ++++ +*** 'make-symbolic-link' removes the remote part of a link target if +target and newname have the same remote part. For example, +'(make-symbolic-link "/x:y:a" "/x:y:b")' creates a link with the +literal string "a"; and '(make-symbolic-link "/x:y:a" "/x:z:b")' +creates a link with the literal string "/x:y:a" instead of failing. +++ *** 'make-symbolic-link' now expands a link target with leading "~" only when the optional third arg is an integer, as when invoked -interactively. For example, (make-symbolic-link "~y" "x") now creates -a link with target the literal string "~y"; to get the old behavior, -use (make-symbolic-link (expand-file-name "~y") "x"). To avoid this -expansion in interactive use, you can now prefix the link target with -"/:". For example, (make-symbolic-link "/:~y" "x" 1) now creates a -link to literal "~y". +interactively. For example, '(make-symbolic-link "~y" "x")' now +creates a link with target the literal string "~y"; to get the old +behavior, use '(make-symbolic-link (expand-file-name "~y") "x")'. To +avoid this expansion in interactive use, you can now prefix the link +target with "/:". For example, '(make-symbolic-link "/:~y" "x" 1)' +now creates a link to literal "~y". + ++++ +** 'file-truename' returns a quoted file name if the target of a +symbolic link has remote file name syntax. +++ ** Module functions are now implemented slightly differently; in @@ -1235,8 +1247,8 @@ Code that depends on undocumented internals of the module system might break. --- -** The arguments LOCKNAME and MUSTBENEW of 'write-region' are -propagated to file name handlers now. +** The argument LOCKNAME of 'write-region' is propagated to file name +handlers now. --- ** When built against recent versions of GTK+, Emacs always uses commit c09116e64012534ee244c22f1ba4f2e106f6ed91 Author: John Wiegley Date: Tue Sep 5 14:24:25 2017 +0100 Remove an opinionated section on "What Eshell is not" I don't find this information to accurately reflect possible use cases for Eshell; plus, it doesn't offer much in the way of information, just opinion. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index a7651b21d6..8963826c4c 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -142,24 +142,6 @@ Any tool you use often deserves the time spent learning to master it. looks like: But don't let it fool you; once you know what's going on, it's easier than it looks: @code{ls -lt **/*.doc(Lk+50aM+5)}.} -@section What Eshell is not -@cindex Eshell, what it is not -@cindex what Eshell is not -@cindex what isn't Eshell? - -Eshell is @emph{not} a replacement for system shells such as -@command{bash} or @command{zsh}. Use Eshell when you want to move -text between Emacs and external processes; if you only want to pipe -output from one external process to another (and then another, and so -on), use a system shell, because Emacs's IO system is buffer oriented, -not stream oriented, and is very inefficient at such tasks. If you -want to write shell scripts in Eshell, don't; either write an elisp -library or use a system shell. - -Some things Eshell just doesn't do well. It fills the niche between -IELM and your system shell, where the peculiar use-cases lie, and it -is less than ideal outside that niche. - @menu * Contributors to Eshell:: People who have helped out! @end menu commit 979797b9eca0ab009cc75a29765f998ec2aa1b45 Author: Ken Brown Date: Mon Sep 4 21:46:05 2017 -0400 Fix configure test for Xpm Problem reported by Ashish Shukla in https://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00020.html. * configure.ac (HAVE_XPM) [HAVE_X11]: Include X11/xpm.h instead of noX/xpm.h in configure test. diff --git a/configure.ac b/configure.ac index 2e0b416053..250a51725b 100644 --- a/configure.ac +++ b/configure.ac @@ -3364,7 +3364,7 @@ if test "${HAVE_X11}" = "yes"; then AC_CACHE_CHECK([for XpmReturnAllocPixels preprocessor define], [emacs_cv_cpp_xpm_return_alloc_pixels], [AC_EGREP_CPP(no_return_alloc_pixels, - [#include "noX/xpm.h" + [#include "X11/xpm.h" #ifndef XpmReturnAllocPixels no_return_alloc_pixels #endif commit d4c3669f9dd7a1da013c8d9d3d285fc3b67de533 Author: Paul Eggert Date: Mon Sep 4 12:08:55 2017 -0700 Revert recent float→double Motif change Problem reported by Martin Rudalics in: http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00014.html * src/xterm.c (xm_scroll_callback, xaw_jump_callback) (x_set_toolkit_scroll_bar_thumb) (x_set_toolkit_horizontal_scroll_bar_thumb): Go back to using ‘float’ temporaries rather than ‘double’. Although quite possibly this masks an underlying bug, we lack time to look into that now. diff --git a/src/xterm.c b/src/xterm.c index a7a52064a1..0b949330eb 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5587,9 +5587,8 @@ xm_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) if (horizontal) { - double dXM_SB_MAX = XM_SB_MAX; - portion = bar->whole * (cs->value / dXM_SB_MAX); - whole = bar->whole * ((XM_SB_MAX - slider_size) / dXM_SB_MAX); + portion = bar->whole * ((float)cs->value / XM_SB_MAX); + whole = bar->whole * ((float)(XM_SB_MAX - slider_size) / XM_SB_MAX); portion = min (portion, whole); part = scroll_bar_horizontal_handle; } @@ -5726,8 +5725,8 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) { struct scroll_bar *bar = client_data; float *top_addr = call_data; - double top = *top_addr; - double shown; + float top = *top_addr; + float shown; int whole, portion, height, width; enum scroll_bar_part part; bool horizontal = bar->horizontal; @@ -5741,8 +5740,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) if (shown < 1) { - double dshown = shown; - whole = bar->whole - (dshown * bar->whole); + whole = bar->whole - (shown * bar->whole); portion = min (top * bar->whole, whole); } else @@ -5763,7 +5761,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) whole = 10000000; portion = shown < 1 ? top * whole : 0; - if (shown < 1 && (eabs (top + shown - 1) < 1.0 / height)) + if (shown < 1 && (eabs (top + shown - 1) < 1.0f / height)) /* Some derivatives of Xaw refuse to shrink the thumb when you reach the bottom, so we force the scrolling whenever we see that we're too close to the bottom (in x_set_toolkit_scroll_bar_thumb @@ -6306,8 +6304,7 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); - double dwhole = whole; - double top, shown; + float top, shown; block_input (); @@ -6336,8 +6333,8 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio top = 0, shown = 1; else { - top = position / dwhole; - shown = portion / dwhole; + top = (float) position / whole; + shown = (float) portion / whole; } if (bar->dragging == -1) @@ -6361,14 +6358,13 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio top = 0, shown = 1; else { - top = position / dwhole; - shown = portion / dwhole; + top = (float) position / whole; + shown = (float) portion / whole; } { - double old_top, old_shown; + float old_top, old_shown; Dimension height; - XtVaGetValues (widget, XtNtopOfThumb, &old_top, XtNshown, &old_shown, @@ -6383,21 +6379,19 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio #if ! defined (HAVE_XAW3D) /* With Xaw, 'top' values too closer to 1.0 may cause the thumb to disappear. Fix that. */ - top = min (top, 0.99); + top = min (top, 0.99f); #endif /* Keep two pixels available for moving the thumb down. */ - shown = max (0, min (1 - top - (2.0 / height), shown)); + shown = max (0, min (1 - top - (2.0f / height), shown)); #if ! defined (HAVE_XAW3D) /* Likewise with too small 'shown'. */ - shown = max (shown, 0.01); + shown = max (shown, 0.01f); #endif /* If the call to XawScrollbarSetThumb below doesn't seem to work, check that 'NARROWPROTO' is defined in src/config.h. If this is not so, most likely you need to fix configure. */ - double ftop = top, fshown = shown; - - if (ftop != old_top || fshown != old_shown) + if (top != old_top || shown != old_shown) { if (bar->dragging == -1) XawScrollbarSetThumb (widget, top, shown); @@ -6422,15 +6416,14 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); - double dwhole = whole; - double top, shown; + float top, shown; block_input (); #ifdef USE_MOTIF bar->whole = whole; - shown = portion / dwhole; - top = position / (dwhole - portion); + shown = (float) portion / whole; + top = (float) position / (whole - portion); { int size = clip_to_bounds (1, shown * XM_SB_MAX, XM_SB_MAX); int value = clip_to_bounds (0, top * (XM_SB_MAX - size), XM_SB_MAX - size); @@ -6443,8 +6436,8 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, top = 0, shown = 1; else { - top = position / dwhole; - shown = portion / dwhole; + top = (float) position / whole; + shown = (float) portion / whole; } { @@ -6465,13 +6458,13 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, #if ! defined (HAVE_XAW3D) /* With Xaw, 'top' values too closer to 1.0 may cause the thumb to disappear. Fix that. */ - top = min (top, 0.99); + top = min (top, 0.99f); #endif /* Keep two pixels available for moving the thumb down. */ - shown = max (0, min (1 - top - (2.0 / height), shown)); + shown = max (0, min (1 - top - (2.0f / height), shown)); #if ! defined (HAVE_XAW3D) /* Likewise with too small 'shown'. */ - shown = max (shown, 0.01); + shown = max (shown, 0.01f); #endif #endif @@ -6480,8 +6473,7 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, If this is not so, most likely you need to fix configure. */ XawScrollbarSetThumb (widget, top, shown); #if false - float ftop = top, fshown = shown; - if (ftop != old_top || fshown != old_shown) + if (top != old_top || shown != old_shown) { if (bar->dragging == -1) XawScrollbarSetThumb (widget, top, shown); commit 514e147dd3233615e7a3e17d594d05ac1420bae5 Author: Glenn Morris Date: Mon Sep 4 09:21:24 2017 -0700 emacsclient-tests: add some debug statements * test/lib-src/emacsclient-tests.el (emacsclient-test-call-emacsclient): Add debug statements. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 61ead4f0f3..dce1c89f86 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -35,6 +35,9 @@ (defun emacsclient-test-call-emacsclient () "Run emacsclient." + (when (getenv "EMACS_HYDRA_CI") + (message "emacsclient-test-emacs: %s" emacsclient-test-emacs) + (message "ALTERNATE_EDITOR: %s" (getenv "ALTERNATE_EDITOR"))) (call-process emacsclient-test-emacs nil nil nil "--server-file" (expand-file-name "non-existent-file" invocation-directory) "foo")) commit 8a65d7a73199315f58588876b6fd34c866814c7c Author: Michael Albinus Date: Mon Sep 4 13:10:52 2017 +0200 Work on Tramp's (symbolic) links * doc/misc/tramp.texi (Traces and Profiles): Mention the backtrace when tramp-verbose is greater than or equal to 10. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): Use `tramp-handle-add-name-to-file'. * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): Use `tramp-handle-add-name-to-file' and `tramp-handle-file-truename'. * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Improve. * lisp/net/tramp-smb.el (tramp-smb-errors): Add "NT_STATUS_CONNECTION_DISCONNECTED" and "NT_STATUS_OBJECT_PATH_SYNTAX_BAD". (tramp-smb-file-name-handler-alist): Use `tramp-handle-file-truename'. (tramp-smb-do-file-attributes-with-stat): Return non-nil only if one of the attributes is non-nil. (tramp-smb-handle-file-local-copy): Use `file-truename'. (tramp-smb-handle-file-truename): Move to tramp.el. (tramp-smb-handle-insert-directory): Show symlinks. (tramp-smb-handle-make-symbolic-link): Improve. (tramp-smb-read-file-entry): Handle extended file modes in Samba. * lisp/net/tramp.el (tramp-handle-add-name-to-file) (tramp-handle-file-truename): New defuns. * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test. (tramp--test-check-files): Make check for "smb". diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 1b751a01db..5e0b1d854f 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -3837,6 +3837,10 @@ both the error and the signal have to be set as follows: @end group @end lisp +If @code{tramp-verbose} is greater than or equal to 10, Lisp +backtraces are also added to the @value{tramp} debug buffer in case of +errors. + To enable stepping through @value{tramp} function call traces, they have to be specifically enabled as shown in this code: diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 6e662df6e2..6e8dd2f9c8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -97,7 +97,7 @@ It is used for TCP/IP devices." ;;;###tramp-autoload (defconst tramp-adb-file-name-handler-alist '((access-file . ignore) - (add-name-to-file . tramp-adb-handle-copy-file) + (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. ;; `copy-directory' performed by default handler. (copy-file . tramp-adb-handle-copy-file) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 48f50a3d05..6567991804 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -453,7 +453,7 @@ Every entry is a list (NAME ADDRESS).") ;;;###tramp-autoload (defconst tramp-gvfs-file-name-handler-alist '((access-file . ignore) - (add-name-to-file . tramp-gvfs-handle-copy-file) + (add-name-to-file . tramp-handle-add-name-to-file) ;; `byte-compiler-base-file-name' performed by default handler. ;; `copy-directory' performed by default handler. (copy-file . tramp-gvfs-handle-copy-file) @@ -494,7 +494,7 @@ Every entry is a list (NAME ADDRESS).") (file-remote-p . tramp-handle-file-remote-p) (file-selinux-context . ignore) (file-symlink-p . tramp-handle-file-symlink-p) - ;; `file-truename' performed by default handler. + (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-gvfs-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `find-file-noselect' performed by default handler. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 85966f122d..597ca6a620 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1063,52 +1063,59 @@ component is used as the target of the symlink." 'make-symbolic-link (list target linkname ok-if-already-exists)) (with-parsed-tramp-file-name linkname nil - (let ((ln (tramp-get-remote-ln v)) - (cwd (tramp-run-real-handler - 'file-name-directory (list localname)))) - (unless ln - (tramp-error - v 'file-error + ;; If TARGET is a Tramp name, use just the localname component. + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p v (tramp-dissect-file-name target))) + (setq target + (tramp-file-name-localname + (tramp-dissect-file-name (expand-file-name target))))) + + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p target) + (make-symbolic-link + (let (file-name-handler-alist) (tramp-compat-file-name-quote target)) + linkname ok-if-already-exists) + + (let ((ln (tramp-get-remote-ln v)) + (cwd (tramp-run-real-handler + 'file-name-directory (list localname)))) + (unless ln + (tramp-error + v 'file-error "Making a symbolic link. ln(1) does not exist on the remote host.")) - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - ;; If TARGET is a Tramp name, use just the localname component. - (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p - v (tramp-dissect-file-name target))) - (setq target - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name target))))) - - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) - - ;; Right, they are on the same host, regardless of user, method, - ;; etc. We now make the link on the remote machine. This will - ;; occur as the user that TARGET belongs to. - (and (tramp-send-command-and-check - v (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - v (format - "%s -sf %s %s" ln - (tramp-shell-quote-argument target) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file names - ;; could start with "-". `tramp-shell-quote-argument' - ;; does not handle this, we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory localname)))))))))) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not + (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + ;; Right, they are on the same host, regardless of user, + ;; method, etc. We now make the link on the remote + ;; machine. This will occur as the user that TARGET belongs to. + (and (tramp-send-command-and-check + v (format "cd %s" (tramp-shell-quote-argument cwd))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" ln + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use + ;; relative file names. However, relative file + ;; names could start with "-". + ;; `tramp-shell-quote-argument' does not handle + ;; this, we must do it ourselves. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname))))))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 0b05cdb8cc..8368cff684 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -130,6 +130,7 @@ call, letting the SMB client use the default one." "NT_STATUS_ACCOUNT_LOCKED_OUT" "NT_STATUS_BAD_NETWORK_NAME" "NT_STATUS_CANNOT_DELETE" + "NT_STATUS_CONNECTION_DISCONNECTED" "NT_STATUS_CONNECTION_REFUSED" "NT_STATUS_DIRECTORY_NOT_EMPTY" "NT_STATUS_DUPLICATE_NAME" @@ -148,6 +149,7 @@ call, letting the SMB client use the default one." "NT_STATUS_OBJECT_NAME_COLLISION" "NT_STATUS_OBJECT_NAME_INVALID" "NT_STATUS_OBJECT_NAME_NOT_FOUND" + "NT_STATUS_OBJECT_PATH_SYNTAX_BAD" "NT_STATUS_PASSWORD_MUST_CHANGE" "NT_STATUS_SHARING_VIOLATION" "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" @@ -253,7 +255,7 @@ See `tramp-actions-before-shell' for more info.") (file-remote-p . tramp-handle-file-remote-p) ;; `file-selinux-context' performed by default handler. (file-symlink-p . tramp-handle-file-symlink-p) - (file-truename . tramp-smb-handle-file-truename) + (file-truename . tramp-handle-file-truename) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `find-file-noselect' performed by default handler. @@ -900,8 +902,9 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (setq id (match-string 1)))) ;; Return the result. - (list id link uid gid atime mtime ctime size mode nil inode - (tramp-get-device vec))))))) + (when (or id link uid gid atime mtime ctime size mode inode) + (list id link uid gid atime mtime ctime size mode nil inode + (tramp-get-device vec)))))))) (defun tramp-smb-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." @@ -912,8 +915,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (defun tramp-smb-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." - (with-parsed-tramp-file-name filename nil - (unless (file-exists-p filename) + (with-parsed-tramp-file-name (file-truename filename) nil + (unless (file-exists-p (file-truename filename)) (tramp-error v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) @@ -947,23 +950,6 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (nth 0 x)))) (tramp-smb-get-file-entries directory)))))))) -(defun tramp-smb-handle-file-truename (filename) - "Like `file-truename' for Tramp files." - (format - "%s%s" - (with-parsed-tramp-file-name (expand-file-name filename) nil - (tramp-make-tramp-file-name - method user domain host port - (with-tramp-file-property v localname "file-truename" - (funcall - (if (tramp-compat-file-name-quoted-p localname) - 'tramp-compat-file-name-quote 'identity) - ;; We don't follow symlink of symlink. - (or (file-symlink-p filename) localname))))) - - ;; Preserve trailing "/". - (if (string-equal (file-name-nondirectory filename) "") "/" ""))) - (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) @@ -1046,11 +1032,14 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (mapc (lambda (x) (when (not (zerop (length (nth 0 x)))) - (when (string-match "l" switches) - (let ((attr - (when (tramp-smb-get-stat-capability v) - (ignore-errors - (file-attributes filename 'string))))) + (let ((attr + (when (tramp-smb-get-stat-capability v) + (ignore-errors + (file-attributes + (expand-file-name + (nth 0 x) (file-name-directory filename)) + 'string))))) + (when (string-match "l" switches) (insert (format "%10s %3d %-8s %-8s %8s %s " @@ -1064,20 +1053,27 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." tramp-half-a-year) "%b %e %R" "%b %e %Y") - (nth 3 x)))))) ; date - - ;; We mark the file name. The inserted name could be - ;; from somewhere else, so we use the relative file name - ;; of `default-directory'. - (let ((start (point))) - (insert - (format - "%s\n" - (file-relative-name - (expand-file-name - (nth 0 x) (file-name-directory filename)) - (when full-directory-p (file-name-directory filename))))) - (put-text-property start (1- (point)) 'dired-filename t)) + (nth 3 x))))) ; date + + ;; We mark the file name. The inserted name could be + ;; from somewhere else, so we use the relative file name + ;; of `default-directory'. + (let ((start (point))) + (insert + (format + "%s" + (file-relative-name + (expand-file-name + (nth 0 x) (file-name-directory filename)) + (when full-directory-p (file-name-directory filename))))) + (put-text-property start (point) 'dired-filename t)) + + ;; Insert symlink. + (when (and (string-match "l" switches) + (stringp (tramp-compat-file-attribute-type attr))) + (insert " -> " (tramp-compat-file-attribute-type attr)))) + + (insert "\n") (forward-line) (beginning-of-line))) entries)))))) @@ -1134,43 +1130,48 @@ component is used as the target of the symlink." 'make-symbolic-link (list target linkname ok-if-already-exists)) (with-parsed-tramp-file-name linkname nil - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - localname))))) - (tramp-error v 'file-already-exists localname) - (delete-file linkname))) - - (unless (tramp-smb-get-cifs-capabilities v) - (tramp-error v 'file-error "make-symbolic-link not supported")) - ;; If TARGET is a Tramp name, use just the localname component. (when (and (tramp-tramp-file-p target) - (tramp-file-name-equal-p - v (tramp-dissect-file-name (expand-file-name target)))) + (tramp-file-name-equal-p v (tramp-dissect-file-name target))) (setq target (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name target))))) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v (file-name-directory localname)) - (tramp-flush-file-property v localname) + ;; If TARGET is still remote, quote it. + (if (tramp-tramp-file-p target) + (make-symbolic-link + (let (file-name-handler-alist) (tramp-compat-file-name-quote target)) + linkname ok-if-already-exists) - (unless - (tramp-smb-send-command - v (format "symlink \"%s\" \"%s\"" - (tramp-compat-file-name-unquote target) - (tramp-smb-get-localname v))) - (tramp-error - v 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (buffer-name)))))) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported")) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + (unless + (tramp-smb-send-command + v (format "symlink \"%s\" \"%s\"" + (tramp-compat-file-name-unquote target) + (tramp-smb-get-localname v))) + (tramp-error + v 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (buffer-name))))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) @@ -1723,13 +1724,17 @@ Result is the list (LOCALNAME MODE SIZE MTIME)." (if (string-match "\\([0-9]+\\)$" line) (let ((length (- (max 10 (1+ (length (match-string 1 line))))))) (setq size (string-to-number (match-string 1 line))) - (when (string-match "\\([ADHRSV]+\\)" (substring line length)) + (when (string-match + "\\([ACDEHNORrsSTV]+\\)" (substring line length)) (setq length (+ length (match-end 0)))) (setq line (substring line 0 length))) (cl-return)) - ;; mode: ARCH, DIR, HIDDEN, RONLY, SYSTEM, VOLID. - (if (string-match "\\([ADHRSV]+\\)?$" line) + ;; mode: ARCHIVE, COMPRESSED, DIRECTORY, ENCRYPTED, HIDDEN, + ;; NONINDEXED, NORMAL, OFFLINE, READONLY, + ;; REPARSE_POINT, SPARSE, SYSTEM, TEMPORARY, VOLID. + + (if (string-match "\\([ACDEHNORrsSTV]+\\)?$" line) (setq mode (or (match-string 1 line) "") mode (save-match-data (format diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1a5cda7e20..f4b69dbc66 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2824,6 +2824,33 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defun tramp-handle-add-name-to-file + (filename newname &optional ok-if-already-exists) + "Like `add-name-to-file' for Tramp files." + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p newname) newname filename) nil + (unless (tramp-equal-remote filename newname) + (tramp-error + v 'file-error + "add-name-to-file: %s" + "only implemented for same method, same user, same host")) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p newname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists newname) + (delete-file newname))) + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + (copy-file + filename newname 'ok-if-already-exists 'keep-time + 'preserve-uid-gid 'preserve-permissions))) + (defun tramp-handle-directory-file-name (directory) "Like `directory-file-name' for Tramp files." ;; If localname component of filename is "/", leave it unchanged. @@ -3068,6 +3095,47 @@ User is always nil." (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) (and (stringp x) x))) +(defun tramp-handle-file-truename (filename) + "Like `file-truename' for Tramp files." + (let ((result filename) + (numchase 0) + ;; Don't make the following value larger than + ;; necessary. People expect an error message in a + ;; timely fashion when something is wrong; + ;; otherwise they might think that Emacs is hung. + ;; Of course, correctness has to come first. + (numchase-limit 20) + symlink-target) + (format + "%s%s" + (with-parsed-tramp-file-name (expand-file-name result) v1 + (with-tramp-file-property v1 v1-localname "file-truename" + (while (and (setq symlink-target (file-symlink-p result)) + (< numchase numchase-limit)) + (setq numchase (1+ numchase) + result + (with-parsed-tramp-file-name (expand-file-name result) v2 + (tramp-make-tramp-file-name + v2-method v2-user v2-domain v2-host v2-port + (funcall + (if (tramp-compat-file-name-quoted-p v2-localname) + 'tramp-compat-file-name-quote 'identity) + + (if (stringp symlink-target) + (if (file-remote-p symlink-target) + (let (file-name-handler-alist) + (tramp-compat-file-name-quote symlink-target)) + symlink-target) + v2-localname))))) + (when (>= numchase numchase-limit) + (tramp-error + v1 'file-error + "Maximum number (%d) of symlinks exceeded" numchase-limit))) + result)) + + ;; Preserve trailing "/". + (if (string-equal (file-name-nondirectory filename) "") "/" "")))) + (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." (with-parsed-tramp-file-name filename nil diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 662163f3fe..c61e5dc9eb 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2607,7 +2607,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (make-symbolic-link tmp-name1 tmp-name2) :type 'file-already-exists) - ;; 0 means interactive case. + ;; number means interactive case. (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) (should-error (make-symbolic-link tmp-name1 tmp-name2 0) @@ -2659,7 +2659,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-error (add-name-to-file tmp-name1 tmp-name2) :type 'file-already-exists) - ;; 0 means interactive case. + ;; number means interactive case. (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) (should-error (add-name-to-file tmp-name1 tmp-name2 0) @@ -2685,6 +2685,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp--test-ignore-make-symbolic-link-error (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) + (should (string-equal tmp-name1 (file-truename tmp-name1))) (make-symbolic-link tmp-name1 tmp-name2) (should (file-symlink-p tmp-name2)) (should-not (string-equal tmp-name2 (file-truename tmp-name2))) @@ -2727,7 +2728,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (file-truename tmp-name1)) (tmp-name2 (tramp--test-make-temp-name nil quoted)) (tmp-name3 tmp-name2) - (number-nesting 50)) + (number-nesting 15)) (dotimes (_ number-nesting) (make-symbolic-link tmp-name3 @@ -2741,7 +2742,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :type tramp-file-missing) (should-error (with-temp-buffer (insert-file-contents tmp-name3)) - :type tramp-file-missing))) + :type tramp-file-missing) + ;; `directory-files' does not show symlinks to + ;; non-existing targets in the "smb" case. So we remove + ;; the symlinks manually. + (while (stringp (setq tmp-name2 (file-symlink-p tmp-name3))) + (delete-file tmp-name3) + (setq tmp-name3 (concat (file-remote-p tmp-name3) tmp-name2))))) ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive))) @@ -3750,23 +3757,27 @@ This requires restrictions of file name syntax." elt)) ;; Check symlink in `directory-files-and-attributes'. + ;; It does not work in the "smb" case, only relative + ;; symlinks to existing files are shown there. (tramp--test-ignore-make-symbolic-link-error - (make-symbolic-link file2 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) - elt1)) - (should - (string-equal - (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) - (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1))))) - (file-remote-p (file-truename file2) 'localname))) - (delete-file file3) - (should-not (file-exists-p file3))) + (unless + (tramp-smb-file-name-p tramp-test-temporary-file-directory) + (make-symbolic-link file2 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (caar (directory-files-and-attributes + file1 nil (regexp-quote elt1))) + elt1)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (cadr (car (directory-files-and-attributes + file1 nil (regexp-quote elt1))))) + (file-remote-p (file-truename file2) 'localname))) + (delete-file file3) + (should-not (file-exists-p file3)))) (delete-file file2) (should-not (file-exists-p file2)) commit 9314e6c56e248a5060a6c125e2088c4fbffe123b Author: Mark Oteiza Date: Mon Sep 4 03:40:30 2017 -0400 Embed JSON readtable into json-read Also unroll dispatch into a cond. * lisp/json.el (json-readtable): Remove. (json-readtable-dispatch): New macro. Assimilate json-readtable. (json-read): Use the macro. diff --git a/lisp/json.el b/lisp/json.el index 64486258cc..025a77d4b0 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -669,19 +669,22 @@ become JSON objects." ;;; JSON reader. -(defvar json-readtable +(defmacro json-readtable-dispatch (char) + "Dispatch reader function for CHAR." + (declare (debug (symbolp))) (let ((table '((?t json-read-keyword "true") (?f json-read-keyword "false") (?n json-read-keyword "null") (?{ json-read-object) (?\[ json-read-array) - (?\" json-read-string)))) - (mapc (lambda (char) - (push (list char 'json-read-number) table)) - '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) - table) - "Readtable for JSON reader.") + (?\" json-read-string))) + res) + (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)) + (push (list c 'json-read-number) table)) + (pcase-dolist (`(,c . ,rest) table) + (push `((eq ,char ,c) (,@rest)) res)) + `(cond ,@res (t (signal 'json-readtable-error ,char))))) (defun json-read () "Parse and return the JSON object following point. @@ -690,10 +693,7 @@ Advances point just past JSON object." (let ((char (json-peek))) (if (zerop char) (signal 'json-end-of-file nil) - (let ((record (cdr (assq char json-readtable)))) - (if (functionp (car record)) - (apply (car record) (cdr record)) - (signal 'json-readtable-error record)))))) + (json-readtable-dispatch char)))) ;; Syntactic sugar for the reader commit 132f4472f5f066948e69894bac8ff27430e82012 Author: Mark Oteiza Date: Sun Sep 3 20:42:01 2017 -0400 Hexify strings in EWW search queries Previously, inputting "cats & dogs" would lose dogs because the ampersand signifies a query parameter. Instead, hexify each word while preserving quotes with split-string. * lisp/net/eww.el (eww--dwim-expand-url): Join hexified words together with + separators, instead of replacing whitespace with +. diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 2fc36e180e..03d9172b65 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -297,7 +297,8 @@ word(s) will be searched for via `eww-search-prefix'." (when (string= (url-filename (url-generic-parse-url url)) "") (setq url (concat url "/")))) (setq url (concat eww-search-prefix - (replace-regexp-in-string " " "+" url)))))) + (mapconcat + #'url-hexify-string (split-string url) "+")))))) url) ;;;###autoload (defalias 'browse-web 'eww) commit 48116f91267cb35cdde0a1558c7cee47b6e3ff53 Author: Glenn Morris Date: Sun Sep 3 10:55:45 2017 -0700 emacsclient-tests: call-process may return non-integer * test/lib-src/emacsclient-tests.el (emacsclient-test-alternate-editor-allows-arguments) (emacsclient-test-alternate-editor-allows-quotes): Handle non-integer return from call-process. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index 91f1f1002d..61ead4f0f3 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -1,19 +1,21 @@ ;;; emacsclient-tests.el --- Test emacsclient -;; Copyright (C) 2016 Free Software Foundation, Inc. +;; Copyright (C) 2016-2017 Free Software Foundation, Inc. -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -42,7 +44,7 @@ (setenv "ALTERNATE_EDITOR" (concat (expand-file-name invocation-name invocation-directory) " --batch")) - (should (= 0 (emacsclient-test-call-emacsclient))))) + (should (eq 0 (emacsclient-test-call-emacsclient))))) (ert-deftest emacsclient-test-alternate-editor-allows-quotes () (let ((process-environment process-environment)) @@ -50,7 +52,7 @@ "\"" (expand-file-name invocation-name invocation-directory) "\"" " --batch")) - (should (= 0 (emacsclient-test-call-emacsclient))))) + (should (eq 0 (emacsclient-test-call-emacsclient))))) (provide 'emacsclient-tests) ;;; emacsclient-tests.el ends here commit 96c23a19fdcedad917109767b036104db7320f69 Author: Martin Rudalics Date: Sun Sep 3 19:27:52 2017 +0200 ; Drop note about tracing X protocol errors from a TTY based server * etc/DEBUG: Drop note about how to trace X protocol errors when a GUI client connects to a server running from a text terminal. diff --git a/etc/DEBUG b/etc/DEBUG index 3719c3e6f6..d7d6a0d238 100644 --- a/etc/DEBUG +++ b/etc/DEBUG @@ -622,6 +622,15 @@ Setting a breakpoint in the function 'x_error_quitter' and looking at the backtrace when Emacs stops inside that function will show what code causes the X protocol errors. +Note that the -xrm option may have no effect when you make an Emacs +process invoked with the -nw option a server and want to trace X +protocol errors from subsequent invocations of emacsclient in a GUI +frame. In that case calling the initial Emacs via + +emacs -nw --eval '(setq x-command-line-resources "emacs.synchronous: true")' + +should give more reliable results. + Some bugs related to the X protocol disappear when Emacs runs in a synchronous mode. To track down those bugs, we suggest the following procedure: commit 673e6d35acf45d8c115829757f863a788c9bd554 Author: Eli Zaretskii Date: Sun Sep 3 18:20:31 2017 +0300 * lisp/simple.el (visual-line-mode): Doc fix. (Bug#28337) diff --git a/lisp/simple.el b/lisp/simple.el index 27990bb661..ff0aa066b5 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6827,7 +6827,7 @@ other purposes." (defvar visual-line--saved-state nil) (define-minor-mode visual-line-mode - "Toggle visual line based editing (Visual Line mode). + "Toggle visual line based editing (Visual Line mode) in the current buffer. Interactively, with a prefix argument, enable Visual Line mode if the prefix argument is positive, and disable it otherwise. If called from Lisp, toggle commit 1b492fa5456e2b6face8d0856f11d17e432693b0 Author: Alan Third Date: Sun Sep 3 13:51:14 2017 +0100 Force screen update after drawing cursor glyph (bug#23774) * src/nsterm.m (ns_draw_window_cursor): Force a screen update after drawing the glyph over the cursor. diff --git a/src/nsterm.m b/src/nsterm.m index ff3329d1ce..6b0e18bf43 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3143,7 +3143,16 @@ Note that CURSOR_WIDTH is meaningful only for (h)bar cursors. /* draw the character under the cursor */ if (cursor_type != NO_CURSOR) - draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + { + draw_phys_cursor_glyph (w, glyph_row, DRAW_CURSOR); + +#ifdef NS_IMPL_COCOA + /* The glyph under the cursor isn't displayed when switching + spaces, so force an update. This seems to be related to the + use of NSDisableScreenUpdates. */ + [FRAME_NS_VIEW (f) setNeedsDisplay:YES]; +#endif + } #ifdef NS_IMPL_COCOA NSEnableScreenUpdates (); commit c8439abe22f1bb5e717f5c0f3725084c8d738155 Author: Alan Mackenzie Date: Sun Sep 3 11:01:21 2017 +0000 Correct the fontification of quote marks after buffer changes in CC Mode. * lisp/progmodes/cc-defs.el (c-search-forward-char-property-with-value-on-char): New macro. * lisp/progmodes/cc-mode.el (c-parse-quotes-before-change) (c-parse-quotes-after-change): Rewrite the functions, simplifying considerably, and removing unnecessary optimisations. Invalidate two caches after manipulating text properties. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index ab910ab7de..dda343d72e 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -1185,6 +1185,29 @@ been put there by c-put-char-property. POINT remains unchanged." ;; GNU Emacs `(c-clear-char-property-with-value-function ,from ,to ,property ,value))) +(defmacro c-search-forward-char-property-with-value-on-char + (property value char &optional limit) + "Search forward for a text-property PROPERTY having value VALUE on a +character with value CHAR. +LIMIT bounds the search. The value comparison is done with `equal'. +PROPERTY must be a constant. + +Leave point just after the character, and set the match data on +this character, and return point. If the search fails, return +nil; point is then left undefined." + `(let ((char-skip (concat "^" (char-to-string ,char))) + (-limit- ,limit) + (-value- ,value)) + (while + (and + (progn (skip-chars-forward char-skip -limit-) + (< (point) -limit-)) + (not (equal (c-get-char-property (point) ,property) -value-))) + (forward-char)) + (when (< (point) -limit-) + (search-forward-regexp ".") ; to set the match-data. + (point)))) + (defun c-clear-char-property-with-value-on-char-function (from to property value char) "Remove all text-properties PROPERTY with value VALUE on diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 48a6619bd1..663a51ca72 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1197,76 +1197,82 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") ;; ;; This function is called exclusively as a before-change function via the ;; variable `c-get-state-before-change-functions'. - (c-save-buffer-state (p-limit found) - ;; Special consideration for deleting \ from '\''. - (if (and (> end beg) - (eq (char-before end) ?\\) - (<= c-new-END end)) - (setq c-new-END (min (1+ end) (point-max)))) - - ;; Do we have a ' (or something like ',',',',',') within range of - ;; c-new-BEG? + (c-save-buffer-state () (goto-char c-new-BEG) - (setq p-limit (max (- (point) 2) (point-min))) - (while (and (skip-chars-backward "^\\\\'" p-limit) - (> (point) p-limit)) - (when (eq (char-before) ?\\) - (setq p-limit (max (1- p-limit) (point-min)))) - (backward-char) - (setq c-new-BEG (point))) + ;; We need to scan for 's from the BO (logical) line. (beginning-of-line) - (while (and - (setq found (search-forward-regexp "\\('\\([^'\\]\\|\\\\.\\)\\)*'" - c-new-BEG 'limit)) - (< (point) (1- c-new-BEG)))) - (if found - (setq c-new-BEG - (if (and (eq (point) (1- c-new-BEG)) - (eq (char-after) ?')) ; "''" before c-new-BEG. - (1- c-new-BEG) - (match-beginning 0)))) - - ;; Check for a number with quote separators straddling c-new-BEG - (when c-has-quoted-numbers - (goto-char c-new-BEG) - (when ;; (c-quoted-number-straddling-point) - (c-quoted-number-head-before-point) - (setq c-new-BEG (match-beginning 0)))) + (while (eq (char-before (1- (point))) ?\\) + (beginning-of-line 0)) + (while (and (< (point) c-new-BEG) + (search-forward "'" c-new-BEG t)) + (cond + ((c-quoted-number-straddling-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-BEG) + (setq c-new-BEG (match-beginning 0)))) + ((c-quoted-number-head-before-point) + (if (>= (point) c-new-BEG) + (setq c-new-BEG (match-beginning 0)))) + ((looking-at "\\([^'\\]\\|\\\\.\\)'") + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-BEG) + (setq c-new-BEG (1- (match-beginning 0))))) + ((or (>= (point) (1- c-new-BEG)) + (and (eq (point) (- c-new-BEG 2)) + (eq (char-after) ?\\))) + (setq c-new-BEG (1- (point)))) + (t nil))) - ;; Do we have a ' (or something like ',',',',...,',') within range of - ;; c-new-END? (goto-char c-new-END) - (setq p-limit (min (+ (point) 2) (point-max))) - (while (and (skip-chars-forward "^\\\\'" p-limit) - (< (point) p-limit)) - (when (eq (char-after) ?\\) - (setq p-limit (min (1+ p-limit) (point-max)))) - (forward-char) - (setq c-new-END (point))) - (if (looking-at "[^']?\\('\\([^'\\]\\|\\\\.\\)\\)*'") - (setq c-new-END (match-end 0))) - - ;; Check for a number with quote separators straddling c-new-END. - (when c-has-quoted-numbers - (goto-char c-new-END) - (when ;; (c-quoted-number-straddling-point) - (c-quoted-number-tail-after-point) - (setq c-new-END (match-end 0)))) - - ;; Remove the '(1) syntax-table property from all "'"s within (c-new-BEG + ;; We will scan from the BO (logical) line. + (beginning-of-line) + (while (eq (char-before (1- (point))) ?\\) + (beginning-of-line 0)) + (while (and (< (point) c-new-END) + (search-forward "'" c-new-END t)) + (cond + ((c-quoted-number-straddling-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + ((c-quoted-number-tail-after-point) + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + ((looking-at "\\([^'\\]\\|\\\\.\\)'") + (goto-char (match-end 0)) + (if (> (match-end 0) c-new-END) + (setq c-new-END (match-end 0)))) + (t nil))) + ;; Having reached c-new-END, handle any 's after it whose context may be + ;; changed by the current buffer change. + (goto-char c-new-END) + (cond + ((c-quoted-number-tail-after-point) + (setq c-new-END (match-end 0))) + ((looking-at + "\\(\\\\.\\|.\\)?\\('\\([^'\\]\\|\\\\.\\)\\)*'") + (setq c-new-END (match-end 0)))) + + ;; Remove the '(1) syntax-table property from any "'"s within (c-new-BEG ;; c-new-END). - (c-clear-char-property-with-value-on-char - c-new-BEG c-new-END - 'syntax-table '(1) - ?') - ;; Remove the c-digit-separator text property from the same "'"s. - (when c-has-quoted-numbers + (goto-char c-new-BEG) + (when (c-search-forward-char-property-with-value-on-char + 'syntax-table '(1) ?\' c-new-END) + (c-invalidate-state-cache (1- (point))) + (c-truncate-semi-nonlit-pos-cache (1- (point))) (c-clear-char-property-with-value-on-char - c-new-BEG c-new-END - 'c-digit-separator t - ?')))) - -(defun c-parse-quotes-after-change (_beg _end _old-len) + (1- (point)) c-new-END + 'syntax-table '(1) + ?') + ;; Remove the c-digit-separator text property from the same "'"s. + (when c-has-quoted-numbers + (c-clear-char-property-with-value-on-char + (1- (point)) c-new-END + 'c-digit-separator t + ?'))))) + +(defun c-parse-quotes-after-change (beg end old-len) ;; This function applies syntax-table properties (value '(1)) and ;; c-digit-separator properties as needed to 's within the range (c-new-BEG ;; c-new-END). This operation is performed even within strings and @@ -1277,25 +1283,34 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (c-save-buffer-state (num-beg num-end) ;; Apply the needed syntax-table and c-digit-separator text properties to ;; quotes. - (goto-char c-new-BEG) - (while (and (< (point) c-new-END) - (search-forward "'" c-new-END 'limit)) - (cond ((and (eq (char-before (1- (point))) ?\\) - ;; Check we've got an odd number of \s, here. - (save-excursion - (backward-char) - (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '. - ((c-quoted-number-straddling-point) - (setq num-beg (match-beginning 0) - num-end (match-end 0)) - (c-put-char-properties-on-char num-beg num-end - 'syntax-table '(1) ?') - (c-put-char-properties-on-char num-beg num-end - 'c-digit-separator t ?') - (goto-char num-end)) - ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression. - (goto-char (match-end 0))) - (t (c-put-char-property (1- (point)) 'syntax-table '(1))))))) + (save-restriction + (goto-char c-new-BEG) + (while (and (< (point) c-new-END) + (search-forward "'" c-new-END 'limit)) + (cond ((and (eq (char-before (1- (point))) ?\\) + ;; Check we've got an odd number of \s, here. + (save-excursion + (backward-char) + (eq (logand (skip-chars-backward "\\\\") 1) 1)))) ; not a real '. + ((c-quoted-number-straddling-point) + (setq num-beg (match-beginning 0) + num-end (match-end 0)) + (c-invalidate-state-cache num-beg) + (c-truncate-semi-nonlit-pos-cache num-beg) + (c-put-char-properties-on-char num-beg num-end + 'syntax-table '(1) ?') + (c-put-char-properties-on-char num-beg num-end + 'c-digit-separator t ?') + (goto-char num-end)) + ((looking-at "\\([^\\']\\|\\\\.\\)'") ; balanced quoted expression. + (goto-char (match-end 0))) + (t + (c-invalidate-state-cache (1- (point))) + (c-truncate-semi-nonlit-pos-cache (1- (point))) + (c-put-char-property (1- (point)) 'syntax-table '(1)))) + ;; Prevent the next `c-quoted-number-straddling-point' getting + ;; confused by already processed single quotes. + (narrow-to-region (point) (point-max)))))) (defun c-before-change (beg end) ;; Function to be put on `before-change-functions'. Primarily, this calls commit b733a910091c426de0d831f1ce0cda4ae736ab69 Author: Alan Mackenzie Date: Sun Sep 3 09:40:31 2017 +0000 Fix fontification of "operator~" in C++ Mode. * lisp/progmodes/cc-langs.el (c-ambiguous-overloadable-or-identifier-prefices) (c-ambiguous-overloadable-or-identifier-prefix-re): New c-lang-defconsts/vars. * lisp/progmodes/cc-engine.el (c-forward-name): Do not try to parse "~" (and two other symbols) as a cast without good evidence. Prefer an overloaded operator in ambiguous cases. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index bf95dc1e3c..5ac4a76933 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -7387,7 +7387,12 @@ comment at the start of cc-engine.el for more info." (setq pos (point) res subres)))) - ((looking-at c-identifier-start) + ((and (looking-at c-identifier-start) + (or (not (looking-at + c-ambiguous-overloadable-or-identifier-prefix-re)) + (save-excursion + (and (eq (c-forward-token-2) 0) + (not (eq (char-after) ?\()))))) ;; Got a cast operator. (when (c-forward-type) (setq pos (point) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 93e8df16c1..d4eae06f29 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -1185,6 +1185,24 @@ This regexp is assumed to not match any non-operator identifier." (make-obsolete-variable 'c-opt-op-identitier-prefix 'c-opt-op-identifier-prefix "CC Mode 5.31.4, 2006-04-14") +(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefices + ;; A list of strings which can be either overloadable operators or + ;; identifier prefixes. + t (c--intersection + (c-filter-ops (c-lang-const c-identifier-ops) + '(prefix) + t) + (c-lang-const c-overloadable-operators) + :test 'string-equal)) + +(c-lang-defconst c-ambiguous-overloadable-or-identifier-prefix-re + ;; A regexp matching strings which can be either overloadable operators + ;; or identifier prefixes. + t (c-make-keywords-re + t (c-lang-const c-ambiguous-overloadable-or-identifier-prefices))) +(c-lang-defvar c-ambiguous-overloadable-or-identifier-prefix-re + (c-lang-const c-ambiguous-overloadable-or-identifier-prefix-re)) + (c-lang-defconst c-other-op-syntax-tokens "List of the tokens made up of characters in the punctuation or parenthesis syntax classes that have uses other than as expression commit d577d1609c6c9d11b6af30a33e02bb21ffa821fd Author: Martin Rudalics Date: Sun Sep 3 11:30:16 2017 +0200 In delete_frame do not delete terminal for any toolkit build * src/frame.c (delete_frame): Neither delete terminal for non-GTK toolkit builds (Bug#5802, Bug#21509, Bug#23499, Bug#27816). diff --git a/src/frame.c b/src/frame.c index 5099f75be4..6e0c51b2f5 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2026,13 +2026,17 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* If needed, delete the terminal that this frame was on. (This must be done after the frame is killed.) */ terminal->reference_count--; -#ifdef USE_GTK +#if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* FIXME: Deleting the terminal crashes emacs because of a GTK bug. http://lists.gnu.org/archive/html/emacs-devel/2011-10/msg00363.html */ + + /* Since a similar behavior was observed on the Lucid and Motif + builds (see Bug#5802, Bug#21509, Bug#23499, Bug#27816), we now + don't delete the terminal for these builds either. */ if (terminal->reference_count == 0 && terminal->type == output_x_window) terminal->reference_count = 1; -#endif /* USE_GTK */ +#endif /* USE_X_TOOLKIT || USE_GTK */ if (terminal->reference_count == 0) { Lisp_Object tmp; commit 71766a45f1edb02ec5107803a7f7a8e17809b093 Author: Philipp Stephani Date: Sat Sep 2 21:08:04 2017 +0200 Improve error messages for improper plists (Bug#27726) * src/fns.c (Fplist_put, Flax_plist_get, Flax_plist_put) (Fplist_member, syms_of_fns): Use ‘plistp’ as pseudo-predicate for improper plists instead of ‘listp.’ * test/src/fns-tests.el (plist-get/odd-number-of-elements) (lax-plist-get/odd-number-of-elements) (plist-put/odd-number-of-elements) (lax-plist-put/odd-number-of-elements) (plist-member/improper-list): Add unit tests. diff --git a/src/fns.c b/src/fns.c index 00b6ed6a28..ef9a1758d6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2021,7 +2021,7 @@ The PLIST is modified by side effects. */) if (EQ (tail, li.tortoise)) circular_list (plist); } - CHECK_LIST_END (tail, plist); + CHECK_TYPE (NILP (tail), Qplistp, plist); Lisp_Object newcell = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev)))); if (NILP (prev)) @@ -2061,7 +2061,7 @@ one of the properties on the list. */) circular_list (plist); } - CHECK_LIST_END (tail, plist); + CHECK_TYPE (NILP (tail), Qplistp, plist); return Qnil; } @@ -2093,7 +2093,7 @@ The PLIST is modified by side effects. */) if (EQ (tail, li.tortoise)) circular_list (plist); } - CHECK_LIST_END (tail, plist); + CHECK_TYPE (NILP (tail), Qplistp, plist); Lisp_Object newcell = list2 (prop, val); if (NILP (prev)) return newcell; @@ -2858,7 +2858,7 @@ The value is actually the tail of PLIST whose car is PROP. */) if (EQ (tail, li.tortoise)) circular_list (tail); } - CHECK_LIST_END (tail, plist); + CHECK_TYPE (NILP (tail), Qplistp, plist); return Qnil; } @@ -5191,6 +5191,7 @@ Used by `featurep' and `require', and altered by `provide'. */); Fmake_var_non_special (Qfeatures); DEFSYM (Qsubfeatures, "subfeatures"); DEFSYM (Qfuncall, "funcall"); + DEFSYM (Qplistp, "plistp"); #ifdef HAVE_LANGINFO_CODESET DEFSYM (Qcodeset, "codeset"); diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e294859226..73c6593caf 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -547,4 +547,32 @@ (should-error (nconc (cyc1 1) 'tail) :type 'circular-list) (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list)) +(ert-deftest plist-get/odd-number-of-elements () + "Test that ‘plist-get’ doesn’t signal an error on degenerate plists." + (should-not (plist-get '(:foo 1 :bar) :bar))) + +(ert-deftest lax-plist-get/odd-number-of-elements () + "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726." + (should (equal (should-error (lax-plist-get '(:foo 1 :bar) :bar) + :type 'wrong-type-argument) + '(wrong-type-argument plistp (:foo 1 :bar))))) + +(ert-deftest plist-put/odd-number-of-elements () + "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726." + (should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2) + :type 'wrong-type-argument) + '(wrong-type-argument plistp (:foo 1 :bar))))) + +(ert-deftest lax-plist-put/odd-number-of-elements () + "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726." + (should (equal (should-error (lax-plist-put '(:foo 1 :bar) :zot 2) + :type 'wrong-type-argument) + '(wrong-type-argument plistp (:foo 1 :bar))))) + +(ert-deftest plist-member/improper-list () + "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726." + (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux) + :type 'wrong-type-argument) + '(wrong-type-argument plistp (:foo 1 . :bar))))) + (provide 'fns-tests) commit dbe1e55dc4064e82813f6b84ee4297d8fc45b2fc Author: Eli Zaretskii Date: Sat Sep 2 13:02:10 2017 +0300 Fix decrypting in plstore.el on MS-Windows * lisp/plstore.el (plstore-open): Bind coding-system-for-read to raw-text, instead of using insert-file-contents-literally. (Bug#28114) diff --git a/lisp/plstore.el b/lisp/plstore.el index b9025433b1..26c53b3e61 100644 --- a/lisp/plstore.el +++ b/lisp/plstore.el @@ -212,7 +212,8 @@ symmetric encryption will be used." (with-current-buffer buffer (erase-buffer) (condition-case nil - (insert-file-contents-literally file) + (let ((coding-system-for-read 'raw-text)) + (insert-file-contents file)) (error)) (setq buffer-file-name (file-truename file)) (set-buffer-modified-p nil) commit f529fc1570e4157c1ecbf4aa1ab5de60efdd5ca7 Author: Eli Zaretskii Date: Sat Sep 2 12:57:30 2017 +0300 * src/fileio.c (Fexpand_file_name): Doc fix. (Bug#27982) diff --git a/src/fileio.c b/src/fileio.c index bbd1a4ef69..0a52982291 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -755,7 +755,9 @@ For technical reasons, this function can return correct but non-intuitive results for the root directory; for instance, \(expand-file-name ".." "/") returns "/..". For this reason, use \(directory-file-name (file-name-directory dirname)) to traverse a -filesystem tree, not (expand-file-name ".." dirname). */) +filesystem tree, not (expand-file-name ".." dirname). Note: make +sure DIRNAME in this example doesn't end in a slash, unless it's +the root directory. */) (Lisp_Object name, Lisp_Object default_directory) { /* These point to SDATA and need to be careful with string-relocation commit c89f3ff3dc6c744c71808c40dc52c61979c57a4b Author: Eli Zaretskii Date: Sat Sep 2 12:37:51 2017 +0300 Rewrite Antinews for Emacs 26 * doc/lispref/anti.texi (Antinews): Rewrite for Emacs 26. * doc/lispref/elisp.texi (Top): Update the top-level menu's Antinews entry. * doc/emacs/anti.texi (Antinews): Rewrite for Emacs 26. * doc/emacs/emacs.texi (Top): Update the top-level menu's Antinews entry. * etc/NEWS: Rearrange some entries in a more reasonable order. diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi index 87cbe439e0..ffec915cb1 100644 --- a/doc/emacs/anti.texi +++ b/doc/emacs/anti.texi @@ -4,215 +4,167 @@ @c See file emacs.texi for copying conditions. @node Antinews -@appendix Emacs 24 Antinews +@appendix Emacs 25 Antinews @c Update the emacs.texi Antinews menu entry with the above version number. For those users who live backwards in time, here is information -about downgrading to Emacs version 24.5. We hope you will enjoy the -greater simplicity that results from the absence of many Emacs -@value{EMACSVER} features. +about downgrading to Emacs version 25.2. We hope you will enjoy the +greater simplicity that results from the absence of many @w{Emacs +@value{EMACSVER}} features. @itemize @bullet @item -Support for Cairo drawing has been removed. On GNU and Unix systems, -you now have only one drawing engine---the venerable X Window system. -No need to procrastinate on the dilemma whether you do or don't want -the new shiny Cairo thing. Hail, simplicity! - -@item -Emacs still works on SGI IRIX systems. If you live backwards in time, -this is actually a bonus, as IRIX systems will become more and more -popular as you move farther back in time. - -@item -Support for dynamically loaded modules has been removed. You get to -use only the trusted Emacs codebase, with no additions. Those -external modules written by some J.R. Hacker cannot be trusted anyway. -Good riddance! - -@item -We have greatly simplified the Emacs features which access the network -by removing the Network Security Manager. No more annoying prompts -about trusting this or that site or page---you asked for it, you get -it, no questions asked! You, the user, are now in charge of any -security issues related to sites whose certificates expired or didn't -exist in the first place. Giving the user the utmost freedom was and -always will be the most important goal of Emacs development. We keep -that goal even as we develop Emacs back in time. - -@item -We made the output of @kbd{C-h l} much simpler and easier to grasp by -removing the names of commands run by the recorded keystrokes. True -Emacs lovers know their bindings by heart anyway, so why waste -precious screen estate on that which is well known? - -@item -Selection- and clipboard-related commands and variables got their -historical names back. It's now the definitive -@code{x-select-enable-clipboard} again instead of the vague -@code{select-enable-clipboard}, and all those @code{gui-select-text}, -@code{gui-get-primary-selection}, etc.@: got their @code{x-*} names -back. (What's a ``GUI'', anyway?) The only true window system with -selections is the X Window system, so we stopped pretending that other -platforms have anything similar to that. You now know when you invoke -a command that accesses X. - -@item -Passwords are no longer hidden when typed in @code{-batch} mode. It -was a misfeature to have it not shown in the first place: who can type -without seeing what they type? We couldn't convince the users of GUI -sessions to give up hiding the password, so we at least made it -visible in batch mode, which is something every veteran Emacs user -uses all the time. Stay tuned for un-hiding the password in GUI -sessions as well as we downgrade progressively to previous Emacs -versions. - -@item -The nuisance with Unicode characters popping up all over the place has -been amply dealt with. We've removed @kbd{C-x 8} shorthands for -characters such as ‘, ’, “, ”, €, ≤, and many others; as a nice -benefit, this removes many useless entries at the beginning of the -@kbd{C-h b} output. The @code{electric-quote-mode} has been deleted, -so there's only the one true quoting method now---using the -plain-@acronym{ASCII} quote characters. And if that's not enough, the -doc strings and other messages show text quoted @t{`like this'} -as they were written, instead of arbitrarily replacing them -with Unicode ``curved quote'' characters @t{‘like this’}. The -@code{text-quoting-style} variable becomes therefore unneeded and was -removed. As result, text produced by Emacs can be sent to those -venerable teletypes again, yeah! - -For the same reasons, the character classes @code{[:alpha:]} and -@code{[:alnum:]} again match any word-constituent character, and -@code{[:graph:]} and @code{[:print:]} match every multibyte character. -Confusing use of Unicode character properties is gone. - -@item -I-search and query-replace no longer try to confuse you by using the -``character-folding'' magic. They will no longer find any characters -you didn't actually type, like find @kbd{ⓐ} when you actually typed -@kbd{a}. Users who want to find some fancy character will have to -type it explicitly. - -@item -The @file{desktop.el} package no longer records window and frame -configuration, and doesn't attempt to restore them. You now have back -your freedom of re-arranging your windows and frames anew each time -you restore a session. This made the new backward-incompatible format -of the @file{.emacs.desktop} file unnecessary, so the format was -reverted back to what it was before Emacs 25. You can now again use -the desktop file with all the previous versions of Emacs. - -@item -We have reworked the Prettify Symbols mode to support only the default -@code{prettify-symbols-compose-predicate}. No need to consider -whether your major or minor mode needs its own prettifications; just -use what came with Emacs. We also removed the -@code{prettify-symbols-unprettify-at-point} option: once prettified, -always prettified! These changes make the Prettify Symbols mode quite -a lot simpler and easier to use. +Emacs no longer defaults to requiring the GnuTLS library when you +build it. Those who want the TLS functionality built-in will have to +explicitly request it at build time---or forever hold their peace. We +decided that having the TLS functionality doesn't justify annoying +users or package builders with error messages about libgnutls absence. +We also decided that if you do build with GnuTLS, we will allow +versions of the library older than 2.12.2, as that version will become +less and less available/popular as you move farther back in time. @item -Support for nifty new features of xterm, such as access to the X -selection and the clipboard, the ``bracketed paste mode'', and other -advanced capabilities has been removed. When you kill text in an -xterm Emacs session, that text is only saved in the Emacs kill ring, -without letting other applications have any way of accessing it. An -xterm is just a text terminal, nothing more, nothing less. There -should be no feature we support on xterm that isn't supported on bare -console terminals. For the same reasons, support for mouse-tracking -on xterm was removed. We will continue this line of simplifications -as we downgrade to previous versions of Emacs; stay tuned. +For similar reasons, we've reverted back to building our own version +of of @command{movemail} that retrieves POP3 mail as clear text via +insecure channels. As you move back in time, the availability of +secure alternatives to POP3 will diminish, and we are only keen to +support that. We've also removed the @option{--with-mailutils} +configure-time option, as it no longer makes sense for the observable +past. -@item -Various features in @file{package.el} have been simplified. The -``external'' package status is no longer available. A package present -on multiple archives will now be listed as many times as it is found: -we don't believe in concealing any information from the users. This -and other similar simplifications made -@code{package-menu-toggle-hiding} unnecessary, since there's nothing -to unhide now. - -@item -The @kbd{@key{UP}} and @kbd{@key{DOWN}} keys in the minibuffer have -been simplified to move by history items. No need to wonder whether -you have moved to the next/previous item or to another line within the -same item. Well-written commands shouldn't allow too long history -entries anyway; be sure to report any that do as bugs, so that we -could fix them in past versions of Emacs. - -@item -The VC mode was simplified by removing the support for ``push'' -commands. Moving back in time means you will have less and less need -to use modern version control systems such as Git, Bazaar, and -Mercurial, so the necessity of using ``push'' commands will gradually -disappear. We removed it from Emacs in advance, so that you won't -need to un-learn it when this command disappears, as it should. - -@item -The support for full C/C++ expressions in macros has been removed from -Hide-Ifdef mode. It now supports only the basic literal macros. As -result, the user interface was simplified, and a number of useless -commands have been removed from Hide-Ifdef mode. Further -simplifications were made possible by removing support for some fancy -new preprocessor directives, such as @code{#if defined}, @code{#elif}, -etc. - -@item -We have reverted to Etags for looking up definitions of functions, -variables, etc. Commands such as @kbd{M-.} use tags tables, as they -always have. This allowed the removal of the entire @file{xref.el} -package and its many metastases in the other Emacs packages and -commands, significantly simplifying those. No more complexities with -the various ``backends'' that provide incoherent behavior that is hard -to explain and remember; either the symbol is in TAGS or it isn't. No -more new user interfaces we never before saw in Emacs, either; if you -want the next definition for the symbol you typed, just invoke -@kbd{C-u M-.}---what could be simpler? As a nice side effect, you get -to use your beloved @code{tags-loop-continue} and @code{pop-tag-mark} -commands and their memorable bindings. The @file{package.el} package -has been removed for similar reasons. +@item +We have removed support for @command{systemd} and similar services: we +no longer provide a user init file for enabling Emacs support via +those services, and we removed from the Emacs server the +socket-launching support important for Emacs client operation under +these services. Again, these services will lose popularity as you +move back in time, so the code supporting them will be just dead code, +bloating Emacs unnecessarily. + +@item +Reproducible builds of Emacs are no longer supported, as past +development will make that unnecessary. + +@item +The @option{--fg-daemon} is gone, leaving only @option{--daemon}. No +need to procrastinate on the dilemma whether you do or don't want the +new shiny ``headless Emacs'' thingy. Hail, simplicity! + +@item +As text terminals supporting true color will lose ground as you move +back in time, we've removed support for 24-bit colors on text +terminals. If you want colors on a text terminal, you should be fine +with just 8 of them. (Truth being told, we think text terminals +should be monochrome, but you will have to keep downgrading to older +Emacs versions to have that feature back.) + +@item +Emacs 25.2 no longer supports magic signatures of the form +@samp{#!/usr/bin/env @var{interpreter}} in scripts. Moving back in +time means you are getting closer to the ideal of the original Unix +design where all the interpreters lived in a single directory +@file{/bin}, so this fancy feature is simply becoming unnecessary +ballast. + +@item +The double-buffering feature of Emacs display on X has been removed. +We decided that its complexity and a few random surprising +side-effects aren't justified by the gains, even though those gains +were hailed in some quarters. Yes, Emacs 25.2 will flicker in some +use cases, but we are sure Emacs users will be able to suck it, a they +have been doing for years. Since this feature is gone, we've also +removed the @code{inhibit-double-buffering} frame parameter, which is +now unnecessary. + +@item +Non-breaking hyphens and ASCII characters displayed instead of +unsupported quote characters are now again displayed using the +@code{escape-glyph} face. We think having a single face instead of 3 +different ones will make Emacs customization a much simpler job for +users. For the same reason, we've removed the +@code{header-line-highlight} face, leaving just @code{highlight} for +any element of the Emacs display besides the mode line. + +@item +You can no longer disable attempts of recovery from fatal exceptions +such as C stack overflows and fatal signals. Since the recovery +included in Emacs is reliable enough, we decided there was no reason +to put your edits in danger of becoming lost when these situations +happen. The variables @code{'attempt-stack-overflow-recovery} and +@code{attempt-orderly-shutdown-on-fatal-signal} are therefore removed. + +@item +The @code{timer-list} command was removed, as we decided timers are +not user-level feature, and therefore users should not be allowed to +mess with them. Ask an Emacs Lisp guru near you for help if you have +a runaway timer in your session. (Of course, as you move back in +time, such runaway timers will become less and less frequent, and +actually timers might start shutting down automatically, as they +cannot cope with time reversal.) + +@item +Horizontal scrolling using the mouse or touchpad has been removed. In +the past, wide monitors will become less popular, so horizontal +scrolling will no longer be needed. Removal of the mouse support for +horizontal scrolling is the first step towards its complete removal in +prior Emacs versions. + +@item +We have found the @option{--tramp} option of @command{emacsclient} too +risky and too complicated, so we removed it to simplify the client +code and its usage. + +@item +The @code{display-raw-bytes-as-hex} variable is gone, so raw bytes can +only be displayed as octal escapes. Emacs users should be able to +convert from octal to any other base in their sleep! @item -@code{(/ @var{n})} once again yields just @var{n}. Emacs Lisp is not -Common Lisp, so compatibility with CL just complicates Emacs here. +Displaying line numbers for a buffer is only possibly using add-on +features, such as @code{linum-mode}, which can only display the +numbers in the display margins. Line-number display using these +features is also slow, as we firmly believe such a feature is +un-Emacsy and should not have been included in Emacs to begin with. +Consequently, @code{display-line-numbers-mode} was removed. @item -The functions @code{filepos-to-bufferpos} and -@code{bufferpos-to-filepos} have been removed. Code that needs to -find a file position by a buffer position or vice versa should adapt -by reading the file with no conversions and counting bytes while -comparing text. How hard can that be? +On our permanent quest for simplifying Emacs, we've removed the +support for passing command-line arguments and options to Emacs via +the @option{--alternate-editor} option of @command{emacsclient} and +@env{ALTERNATE_EDITOR} environment variable. There's only one True +Emacs---the one that comes up when invoked as @kbd{emacs}, no need for +all those fancy options! @item -We saw no need for the @code{make-process} primitive, so we removed -it. The @code{start-process} primitive provides all the functionality -one needs, so adding more APIs just confuses users. +The complication known as ``single-line horizontal scrolling'' is no +longer with you in Emacs 25.2. This feature was a bow to ``other +editors''; instead, let those other editors bow to Emacs by hscrolling +the entire window at all times. Repeat after me: ``The Emacs way is +the Only Way!'' @item -The functions @code{bidi-find-overridden-directionality} and -@code{buffer-substring-with-bidi-context} were removed, in preparation -for removing the whole bidi support when downgrading to Emacs 23. +The fancy case conversions of non-ASCII characters used in several +locales, like Turkish and Greek, are removed, leaving the relations +between upper and lower letter-case simple again, as they were in +7-bit ASCII. Likewise with ligatures that turn into multiple +characters when their letter-case changes---gone. @item -Horizontal scroll bars are no longer supported. Enlarge your windows -and frames instead, or use @code{truncate-lines} and the automatic -horizontal scrolling of text that Emacs had since time immemorial. +Enchant is no longer supported by @code{ispell-buffer} and similar +spell-checking commands. As Enchant will gradually disappear while +you move back in time, its support will become unnecessary anyway. @item -Emacs is again counting the height of a frame's menu and its tool bar -in the frame's text height calculations. This makes Emacs invocation -on different platforms and with different toolkits less predictable -when frame geometry parameters are given on the Emacs command line, -thus making Emacs more adventurous and less boring to use. +Tramp lost its support for Google Drive repositories. Cloud storage +is on its way to extinction as you move back in time, thus making this +feature redundant. @item -The @command{etags} program no longer supports Ruby and Go languages. -You won't need that as you progressively travel back in time towards -the time before these languages were invented. We removed support for -them in anticipation for that time. +Several commands, deemed to be unnecessary complications, have been +removed. Examples include @code{replace-buffer-contents} and +@code{apropos-local-variable}. @item To keep up with decreasing computer memory capacity and disk space, many -other functions and files have been eliminated in Emacs 24.5. +other functions and files have been eliminated in Emacs 25.2. @end itemize diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index f3e6c94e27..1f60354061 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -222,7 +222,7 @@ Appendices * GNU Free Documentation License:: The license for this documentation. * Emacs Invocation:: Hairy startup options. * X Resources:: X resources for customizing Emacs. -* Antinews:: Information about Emacs version 24. +* Antinews:: Information about Emacs version 25. * Mac OS / GNUstep:: Using Emacs under Mac OS and GNUstep. * Microsoft Windows:: Using Emacs on Microsoft Windows and MS-DOS. * Manifesto:: What's GNU? Gnu's Not Unix! diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi index 02d08ebc01..fc14c8cfca 100644 --- a/doc/lispref/anti.texi +++ b/doc/lispref/anti.texi @@ -6,110 +6,158 @@ @c This node must have no pointers. @node Antinews -@appendix Emacs 24 Antinews +@appendix Emacs 25 Antinews @c Update the elisp.texi Antinews menu entry with the above version number. For those users who live backwards in time, here is information about -downgrading to Emacs version 24.5. We hope you will enjoy the greater -simplicity that results from the absence of many Emacs @value{EMACSVER} -features. +downgrading to Emacs version 25.2. We hope you will enjoy the greater +simplicity that results from the absence of many @w{Emacs +@value{EMACSVER}} features. -@section Old Lisp Features in Emacs 24 +@section Old Lisp Features in Emacs 25 @itemize @bullet @item -The requirement that @code{setq} and @code{setf} must be called with -an even number of arguments has been removed. You can now call them -with an odd number of arguments, and Emacs will helpfully supply a -@code{nil} for the missing one. Simplicity rules! +The concurrency features have been removed. Even in its limited +``mostly cooperative'' form, with only one Lisp thread running at any +given time, it made Emacs significantly more complex for Lisp programs +that need to work correctly in the presence of additional threads. @item -@kbd{M-x shell} and @kbd{M-x compile} set the @env{EMACS} environment -variable, as they should, to indicate that the subprocess is run by -Emacs. This is so packages that took years to learn how to work -around that setting could continue using their code to that effect. +Handling of file attributes has been simplified by discarding the +accessor functions, such as @code{file-attribute-type} and +@code{file-attribute-modification-time}. Real Lisp programmers always +access the individual attributes by their ordinal numbers, and can +recite those numbers in their sleep. @item -The @code{save-excursion} form saves and restores the mark, as -expected. No more need for the new @code{save-mark-and-excursion}, -which has been deleted. +The networking code is back at its pristine simplicity, as we deleted +the use of asynchronous DNS resolution, connection, and TLS +negotiation for TLS streams. You no longer need to consider the +resulting complexity and interesting race conditions when you write +Lisp programs that use network communications. As a direct +consequence, the @code{:complete-negotiation} parameter of +@code{gnutls-boot} has become unnecessary, and was removed---just one +example of how removal of asynchronicity simplifies Emacs. @item -We have removed the @code{text-quoting-style} variable and the -associated functionality that translates quote characters in messages -displayed to the user and in help buffers. Emacs now shows exactly -the same quote characters as you wrote in your code! Likewise, -@code{substitute-command-keys} leaves the quote characters alone. As -you move back in time, Unicode support becomes less and less -important, so no need to display those fancy new quotes the Unicode -Standard invented. +We've removed the @file{puny.el} library, so Web sites with +non-@acronym{ASCII} URLs are no longer easily accessible. But such +sites become more and more rare as you move back in time, so having a +specialized library for their support was deemed an unnecessary +maintenance burden. + +@item +Field numbers like @samp{%2$} in format specifiers are no longer +available. We decided that their use makes code reading and +comprehension much harder, and that having them is unjustified in the +past where similar features in popular C libraries will also be gone. + +@item +Since the built-in capability to display line numbers has been removed +(@pxref{Antinews,,, emacs, The GNU Emacs Manual}), we've also deleted +the @code{line-number-display-width} function and the support for the +@code{display-line-numbers-disable} property, as Lisp programs that do +their own display layout decisions no longer need to cater to this +tricky feature. @item Regular expressions have been simplified by removing support for -Unicode character properties in regexp classes. As result, -@code{[:alpha:]} and @code{[:alnum:]} will match any character with a -word syntax, and @code{[:graph:]} and @code{[:print:]} will match any -multibyte character, including surrogates and unassigned codepoints. -Once again, this is in line with diminishing importance of Unicode as -you move back in time. +Unicode character properties in the @code{[:blank:]} regexp class. As +result, this class will match only spaces and tabs. Once again, this +is in line with diminishing importance of Unicode as you move back in +time. + +@item +For similar reasons, we removed the function @code{char-from-name}. +It should be easy enough to access the full list of Unicode characters +returned by @code{ucs-names} instead, for as long as Unicode support +in Emacs exists (which shouldn't be too long). + +@item +Various functions that accept file names as arguments, such as +@code{file-attributes}, @code{file-symlink-p}, and +@code{make-symbolic-link} gained back the special support for file +names quoted with @samp{/:}, and they now interpret @samp{~} in +symlink targets as you'd expect: to mean your home directory. The +confusing differences between the operation of these functions in +interactive and non-interactive invocations has been removed. + +@item +The function @file{assoc} has been simplified by removing its third +optional argument. It now always uses @code{equal} for comparison. +Likewise, @code{alist-get} always uses @code{assq}, and @code{map-get} +and @code{map-put} always use @code{eql} for their comparisons. + +@item +GnuTLS cryptographic functions are no longer available in Emacs. We +have decided that the needs for such functionality are deteriorating, +and their cumbersome interfaces make them hard to use. + +@item +We have removed support for records of user-defined types, and +@code{cl-defstruct} no longer uses records. This removes the +potential for quite a few places where existing and past code could be +broken by records. + +@item +You can again use @code{string-as-unibyte}, +@code{string-make-multibyte}, and other similar functions, without +being annoyed by messages about their deprecation. This is in +preparation for removal of multibyte text from Emacs in the distance +past. @item -Evaluating @samp{(/ @var{n})} will now yield @var{n}. We have -realized that interpreting that as in Common Lisp was a bad mistake -that needed to be corrected. +The function @code{read-color} no longer displays color names using +each color as the background. We have determined that this surprises +users and produces funny inconsistent results on color-challenged +terminals. @item -The @code{pcase} form was significantly simplified by removing the -UPatterns @code{quote} and @code{app}. To further simplify this -facility, we've removed @code{pcase-defmacro}, since we found no need -for letting Lisp programs define new UPatterns. +We removed the function @code{file-name-case-insensitive-p}, as +testing for the OS symbol should be enough for the observable past to +come, and learning to use yet another API is a burden. @item -We've removed the text properties @code{cursor-intangible} and -@code{cursor-sensor-functions}, replacing them by the much simpler -@code{intangible}, @code{point-entered}, and @code{point-left} -properties. The latter are implemented on a much lower level, and -therefore are better integrated with user expectations. For similar -reasons, @code{cursor-intangible-mode} and @code{cursor-sensor-mode} -were removed; use the hook variable @code{inhibit-point-motion-hooks} -which is no longer obsolete. +The function @code{read-multiple-choice} is also gone, in recognition +of the fact that nothing makes Emacs Lisp hacker rejoice more than the +need to sit down and write yet another interactive question-and-answer +function, and make it optimal for each specific case. @item -Process creation and management functions were significantly improved -and simplified by removing @code{make-process} and the @code{pipe} -connection type. Redirecting @code{stderr} of a subprocess should be -done with shell facilities, not by Emacs. +The function @code{add-variable-watcher} and the corresponding +debugger command @code{debug-on-variable-change} have been removed. +They make debugging more complicated, while examining the value of a +variable at each stop point is easy enough to cover the same use +cases. Let simplicity rule! @item -We decided that shutting up informative messages is bad for user -interaction, so we've removed the @code{inhibit-message} variable -which could be used to that effect. +The function @code{mapcan} is gone; use @code{mapcar} instead, and +process the resulting list as you see fit. @item -Support for generators and for finalizers has been removed, as we -found no real need for these facilities. +You can once again write a Lisp program that returns funny random +values from @code{file-attributes} by having another process alter the +filesystem while Emacs is accessing the file. This can give rise to +some interesting applications in the near past. @item -Due to excessive complexity and the diminishing need for Unicode -support, the functions @code{string-collate-lessp} and -@code{string-collate-equalp} were removed. Their locale-independent -counterparts @code{string-lessp} and @code{string-equal} are so much -more simple and yield predictable results that we don't see any -situation where the locale-dependent collation could be useful in -Emacs. As result, the @file{ls-lisp.el} package sorts files in a -locale-independent manner. +We have removed the functions @code{file-name-quote}, +@code{file-name-unquote}, and @code{file-name-quoted-p}. Writing code +that checks whether a file name is already quoted is easy, and doubly +quoting a file name should not produce any problems for well-written +Lisp code. @item -In preparation for removal in some past version of Emacs of the -bidirectional editing support, we started by deleting two functions -@code{bidi-find-overridden-directionality} and -@code{buffer-substring-with-bidi-context}. +Frame parameters like @code{z-group}, @code{min-width}, +@code{parent-frame}, @code{delete-before}, etc. have been removed. +Emacs should not replace your window-manager, certainly not as +window-managers become less and less capable. @item -Time conversion functions, such as @code{current-time-string}, no -longer accept an optional @var{zone} argument. If you need to change -the current time zone (why?), do that explicitly with -@code{set-time-zone-rule}. +We decided that the format of mode line and header line should be +customizable only based on buffers; the @code{mode-line-format} and +@code{header-line-format} window parameters have been removed. @item As part of the ongoing quest for simplicity, many other functions and diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index f30d9f95e2..b1399cdbd1 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -230,7 +230,7 @@ To view this manual in other formats, click Appendices -* Antinews:: Info for users downgrading to Emacs 24. +* Antinews:: Info for users downgrading to Emacs 25. * GNU Free Documentation License:: The license for this documentation. * GPL:: Conditions for copying and changing GNU Emacs. * Tips:: Advice and coding conventions for Emacs Lisp. diff --git a/etc/NEWS b/etc/NEWS index be95504cfd..2b0c86d7af 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -65,9 +65,9 @@ need to copy the emacs.service file to eg ~/.config/systemd/user/) Emacs that is more likely to be reproducible; that is, if you build and install Emacs twice, the second Emacs is a copy of the first. Deterministic builds omit the build date from the output of the -emacs-version and erc-cmd-SV functions, and the leave the following -variables nil: emacs-build-system, emacs-build-time, -erc-emacs-build-time. +'emacs-version' and 'erc-cmd-SV' functions, and the leave the +following variables nil: 'emacs-build-system', 'emacs-build-time', +'erc-emacs-build-time'. ** The configure option '--with-gameuser' now defaults to 'no', as this appears to be the most common configuration in practice. @@ -108,11 +108,6 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 -+++ -** The function 'assoc' now takes an optional third argument 'testfn'. -This argument, when non-nil, is used for comparison instead of -'equal'. - --- ** New variable 'executable-prefix-env' for inserting magic signatures. This variable affects the format of the interpreter magic number @@ -126,10 +121,6 @@ so the default behavior is not changed. ** The variable 'emacs-version' no longer includes the build number. This is now stored separately in a new variable, 'emacs-build-number'. -+++ -** The new function 'mapbacktrace' applies a function to all frames of -the current stack trace. - +++ ** Emacs now provides a limited form of concurrency with Lisp threads. Concurrency in Emacs Lisp is "mostly cooperative", meaning that @@ -143,10 +134,6 @@ buffer and its own match data. See the chapter "Threads" in the ELisp manual for full documentation of these facilities. -+++ -** The new function 'file-name-case-insensitive-p' tests whether a -given file is on a case-insensitive filesystem. - +++ ** The new user variable 'electric-quote-chars' provides a list of curved quotes for 'electric-quote-mode', allowing user to choose @@ -272,20 +259,6 @@ part of minibuffers. ** 'find-library' now takes a prefix argument to pop to a different window. -+++ -** Several accessors for the value returned by 'file-attributes' -have been added. They are: 'file-attribute-type', -'file-attribute-link-number', 'file-attribute-user-id', -'file-attribute-group-id', 'file-attribute-access-time', -'file-attribute-modification-time', -'file-attribute-status-change-time', 'file-attribute-size', -'file-attribute-modes', 'file-attribute-inode-number', -'file-attribute-device-number' and 'file-attribute-collect'. - -+++ -** The new function 'buffer-hash' computes a fast, non-consing hash of -a buffer's contents. - --- ** 'fill-paragraph' no longer marks the buffer as changed unless it actually changed something. @@ -336,13 +309,6 @@ These variables are for users who would like to avoid the small probability of data corruption due to techniques Emacs uses to recover in these situations. -+++ -** 'interrupt-process' now consults the list 'interrupt-process-functions', -to determine which function has to be called in order to deliver the -SIGINT signal. This allows Tramp to send the SIGINT signal to remote -asynchronous processes. The hitherto existing implementation has been -moved to 'internal-default-interrupt-process'. - +++ ** File local and directory local variables are now initialized each time the major mode is set, not just when the file is first visited. @@ -359,16 +325,12 @@ see the node "Connection Local Variables" in the ELisp manual. --- ** International domain names (IDNA) are now encoded via the new -puny.el library, so that one can visit web sites with non-ASCII URLs. +puny.el library, so that one can visit Web sites with non-ASCII URLs. +++ ** The new 'timer-list' command lists all active timers in a buffer, where you can cancel them with the 'c' command. -+++ -** The new function 'read-multiple-choice' prompts for multiple-choice -questions, with a handy way to display help texts. - +++ ** 'switch-to-buffer-preserve-window-point' now defaults to t. @@ -455,10 +417,6 @@ display of raw bytes from octal to hex. ** You can now provide explicit field numbers in format specifiers. For example, '(format "%2$s %1$s" "X" "Y")' produces "Y X". ---- -** 'comment-indent-function' values may now return a cons to specify a -range of indentation. - +++ ** Emacs now supports optional display of line numbers in the buffer. This is similar to what linum-mode provides, but much faster and @@ -1289,18 +1247,62 @@ variable 'x-gtk-use-window-move'. The variable is now obsolete. * Lisp Changes in Emacs 26.1 +++ -** New optional argument TEXT in 'make-temp-file'. - ---- -** New function `define-symbol-prop'. +** The function 'assoc' now takes an optional third argument TESTFN. +This argument, when non-nil, is used for comparison instead of +'equal'. +++ ** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. +If non-nil, the argument specifies a function to use for comparison, +instead of, respectively, 'assq' and 'eql'. +++ ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. ++++ +** The new function 'mapbacktrace' applies a function to all frames of +the current stack trace. + ++++ +** The new function 'file-name-case-insensitive-p' tests whether a +given file is on a case-insensitive filesystem. + ++++ +** Several accessors for the value returned by 'file-attributes' +have been added. They are: 'file-attribute-type', +'file-attribute-link-number', 'file-attribute-user-id', +'file-attribute-group-id', 'file-attribute-access-time', +'file-attribute-modification-time', +'file-attribute-status-change-time', 'file-attribute-size', +'file-attribute-modes', 'file-attribute-inode-number', +'file-attribute-device-number' and 'file-attribute-collect'. + ++++ +** The new function 'buffer-hash' computes a fast, non-consing hash of +a buffer's contents. + ++++ +** 'interrupt-process' now consults the list 'interrupt-process-functions', +to determine which function has to be called in order to deliver the +SIGINT signal. This allows Tramp to send the SIGINT signal to remote +asynchronous processes. The hitherto existing implementation has been +moved to 'internal-default-interrupt-process'. + ++++ +** The new function 'read-multiple-choice' prompts for multiple-choice +questions, with a handy way to display help texts. + +--- +** 'comment-indent-function' values may now return a cons to specify a +range of indentation. + ++++ +** New optional argument TEXT in 'make-temp-file'. + +--- +** New function `define-symbol-prop'. + ** Checksum/Hash +++ commit 2b91b841b23a17884b5da63dea27604496a93b67 Author: Reuben Thomas Date: Fri Sep 1 23:41:36 2017 +0100 Fix a mis-binding in a test * test/lisp/progmodes/python-tests.el (python-shell-calculate-process-environment-3): Fix binding of process-environment. A level of parens was missing. This was found after Glenn Morris noticed a similar problem with the patch for Bug#28319. diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 4b022fc815..57e40ff640 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2561,7 +2561,7 @@ if x: "Test `python-shell-virtualenv-root' modification." (let* ((python-shell-virtualenv-root "/env") (process-environment - (let (process-environment process-environment) + (let ((process-environment process-environment)) (setenv "PYTHONHOME" "/home") (setenv "VIRTUAL_ENV") (python-shell-calculate-process-environment)))) commit 6c995e4194d016fa8959acffd5787da4d3032f05 Author: Reuben Thomas Date: Fri Sep 1 23:38:31 2017 +0100 Fix a mis-binding and a bad defun name in a test (Bug#28319) test/lib-src/emacs-client-tests.el (call-emacsclient): Rename emacsclient-test-call-emacsclient. (emacsclient-test-alternate-editor-allows-arguments) (emacsclient-test-alternate-editor-allows-quotes): Fix let-binding of process-environment. Thanks to Glenn Morris for noticing these errors. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index e454e2825e..91f1f1002d 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -31,26 +31,26 @@ "lib-src")) "Path to emacsclient binary in build tree.") -(defun call-emacsclient () +(defun emacsclient-test-call-emacsclient () "Run emacsclient." (call-process emacsclient-test-emacs nil nil nil "--server-file" (expand-file-name "non-existent-file" invocation-directory) "foo")) (ert-deftest emacsclient-test-alternate-editor-allows-arguments () - (let (process-environment process-environment) + (let ((process-environment process-environment)) (setenv "ALTERNATE_EDITOR" (concat (expand-file-name invocation-name invocation-directory) " --batch")) - (should (= 0 (call-emacsclient))))) + (should (= 0 (emacsclient-test-call-emacsclient))))) (ert-deftest emacsclient-test-alternate-editor-allows-quotes () - (let (process-environment process-environment) + (let ((process-environment process-environment)) (setenv "ALTERNATE_EDITOR" (concat "\"" (expand-file-name invocation-name invocation-directory) "\"" " --batch")) - (should (= 0 (call-emacsclient))))) + (should (= 0 (emacsclient-test-call-emacsclient))))) (provide 'emacsclient-tests) ;;; emacsclient-tests.el ends here commit cae005f28d8533aeb76ccb18601158ea959bc807 Author: Glenn Morris Date: Fri Sep 1 18:29:49 2017 -0400 * test/Makefile.in (check-no-automated-subdir): Silence by default. diff --git a/test/Makefile.in b/test/Makefile.in index 0c3d3601d7..d4395e69bb 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -220,7 +220,7 @@ endif ## the tests were arranged differently. .PHONY: check-no-automated-subdir check-no-automated-subdir: - test ! -d $(srcdir)/automated + ${AM_V_at}test ! -d $(srcdir)/automated ## Rerun all default tests. check: mostlyclean check-no-automated-subdir commit 44c971bb67f7eb30ea6d078551b1815b57dcdeed Author: Glenn Morris Date: Fri Sep 1 18:27:31 2017 -0400 * test/Makefile.in (ELFILES): Sort, for a reproducible order. diff --git a/test/Makefile.in b/test/Makefile.in index 34d74d41cb..0c3d3601d7 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -156,11 +156,11 @@ else maybe_exclude_module_tests := -name emacs-module-tests.el -prune -o endif -ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ +ELFILES := $(sort $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ -path "${srcdir}/data" -prune -o \ -name "*resources" -prune -o \ ${maybe_exclude_module_tests} \ - -name "*.el" ! -name ".*" -print) + -name "*.el" ! -name ".*" -print)) ## .log files may be in a different directory for out of source builds LOGFILES := $(patsubst %.el,%.log, \ $(patsubst $(srcdir)/%,%,$(ELFILES))) commit 55ac7505a094c7c3d9ee28c7668a0179a072b889 Author: Mark Oteiza Date: Fri Sep 1 17:31:45 2017 -0400 Turn off checkdoc complaint about default argument order * etc/NEWS: Mention change. * lisp/emacs-lisp/checkdoc.el (checkdoc-arguments-in-order-flag): Disable by default, note version. diff --git a/etc/NEWS b/etc/NEWS index d32b0e5bc8..be95504cfd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -673,6 +673,11 @@ bound to 'Buffer-menu-unmark-all-buffers'. *** Two new commands 'Buffer-menu-unmark-all', bound to 'U' and 'Buffer-menu-unmark-all-buffers', bound to 'M-DEL'. +--- +** Checkdoc + +*** 'checkdoc-arguments-in-order-flag' now defaults to nil. + ** Gnus --- diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 1d6fdfa4e8..bc67a6be51 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -258,12 +258,13 @@ Any more than this and a warning is generated suggesting that the construct \\ {keymap} be used instead." :type 'integer) -(defcustom checkdoc-arguments-in-order-flag t +(defcustom checkdoc-arguments-in-order-flag nil "Non-nil means warn if arguments appear out of order. Setting this to nil will mean only checking that all the arguments appear in the proper form in the documentation, not that they are in the same order as they appear in the argument list. No mention is made in the style guide relating to order." + :version "26.1" :type 'boolean) ;;;###autoload(put 'checkdoc-arguments-in-order-flag 'safe-local-variable #'booleanp) commit 4bc2795a401cf31fa8bb4d5a45698b181951786f Author: Reuben Thomas Date: Fri Sep 1 21:21:38 2017 +0100 Stop emacsclient tests hanging (Bug#28319) * test/lib-src/emacsclient-tests.el (emacsclient-test-alternate-editor-allows-arguments): Use a non-existent file to communicate with server, so that any existing default server will not be hijacked (in fact, the test does not need a server). (emacsclient-test-alternate-editor-allows-quotes): Likewise. diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el index ea757f6914..e454e2825e 100644 --- a/test/lib-src/emacsclient-tests.el +++ b/test/lib-src/emacsclient-tests.el @@ -31,12 +31,18 @@ "lib-src")) "Path to emacsclient binary in build tree.") +(defun call-emacsclient () + "Run emacsclient." + (call-process emacsclient-test-emacs nil nil nil + "--server-file" (expand-file-name "non-existent-file" invocation-directory) + "foo")) + (ert-deftest emacsclient-test-alternate-editor-allows-arguments () (let (process-environment process-environment) (setenv "ALTERNATE_EDITOR" (concat (expand-file-name invocation-name invocation-directory) " --batch")) - (should (= 0 (call-process emacsclient-test-emacs nil nil nil "foo"))))) + (should (= 0 (call-emacsclient))))) (ert-deftest emacsclient-test-alternate-editor-allows-quotes () (let (process-environment process-environment) @@ -44,7 +50,7 @@ "\"" (expand-file-name invocation-name invocation-directory) "\"" " --batch")) - (should (= 0 (call-process emacsclient-test-emacs nil nil nil "foo"))))) + (should (= 0 (call-emacsclient))))) (provide 'emacsclient-tests) ;;; emacsclient-tests.el ends here commit c4ccafb1a59677c669519575b47d20f3ed4bacb3 Author: Stefan Monnier Date: Fri Sep 1 14:29:57 2017 -0400 * lisp/obsolete/html2text.el: Don't require CL (html2text-clean-anchor): Mark unused arg. diff --git a/lisp/obsolete/html2text.el b/lisp/obsolete/html2text.el index 27560a70c6..f60b04a404 100644 --- a/lisp/obsolete/html2text.el +++ b/lisp/obsolete/html2text.el @@ -38,8 +38,6 @@ ;; ;; -(eval-when-compile - (require 'cl)) (defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr))) @@ -300,7 +298,7 @@ formatting, and then moved afterward.") (defun html2text-clean-blockquote (p1 p2 p3 p4) (html2text-delete-tags p1 p2 p3 p4)) -(defun html2text-clean-anchor (p1 p2 p3 p4) +(defun html2text-clean-anchor (p1 p2 _p3 p4) ;; If someone can explain how to make the URL clickable I will surely ;; improve upon this. ;; Maybe `goto-addr.el' can be used here. commit 2d420fb6b1de1f3293993297068f85c3533ba20b Author: Glenn Morris Date: Fri Sep 1 06:26:57 2017 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 0cb2eb4c31..32f2a179c3 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5444,16 +5444,7 @@ See also `conf-space-mode', `conf-colon-mode', `conf-javaprop-mode', (autoload 'conf-unix-mode "conf-mode" "\ Conf Mode starter for Unix style Conf files. -Comments start with `#'. -For details see `conf-mode'. Example: - -# Conf mode font-locks this right on Unix and with \\[conf-unix-mode] - -\[Desktop Entry] - Encoding=UTF-8 - Name=The GIMP - Name[ca]=El GIMP - Name[cs]=GIMP +Comments start with `#'. For details see `conf-mode'. \(fn)" t nil) @@ -5559,6 +5550,32 @@ For details see `conf-mode'. Example: \(fn)" t nil) +(autoload 'conf-toml-mode "conf-mode" "\ +Conf Mode starter for TOML files. +Comments start with `#' and \"assignments\" are with `='. +For details see `conf-mode'. Example: + +# Conf mode font-locks this right with \\[conf-toml-mode] + +\[entry] +value = \"some string\" + +\(fn)" t nil) + +(autoload 'conf-desktop-mode "conf-mode" "\ +Conf Mode started for freedesktop.org Desktop files. +Comments start with `#' and \"assignments\" are with `='. +For details see `conf-mode'. + +# Conf mode font-locks this correctly with \\[conf-desktop-mode] + [Desktop Entry] + Name=GNU Image Manipulation Program + Name[oc]=Editor d'imatge GIMP + Exec=gimp-2.8 %U + Terminal=false + +\(fn)" t nil) + (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "conf-mode" '("conf-"))) ;;;*** @@ -6830,9 +6847,12 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -With a prefix argument ARG, enable Delete Selection mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. +Interactively, with a prefix argument, enable +Delete Selection mode if the prefix argument is positive, +and disable it otherwise. If called from Lisp, toggle +the mode if ARG is `toggle', disable the mode if ARG is +a non-positive integer, and enable the mode otherwise +\(including if ARG is omitted or nil or a positive integer). When Delete Selection mode is enabled, typed text replaces the selection if the selection is active. Otherwise, typed text is just inserted at @@ -9700,15 +9720,6 @@ It creates an autoload function for CNAME's constructor. ;;;### (autoloads nil "elec-pair" "elec-pair.el" (0 0 0 0)) ;;; Generated autoloads from elec-pair.el -(defvar electric-pair-text-pairs '((34 . 34) ((nth 0 electric-quote-chars) nth 1 electric-quote-chars) ((nth 2 electric-quote-chars) nth 3 electric-quote-chars)) "\ -Alist of pairs that should always be used in comments and strings. - -Pairs of delimiters in this list are a fallback in case they have -no syntax relevant to `electric-pair-mode' in the syntax table -defined in `electric-pair-text-syntax-table'") - -(custom-autoload 'electric-pair-text-pairs "elec-pair" t) - (defvar electric-pair-mode nil "\ Non-nil if Electric-Pair mode is enabled. See the `electric-pair-mode' command @@ -13061,7 +13072,23 @@ to get the effect of a C-q. ;;; Generated autoloads from progmodes/flymake.el (push (purecopy '(flymake 0 3)) package--builtin-versions) -(autoload 'flymake-mode "flymake" "\ +;;;*** + +;;;### (autoloads nil "flymake-proc" "progmodes/flymake-proc.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from progmodes/flymake-proc.el +(push (purecopy '(flymake-proc 0 3)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-proc" '("flymake-"))) + +;;;*** + +;;;### (autoloads nil "flymake-ui" "progmodes/flymake-ui.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from progmodes/flymake-ui.el +(push (purecopy '(flymake-ui 0 3)) package--builtin-versions) + +(autoload 'flymake-mode "flymake-ui" "\ Toggle Flymake mode on or off. With a prefix argument ARG, enable Flymake mode if ARG is positive, and disable it otherwise. If called from Lisp, enable @@ -13070,22 +13097,22 @@ the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'. \(fn &optional ARG)" t nil) -(autoload 'flymake-mode-on "flymake" "\ +(autoload 'flymake-mode-on "flymake-ui" "\ Turn flymake mode on. \(fn)" nil nil) -(autoload 'flymake-mode-off "flymake" "\ +(autoload 'flymake-mode-off "flymake-ui" "\ Turn flymake mode off. \(fn)" nil nil) -(autoload 'flymake-find-file-hook "flymake" "\ +(autoload 'flymake-find-file-hook "flymake-ui" "\ \(fn)" nil nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake" '("flymake-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "flymake-ui" '("flymake-"))) ;;;*** @@ -15060,12 +15087,9 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(autoload 'grep-regexp-alist "grep" "\ -Return a regexp alist to match grep hits. -The regexp used depends on `grep-use-null-filename-separator'. -See `compilation-error-regexp-alist' for format details. - -\(fn)" nil nil) +(defconst grep-regexp-alist `((,(concat "^\\(?:" "\\(?1:[^\n]+\\)\\(?3:\\)\\(?2:[0-9]+\\):" "\\|" "\\(?1:[^\n:]+?[^\n/:]\\):[ ]*\\(?2:[1-9][0-9]*\\)[ ]*:" "\\)") 1 2 (,(lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) (when mbeg (- mbeg beg))))) \, (lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) nil nil (3 '(face nil display ":"))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +Regexp used to match grep hits. +See `compilation-error-regexp-alist' for format details.") (defvar grep-program (purecopy "grep") "\ The default grep program for `grep-command' and `grep-find-command'. @@ -19455,6 +19479,30 @@ A major mode to edit GNU ld script files ;;;*** +;;;### (autoloads nil "less-css-mode" "textmodes/less-css-mode.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/less-css-mode.el + +(put 'less-css-compile-at-save 'safe-local-variable 'booleanp) + +(put 'less-css-lessc-options 'safe-local-variable t) + +(put 'less-css-output-directory 'safe-local-variable 'stringp) + +(put 'less-css-input-file-name 'safe-local-variable 'stringp) + (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode)) + +(autoload 'less-css-mode "less-css-mode" "\ +Major mode for editing Less files (http://lesscss.org/). +Special commands: +\\{less-css-mode-map} + +\(fn)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "less-css-mode" '("less-css-"))) + +;;;*** + ;;;### (autoloads nil "let-alist" "emacs-lisp/let-alist.el" (0 0 ;;;;;; 0 0)) ;;; Generated autoloads from emacs-lisp/let-alist.el @@ -30979,7 +31027,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;### (autoloads nil "sql" "progmodes/sql.el" (0 0 0 0)) ;;; Generated autoloads from progmodes/sql.el -(push (purecopy '(sql 3 5)) package--builtin-versions) +(push (purecopy '(sql 3 6)) package--builtin-versions) (autoload 'sql-add-product-keywords "sql" "\ Add highlighting KEYWORDS for SQL PRODUCT. @@ -31041,7 +31089,7 @@ their settings. The user will not be prompted for any login parameters if a value is specified in the connection settings. -\(fn CONNECTION &optional NEW-NAME)" t nil) +\(fn CONNECTION &optional BUF-NAME)" t nil) (autoload 'sql-product-interactive "sql" "\ Run PRODUCT interpreter as an inferior process. commit 356413bbf8333a0ace700bfbd7461b55ead63280 Author: Katsumi Yamaoka Date: Fri Sep 1 07:25:38 2017 +0000 Don't remove undisplayers from inlined MIME parts (bugfix) * lisp/gnus/gnus-art.el (gnus-mime-buttonize-attachments-in-header): Don't remove undisplayers from inlined MIME parts (bugfix); Simplify criterion that finds attachments. diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index ce0ff2ee8c..8fc5ebaa9b 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6366,7 +6366,7 @@ buttons to be added to the header are only the ones that aren't inlined in the body. Use `gnus-header-face-alist' to highlight buttons." (interactive (list t)) (gnus-with-article-buffer - (let ((case-fold-search t) buttons handle type st) + (let ((case-fold-search t) buttons st) (save-excursion (save-restriction (widen) @@ -6387,22 +6387,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." ;; Find buttons. (setq buttons nil) (dolist (button (gnus-article-mime-handles)) - (setq handle (cdr button) - type (mm-handle-media-type handle)) - (when (or (and (if (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - gnus-inhibit-images) - gnus-inhibit-images) - (string-match "\\`image/" type)) - (mm-inline-override-p handle) - (and (mm-handle-disposition handle) - (not (equal (car (mm-handle-disposition handle)) - "inline")) - (not (mm-attachment-override-p handle))) - (not (mm-automatic-display-p handle)) - (not (or (and (mm-inlinable-p handle) - (mm-inlined-p handle)) - (mm-automatic-external-display-p type)))) + (unless (mm-handle-undisplayer (cdr button)) (push button buttons))) (when buttons ;; Add header buttons. @@ -6413,8 +6398,7 @@ in the body. Use `gnus-header-face-alist' to highlight buttons." (dolist (button (nreverse buttons)) (setq st (point)) (insert " ") - (mm-handle-set-undisplayer (setq handle (cdr button)) nil) - (gnus-insert-mime-button handle (car button)) + (gnus-insert-mime-button (cdr button) (car button)) (skip-chars-backward "\t\n ") (delete-region (point) (point-max)) (when (> (current-column) (window-width)) commit c5c9f5d71853817f1002e3e2c1a7dea1b1d764ef Author: Mark Oteiza Date: Thu Aug 31 17:32:10 2017 -0400 ; Escape some character literals * lisp/leim/quail/latin-ltx.el: Escape some fancy brackets. diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index d8ea90ec3e..ac8d5b40ad 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -547,7 +547,7 @@ system, including many technical ones. Examples: ("\\propto" ?∝) ("\\qed" ?∎) ("\\quad" ? ) - ("\\rangle" ?⟩) ;; Was ?〉, see bug#12948. + ("\\rangle" ?\⟩) ;; Was ?〉, see bug#12948. ("\\rbrace" ?}) ("\\rbrack" ?\]) ("\\rceil" ?⌉) @@ -739,8 +739,8 @@ system, including many technical ones. Examples: ("\\textdiscount" ?⁒) ("\\textestimated" ?℮) ("\\textopenbullet" ?◦) - ("\\textlquill" ?⁅) - ("\\textrquill" ?⁆) + ("\\textlquill" ?\⁅) + ("\\textrquill" ?\⁆) ("\\textcircledP" ?℗) ("\\textreferencemark" ?※) ) commit 96c2c098aeed5c85733577ebbdaf33af6fbb59e9 Author: Mark Oteiza Date: Thu Aug 31 17:22:39 2017 -0400 Make ucs-names a hash table (Bug#28302) * etc/NEWS: Mention the type change. * lisp/descr-text.el (describe-char): Use gethash to access ucs-names. Hardcode BEL's name into the function instead of needlessly mapping over the hash table in the spirit of rassoc. * lisp/international/mule-cmds.el (ucs-names): Fix variable and function docstrings. Initialize a hash table for ucs-names--the number of entries is 42845 here. Switch to hash-table getters/setters. (mule--ucs-names-annotation): Use hash-table getter. (char-from-name): Upcase the string if ignore-case is truthy. * lisp/leim/quail/latin-ltx.el: Use maphash instead of dolist. diff --git a/etc/NEWS b/etc/NEWS index 0889303f82..d32b0e5bc8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1154,6 +1154,9 @@ table implementation. This uses a new bytecode op 'switch', which isn't compatible with previous Emacs versions. This functionality can be disabled by setting 'byte-compile-cond-use-jump-table' to nil. +--- +** The alist 'ucs-names' is now a hash table. + --- ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term mode to send the same escape sequences that xterm does. This makes diff --git a/lisp/descr-text.el b/lisp/descr-text.el index 6f36bbed68..b3c96988dd 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -617,16 +617,16 @@ relevant to POS." (list (let* ((names (ucs-names)) (name - (or (when (= char 7) + (or (when (= char ?\a) ;; Special case for "BELL" which is ;; apparently the only char which ;; doesn't have a new name and whose ;; old-name is shadowed by a newer char ;; with that name (bug#25641). - (car (rassoc char names))) + "BELL (BEL)") (get-char-code-property char 'name) (get-char-code-property char 'old-name)))) - (if (and name (assoc-string name names)) + (if (and name (gethash name names)) (format "type \"C-x 8 RET %x\" or \"C-x 8 RET %s\"" char name) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index 338ca6a6e3..a596411eb7 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2923,10 +2923,10 @@ on encoding." (make-obsolete-variable 'nonascii-translation-table "do not use it." "23.1") (defvar ucs-names nil - "Alist of cached (CHAR-NAME . CHAR-CODE) pairs.") + "Hash table of cached CHAR-NAME keys to CHAR-CODE values.") (defun ucs-names () - "Return alist of (CHAR-NAME . CHAR-CODE) pairs cached in `ucs-names'." + "Return table of CHAR-NAME keys and CHAR-CODE values cached in `ucs-names'." (or ucs-names (let ((ranges '((#x0000 . #x33FF) @@ -2954,38 +2954,39 @@ on encoding." ;; (#x20000 . #xDFFFF) CJK Ideograph Extension A, B, etc, unused (#xE0000 . #xE01FF))) (gc-cons-threshold 10000000) - names) - (dolist (range ranges) - (let ((c (car range)) - (end (cdr range))) - (while (<= c end) + (names (make-hash-table :size 42943 :test #'equal))) + (dolist (range ranges) + (let ((c (car range)) + (end (cdr range))) + (while (<= c end) (let ((new-name (get-char-code-property c 'name)) (old-name (get-char-code-property c 'old-name))) - ;; In theory this code could end up pushing an "old-name" that - ;; shadows a "new-name" but in practice every time an - ;; `old-name' conflicts with a `new-name', the newer one has a - ;; higher code, so it gets pushed later! - (if new-name (push (cons new-name c) names)) - (if old-name (push (cons old-name c) names)) - (setq c (1+ c)))))) - ;; Special case for "BELL" which is apparently the only char which - ;; doesn't have a new name and whose old-name is shadowed by a newer - ;; char with that name. - (setq ucs-names `(("BELL (BEL)" . 7) ,@names))))) + ;; In theory this code could end up pushing an "old-name" that + ;; shadows a "new-name" but in practice every time an + ;; `old-name' conflicts with a `new-name', the newer one has a + ;; higher code, so it gets pushed later! + (if new-name (puthash new-name c names)) + (if old-name (puthash old-name c names)) + (setq c (1+ c)))))) + ;; Special case for "BELL" which is apparently the only char which + ;; doesn't have a new name and whose old-name is shadowed by a newer + ;; char with that name. + (puthash "BELL (BEL)" ?\a names) + (setq ucs-names names)))) (defun mule--ucs-names-annotation (name) ;; FIXME: It would be much better to add this annotation before rather than ;; after the char name, so the annotations are aligned. ;; FIXME: The default behavior of displaying annotations in italics ;; doesn't work well here. - (let ((char (assoc name ucs-names))) - (when char (format " (%c)" (cdr char))))) + (let ((char (gethash name ucs-names))) + (when char (format " (%c)" char)))) (defun char-from-name (string &optional ignore-case) "Return a character as a number from its Unicode name STRING. If optional IGNORE-CASE is non-nil, ignore case in STRING. Return nil if STRING does not name a character." - (or (cdr (assoc-string string (ucs-names) ignore-case)) + (or (gethash (if ignore-case (upcase string) string) (ucs-names)) (let ((minus (string-match-p "-[0-9A-F]+\\'" string))) (when minus ;; Parse names like "VARIATION SELECTOR-17" and "CJK diff --git a/lisp/leim/quail/latin-ltx.el b/lisp/leim/quail/latin-ltx.el index 6c5afcd4f9..d8ea90ec3e 100644 --- a/lisp/leim/quail/latin-ltx.el +++ b/lisp/leim/quail/latin-ltx.el @@ -75,20 +75,20 @@ system, including many technical ones. Examples: (`(,seq ,re) (let ((count 0) (re (eval re t))) - (dolist (pair (ucs-names)) - (let ((name (car pair)) - (char (cdr pair))) - (when (and (characterp char) ;; Ignore char-ranges. - (string-match re name)) - (let ((keys (if (stringp seq) - (replace-match seq nil nil name) - (funcall seq name char)))) - (if (listp keys) - (dolist (x keys) - (setq count (1+ count)) - (push (list x char) newrules)) - (setq count (1+ count)) - (push (list keys char) newrules)))))) + (maphash + (lambda (name char) + (when (and (characterp char) ;; Ignore char-ranges. + (string-match re name)) + (let ((keys (if (stringp seq) + (replace-match seq nil nil name) + (funcall seq name char)))) + (if (listp keys) + (dolist (x keys) + (setq count (1+ count)) + (push (list x char) newrules)) + (setq count (1+ count)) + (push (list keys char) newrules))))) + (ucs-names)) ;; (message "latin-ltx: %d mappings for %S" count re) )))) (setq newrules (delete-dups newrules)) @@ -206,7 +206,7 @@ system, including many technical ones. Examples: ((lambda (name char) (let* ((base (concat (match-string 1 name) (match-string 3 name))) - (basechar (cdr (assoc base (ucs-names))))) + (basechar (gethash base (ucs-names)))) (when (latin-ltx--ascii-p basechar) (string (if (match-end 2) ?^ ?_) basechar)))) "\\(.*\\)SU\\(?:B\\|\\(PER\\)\\)SCRIPT \\(.*\\)") commit e6a2b4c2df96ed8780ff407481a18e3f4299c8ad Author: Alan Third Date: Thu Aug 31 20:42:35 2017 +0100 Remove unneeded version checks (bug#28222) * src/macfont.h (CGContextSetFontSmoothingStyle): Remove version check. * src/macfont.m (macfont_draw): Remove version check, and test for existence of CGContextSetFontSmoothingStyle. diff --git a/src/macfont.h b/src/macfont.h index 3a66d2d005..909336cdba 100644 --- a/src/macfont.h +++ b/src/macfont.h @@ -83,9 +83,6 @@ extern void mac_register_font_driver (struct frame *f); extern void *macfont_get_nsctfont (struct font *font); extern void macfont_update_antialias_threshold (void); -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 -/* This is an undocumented function that is probably not available - pre-10.8. */ +/* This is an undocumented function. */ extern void CGContextSetFontSmoothingStyle(CGContextRef, int) __attribute__((weak_import)); -#endif diff --git a/src/macfont.m b/src/macfont.m index 33c28f7349..59891353cd 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2888,14 +2888,11 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no if (no_antialias_p) CGContextSetShouldAntialias (context, false); -#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 - if (!NILP (ns_use_thin_smoothing) - && CGContextSetFontSmoothingStyle != NULL) + if (!NILP (ns_use_thin_smoothing)) { CGContextSetShouldSmoothFonts(context, YES); CGContextSetFontSmoothingStyle(context, 16); } -#endif CGContextSetTextMatrix (context, atfm); CGContextSetTextPosition (context, text_position.x, text_position.y); commit 5fe41a23d811b17bcde0921b37b89175806c83ef Author: Alan Mackenzie Date: Thu Aug 31 19:06:16 2017 +0000 Fix a glitch in CC Mode's syntactic whitespace cache. * lisp/progmodes/cc-engine.el (c-forward-sws): Deal correctly with a block comment close at the end of a macro. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d20e575a92..bf95dc1e3c 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1980,17 +1980,10 @@ comment at the start of cc-engine.el for more info." (end-of-line)) (setq macro-end (point)) ;; Check for an open block comment at the end of the macro. - (goto-char macro-start) - (let (s in-block-comment) - (while - (progn - (setq s (parse-partial-sexp (point) macro-end - nil nil s 'syntax-table)) - (< (point) macro-end)) - (setq in-block-comment - (and (elt s 4) ; in a comment - (null (elt s 7))))) ; a block comment - (if in-block-comment (setq safe-start nil))) + (let ((s (parse-partial-sexp macro-start macro-end))) + (if (and (elt s 4) ; in a comment + (null (elt s 7))) ; a block comment + (setq safe-start nil))) (forward-line 1) ;; Don't cache at eob in case the buffer is narrowed. (not (eobp))) commit 201f950e665153733b47b133a839921bc95806e3 Author: Alan Mackenzie Date: Thu Aug 31 18:08:21 2017 +0000 Correct the fontification of C++ Mode enclosed declarations. * lisp/progmodes/cc-fonts.el (c-font-lock-enclosing-decls): abolish the spurious check that the character before the start of an enclosed declaration must be ; or }. It might also be {. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index b35d33a5fd..95246f9b16 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1710,18 +1710,16 @@ casts and declarations are fontified. Used on level 2 and higher." (eq (char-after ps-elt) ?\{)) (goto-char ps-elt) (c-syntactic-skip-backward "^;{}" decl-search-lim) - (when (or (bobp) - (memq (char-before) '(?\; ?}))) - (c-forward-syntactic-ws) - (setq in-typedef (looking-at c-typedef-key)) - (if in-typedef (c-forward-token-2)) - (when (and c-opt-block-decls-with-vars-key - (looking-at c-opt-block-decls-with-vars-key)) - (goto-char ps-elt) - (when (c-safe (c-forward-sexp)) - (c-forward-syntactic-ws) - (c-font-lock-declarators limit t in-typedef - (not (c-bs-at-toplevel-p (point))))))))))) + (c-forward-syntactic-ws) + (setq in-typedef (looking-at c-typedef-key)) + (if in-typedef (c-forward-token-2)) + (when (and c-opt-block-decls-with-vars-key + (looking-at c-opt-block-decls-with-vars-key)) + (goto-char ps-elt) + (when (c-safe (c-forward-sexp)) + (c-forward-syntactic-ws) + (c-font-lock-declarators limit t in-typedef + (not (c-bs-at-toplevel-p (point)))))))))) (defun c-font-lock-raw-strings (limit) ;; Fontify C++ raw strings. commit 7bb75e3d8194c2349bfa4479fd72e10f31bea0a5 Author: Martin Rudalics Date: Thu Aug 31 10:00:23 2017 +0200 In xterm.c fix some recently introduced compiler warnings * src/xterm.c (xaw_jump_callback) (x_set_toolkit_scroll_bar_thumb): Fix some recently introduced -Wdouble-promotion warnings. diff --git a/src/xterm.c b/src/xterm.c index b7dc884fa6..a7a52064a1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5727,12 +5727,11 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) struct scroll_bar *bar = client_data; float *top_addr = call_data; double top = *top_addr; - float shown; + double shown; int whole, portion, height, width; enum scroll_bar_part part; bool horizontal = bar->horizontal; - if (horizontal) { /* Get the size of the thumb, a value between 0 and 1. */ @@ -6367,8 +6366,9 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio } { - float old_top, old_shown; + double old_top, old_shown; Dimension height; + XtVaGetValues (widget, XtNtopOfThumb, &old_top, XtNshown, &old_shown, @@ -6395,7 +6395,8 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio /* If the call to XawScrollbarSetThumb below doesn't seem to work, check that 'NARROWPROTO' is defined in src/config.h. If this is not so, most likely you need to fix configure. */ - float ftop = top, fshown = shown; + double ftop = top, fshown = shown; + if (ftop != old_top || fshown != old_shown) { if (bar->dragging == -1) commit f44184f1c34fed8e6e1db93de37d3ea76419c5ac Author: Martin Rudalics Date: Thu Aug 31 09:36:46 2017 +0200 Restrict fix of Bug#24963 and Bug#25887 to GTK builds * src/xterm.c (handle_one_xevent): Restrict earlier fix of Bug#24963 and Bug#25887 to avoid that a non-GTK Emacs won't react to state changes received via ConfigureNotify. diff --git a/src/xterm.c b/src/xterm.c index 64e89708b2..b7dc884fa6 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -8723,9 +8723,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif if (f) { - /* Don't call x_net_wm_state for the scroll bar window. - (Bug#24963, Bug#25887) */ +#ifdef USE_GTK + /* For GTK+ don't call x_net_wm_state for the scroll bar + window. (Bug#24963, Bug#25887) */ if (configureEvent.xconfigure.window == FRAME_X_WINDOW (f)) +#endif x_net_wm_state (f, configureEvent.xconfigure.window); #ifdef USE_X_TOOLKIT commit a4f6b1097fb5d3f27d42b722b7f31fb35fe9da53 Author: Katsumi Yamaoka Date: Thu Aug 31 00:45:54 2017 +0000 Respect directory a user enters (bug#28299) * lisp/gnus/mm-decode.el (mm-save-part): Respect directory a user enters (bug#28299). diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index c6a0be36c4..9b77dadddb 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -1363,7 +1363,7 @@ PROMPT overrides the default one used to ask user for a file name." (mm-handle-disposition handle) 'filename) (mail-content-type-get (mm-handle-type handle) 'name))) - file) + file directory) (when filename (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) @@ -1372,16 +1372,20 @@ PROMPT overrides the default one used to ask user for a file name." (setq file (read-file-name (or prompt - (format "Save MIME part to (default %s): " - (or filename ""))) - (or mm-default-directory default-directory) - (expand-file-name (or filename "") - (or mm-default-directory default-directory)))) + (format "Save MIME part to%s: " + (if filename + (format " (default %s)" filename) + ""))) + (or directory mm-default-directory default-directory) + (expand-file-name + (or filename "") + (or directory mm-default-directory default-directory)))) (cond ((or (not file) (equal file "")) (message "Please enter a file name") t) ((and (file-directory-p file) (not filename)) + (setq directory file) (message "Please enter a non-directory file name") t) (t nil))) commit cda26e64621d71c6a797f694418d844a621998be Author: Samuel Freilich Date: Wed Aug 23 13:40:45 2017 -0400 Do not split line before width of fill-prefix When auto-filling a paragraph, don't split a line before the width of the fill-prefix, creating a subsequent line that is as long or longer (Bug#20774). * lisp/simple.el (do-auto-fill): Only consider break-points that are later in the line than the width of the fill-prefix. This is a more general solution than the previous logic, which only skipped over the exact fill-prefix. The fill-prefix doesn't necessarily match the prefix of the first line of a paragraph in adaptive-fill-mode. diff --git a/lisp/simple.el b/lisp/simple.el index 13cfa3487d..27990bb661 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7151,18 +7151,18 @@ Returns t if it really did any work." (setq fill-prefix prefix)))) (while (and (not give-up) (> (current-column) fc)) - ;; Determine where to split the line. - (let* (after-prefix - (fill-point - (save-excursion - (beginning-of-line) - (setq after-prefix (point)) - (and fill-prefix - (looking-at (regexp-quote fill-prefix)) - (setq after-prefix (match-end 0))) - (move-to-column (1+ fc)) - (fill-move-to-break-point after-prefix) - (point)))) + ;; Determine where to split the line. + (let ((fill-point + (save-excursion + (beginning-of-line) + ;; Don't split earlier in the line than the length of the + ;; fill prefix, since the resulting line would be longer. + (when fill-prefix + (move-to-column (string-width fill-prefix))) + (let ((after-prefix (point))) + (move-to-column (1+ fc)) + (fill-move-to-break-point after-prefix) + (point))))) ;; See whether the place we found is any good. (if (save-excursion @@ -7170,9 +7170,6 @@ Returns t if it really did any work." (or (bolp) ;; There is no use breaking at end of line. (save-excursion (skip-chars-forward " ") (eolp)) - ;; It is futile to split at the end of the prefix - ;; since we would just insert the prefix again. - (and after-prefix (<= (point) after-prefix)) ;; Don't split right after a comment starter ;; since we would just make another comment starter. (and comment-start-skip diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index ad7aee1db1..729001bdf3 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -497,5 +497,19 @@ See Bug#21722." (should (equal (line-number-at-pos 5) 3)) (should (equal (line-number-at-pos 7) 4))))) + +;;; Auto fill. + +(ert-deftest auto-fill-mode-no-break-before-length-of-fill-prefix () + (with-temp-buffer + (setq-local fill-prefix " ") + (set-fill-column 5) + ;; Shouldn't break after 'foo' (3 characters) when the next + ;; line is indented >= to that, that woudln't result in shorter + ;; lines. + (insert "foo bar") + (do-auto-fill) + (should (string-equal (buffer-string) "foo bar")))) + (provide 'simple-test) ;;; simple-test.el ends here commit 160295867de98241a16f2ede93da7e825ed4406b Author: Noam Postavsky Date: Sat Aug 19 10:29:05 2017 -0400 Support lazy loading for autogenerated usage docstrings too (Bug#27748) * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): Consider any documentation that ended up in code as a docstring (e.g., autogenerated (fn ARG1 ARG2) type things), not just what the user passed. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index dc8839e6f9..c3bb777641 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2569,7 +2569,7 @@ not to take responsibility for the actual compilation of the code." (let ((index ;; If there's no doc string, provide -1 as the "doc string ;; index" so that no element will be treated as a doc string. - (if (not (stringp (car body))) -1 4))) + (if (not (stringp (documentation code t))) -1 4))) ;; Output the form by hand, that's much simpler than having ;; b-c-output-file-form analyze the defalias. (byte-compile-output-docform commit bc5d96a0b2a1dccf7eeeec459e40d21b54c977f4 Author: Noam Postavsky Date: Fri Aug 18 08:15:25 2017 -0400 Drop docstrings from cl-defsubst produced inline bodies (Bug#27748) * lisp/emacs-lisp/cl-macs.el (cl-defsubst): Use macroexp-parse-progn to drop the docstring. Add a simple docstring to the compiler-macro. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index b1ada00f4a..20a956b474 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2503,8 +2503,9 @@ The function's arguments should be treated as immutable. ,(if (memq '&key args) `(&whole cl-whole &cl-quote ,@args) (cons '&cl-quote args)) + ,(format "compiler-macro for inlining `%s'." name) (cl--defsubst-expand - ',argns '(cl-block ,name ,@body) + ',argns '(cl-block ,name ,@(cdr (macroexp-parse-body body))) ;; We used to pass `simple' as ;; (not (or unsafe (cl-expr-access-order pbody argns))) ;; But this is much too simplistic since it commit 7553e0f490e1f9a51c330816f7372da735091e8f Author: Paul Eggert Date: Wed Aug 30 14:45:52 2017 -0700 Quote file-truename symlink to "../foo:bar:" Problem reported by Michael Albinus (Bug#28264#19). * lisp/files.el (files--splice-dirname-file): Fix bug where a relative symlink to "../foo:bar:" did not quote the result. diff --git a/lisp/files.el b/lisp/files.el index 8cec3d45dc..43aec8173d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1155,19 +1155,19 @@ names beginning with `~'." (defun files--splice-dirname-file (dirname file) "Splice DIRNAME to FILE like the operating system would. -If FILENAME is relative, return DIRNAME concatenated to FILE. +If FILE is relative, return DIRNAME concatenated to FILE. Otherwise return FILE, quoted as needed if DIRNAME and FILE have different handlers; although this quoting is dubious if DIRNAME is magic, it is not clear what would be better. This function differs from `expand-file-name' in that DIRNAME must be a directory name and leading `~' and `/:' are not special in FILE." - (if (files--name-absolute-system-p file) - (if (eq (find-file-name-handler dirname 'file-symlink-p) - (find-file-name-handler file 'file-symlink-p)) - file - ;; If `file' is remote, we want to quote it at the beginning. - (let (file-name-handler-alist) (file-name-quote file))) - (concat dirname file))) + (let ((unquoted (if (files--name-absolute-system-p file) + file + (concat dirname file)))) + (if (eq (find-file-name-handler dirname 'file-symlink-p) + (find-file-name-handler unquoted 'file-symlink-p)) + unquoted + (let (file-name-handler-alist) (file-name-quote unquoted))))) (defun file-truename (filename &optional counter prev-dirs) "Return the truename of FILENAME. commit 98f01a13a3bf2a4db2dcc82a342ee017326de732 Author: Reuben Thomas Date: Thu Dec 1 15:21:57 2016 +0000 Add support for arguments in emacsclient's ALTERNATE_EDITOR (Bug #25082) * lib-src/emacsclient.c (fail): Parse ALTERNATE_EDITOR, or corresponding command-line argument, into quote- or space-separated tokens. If a token starts with a quote, then it naturally is expected to end with a quote; escaping is not supported. This is enough to cope with the typical case of requiring the initial path to be quoted, common on Windows where it may contain spaces. * etc/NEWS: Document. * doc/emacs/misc.texi: Likewise. * doc/man/emacsclient.1: Tweak to remove the implication that only an editor can be specified (the manual already mentions a “command”). Fix a small error where “EDITOR” is referred to rather than “ALTERNATE_EDITOR”. * test/lib-src/emacsclient-tests.el: Add tests. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 73a6bae767..7602fbb745 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -1821,8 +1821,10 @@ listed below: @table @samp @item -a @var{command} @itemx --alternate-editor=@var{command} -Specify a command to run if @code{emacsclient} fails to contact Emacs. +Specify a shell command to run if @code{emacsclient} fails to contact Emacs. This is useful when running @code{emacsclient} in a script. +The command may include arguments, which may be quoted "like this". +Currently, escaping of quotes is not supported. As a special exception, if @var{command} is the empty string, then @code{emacsclient} starts Emacs in daemon mode (as @command{emacs diff --git a/doc/man/emacsclient.1 b/doc/man/emacsclient.1 index 010eeba19c..daaacab7f3 100644 --- a/doc/man/emacsclient.1 +++ b/doc/man/emacsclient.1 @@ -62,10 +62,10 @@ A missing is treated as column 1. This option applies only to the next file specified. .TP -.B \-a, \-\-alternate-editor=EDITOR -if the Emacs server is not running, run the specified editor instead. +.B \-a, \-\-alternate-editor=COMMAND +if the Emacs server is not running, run the specified shell command instead. This can also be specified via the ALTERNATE_EDITOR environment variable. -If the value of EDITOR is the empty string, run "emacs \-\-daemon" to +If the value of ALTERNATE_EDITOR is the empty string, run "emacs \-\-daemon" to start Emacs in daemon mode, and try to connect to it. .TP .B -c, \-\-create-frame diff --git a/etc/NEWS b/etc/NEWS index ef4d8cda39..0889303f82 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -485,6 +485,13 @@ Linum mode and all similar packages are henceforth becoming obsolete. Users and developers are encouraged to switch to this new feature instead. ++++ +** emacsclient now accepts command-line options in ALTERNATE_EDITOR +and --alternate-editor. For example, ALTERNATE_EDITOR="emacs -Q -nw". +Arguments may be quoted "like this", so that for example an absolute +path containing a space may be specified; quote escaping is not +supported. + * Editing Changes in Emacs 26.1 diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index f1d4e8976d..5e181ccacb 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -110,6 +110,9 @@ char *w32_getenv (const char *); /* Name used to invoke this program. */ const char *progname; +/* The first argument to main. */ +int main_argc; + /* The second argument to main. */ char **main_argv; @@ -201,6 +204,35 @@ xmalloc (size_t size) return result; } +/* Like realloc but get fatal error if memory is exhausted. */ + +static void * +xrealloc (void *ptr, size_t size) +{ + void *result = realloc (ptr, size); + if (result == NULL) + { + perror ("realloc"); + exit (EXIT_FAILURE); + } + return result; +} + +/* Like strdup but get a fatal error if memory is exhausted. */ +char *xstrdup (const char *); + +char * +xstrdup (const char *s) +{ + char *result = strdup (s); + if (result == NULL) + { + perror ("strdup"); + exit (EXIT_FAILURE); + } + return result; +} + /* From sysdep.c */ #if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME) @@ -264,21 +296,6 @@ get_current_dir_name (void) #ifdef WINDOWSNT -/* Like strdup but get a fatal error if memory is exhausted. */ -char *xstrdup (const char *); - -char * -xstrdup (const char *s) -{ - char *result = strdup (s); - if (result == NULL) - { - perror ("strdup"); - exit (EXIT_FAILURE); - } - return result; -} - #define REG_ROOT "SOFTWARE\\GNU\\Emacs" char *w32_get_resource (HKEY, const char *, LPDWORD); @@ -673,7 +690,7 @@ Report bugs with M-x report-emacs-bug.\n"); } /* Try to run a different command, or --if no alternate editor is - defined-- exit with an errorcode. + defined-- exit with an error code. Uses argv, but gets it from the global variable main_argv. */ static _Noreturn void @@ -681,9 +698,38 @@ fail (void) { if (alternate_editor) { - int i = optind - 1; + size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *); + size_t new_argv_size = extra_args_size; + char **new_argv = NULL; + char *s = xstrdup (alternate_editor); + unsigned toks = 0; + + /* Unpack alternate_editor's space-separated tokens into new_argv. */ + for (char *tok = s; tok != NULL && *tok != '\0';) + { + /* Allocate new token. */ + ++toks; + new_argv = xrealloc (new_argv, new_argv_size + toks * sizeof (char *)); + + /* Skip leading delimiters, and set separator, skipping any + opening quote. */ + size_t skip = strspn (tok, " \""); + tok += skip; + char sep = (skip > 0 && tok[-1] == '"') ? '"' : ' '; + + /* Record start of token. */ + new_argv[toks - 1] = tok; + + /* Find end of token and overwrite it with NUL. */ + tok = strchr (tok, sep); + if (tok != NULL) + *tok++ = '\0'; + } + + /* Append main_argv arguments to new_argv. */ + memcpy (&new_argv[toks], main_argv + optind, extra_args_size); - execvp (alternate_editor, main_argv + i); + execvp (*new_argv, new_argv); message (true, "%s: error executing alternate editor \"%s\"\n", progname, alternate_editor); } @@ -696,6 +742,7 @@ fail (void) int main (int argc, char **argv) { + main_argc = argc; main_argv = argv; progname = argv[0]; message (true, "%s: Sorry, the Emacs server is supported only\n" @@ -1629,6 +1676,7 @@ main (int argc, char **argv) int start_daemon_if_needed; int exit_status = EXIT_SUCCESS; + main_argc = argc; main_argv = argv; progname = argv[0]; diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el new file mode 100644 index 0000000000..ea757f6914 --- /dev/null +++ b/test/lib-src/emacsclient-tests.el @@ -0,0 +1,50 @@ +;;; emacsclient-tests.el --- Test emacsclient + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) + +(defconst emacsclient-test-emacs + (expand-file-name "emacsclient" (concat + (file-name-directory + (directory-file-name + (file-name-directory invocation-directory))) + "lib-src")) + "Path to emacsclient binary in build tree.") + +(ert-deftest emacsclient-test-alternate-editor-allows-arguments () + (let (process-environment process-environment) + (setenv "ALTERNATE_EDITOR" (concat + (expand-file-name invocation-name invocation-directory) + " --batch")) + (should (= 0 (call-process emacsclient-test-emacs nil nil nil "foo"))))) + +(ert-deftest emacsclient-test-alternate-editor-allows-quotes () + (let (process-environment process-environment) + (setenv "ALTERNATE_EDITOR" (concat + "\"" + (expand-file-name invocation-name invocation-directory) + "\"" " --batch")) + (should (= 0 (call-process emacsclient-test-emacs nil nil nil "foo"))))) + +(provide 'emacsclient-tests) +;;; emacsclient-tests.el ends here commit dc313922d826b9f53cf1426ff36c8cc3f71d64c6 Author: Stefan Monnier Date: Wed Aug 30 15:00:56 2017 -0400 * lisp/man.el (Man-softhyphen-to-minus): Avoid string-as-multibyte. diff --git a/lisp/man.el b/lisp/man.el index c7d8c4089d..4a14f638fc 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -1174,10 +1174,7 @@ See the variable `Man-notify-method' for the different notification behaviors." (unless (eq t (compare-strings "latin-" 0 nil current-language-environment 0 6 t)) (goto-char (point-min)) - (let ((str "\255")) - (if enable-multibyte-characters - (setq str (string-as-multibyte str))) - (while (search-forward str nil t) (replace-match "-"))))) + (while (search-forward "­" nil t) (replace-match "-")))) (defun Man-fontify-manpage () "Convert overstriking and underlining to the correct fonts. commit 36df2f1b23b26182978915beccd20a4adb23d51b Author: Devon Sean McCullough Date: Thu Aug 24 21:08:16 2017 +0100 Correct "hide others" shortcut on macOS (bug#28215) * lisp/term/ns-win.el: Fix shortcut for ns-do-hide-others. Copyright-paperwork-exempt: yes diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 8848360655..cfce83f892 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -124,6 +124,8 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [?\s-g] 'isearch-repeat-forward) (define-key global-map [?\s-h] 'ns-do-hide-emacs) (define-key global-map [?\s-H] 'ns-do-hide-others) +(define-key global-map [?\M-\s-h] 'ns-do-hide-others) +(define-key key-translation-map [?\M-\s-\u02D9] [?\M-\s-h]) (define-key global-map [?\s-j] 'exchange-point-and-mark) (define-key global-map [?\s-k] 'kill-current-buffer) (define-key global-map [?\s-l] 'goto-line) commit 03759e8ebfbe434611259ebf33f617e6d0a957b3 Author: Eli Zaretskii Date: Wed Aug 30 20:50:25 2017 +0300 ; * etc/NEWS: Some more minor copyedits. diff --git a/etc/NEWS b/etc/NEWS index c152029fa4..ef4d8cda39 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -566,7 +566,7 @@ procedure and therefore obeys saving hooks. 'auto-save-visited-file-name' is now obsolete. +++ -** New behavior of 'mark-defun' implemented +** New behavior of 'mark-defun'. Prefix argument selects that many (or that many more) defuns. Negative prefix arg flips the direction of selection. Also, 'mark-defun' between defuns correctly selects N following defuns (or @@ -641,7 +641,7 @@ This can be customized via the info-menu category in completion-category-override. +++ -** The ancestor buffer is shown by default in 3way merges. +** The ancestor buffer is shown by default in 3-way merges. A new option ediff-show-ancestor and a new toggle ediff-toggle-show-ancestor. @@ -869,7 +869,7 @@ at image boundaries. the function 'image-dired-setup-dired-keybindings'. --- -*** Thumbnail generation is now asynchronous +*** Thumbnail generation is now asynchronous. The number of concurrent processes is limited by the variable 'image-dired-thumb-job-limit'. @@ -952,8 +952,9 @@ located and whether GnuPG's option "--homedir" is used or not. ** Tramp +++ -*** The method part of remote file names is mandatory now. A valid -remote file name starts with "/method:host:" or "/method:user@host:". +*** The method part of remote file names is mandatory now. +A valid remote file name starts with "/method:host:" or +"/method:user@host:". +++ *** The new pseudo method "-" is a marker for the default method. @@ -975,8 +976,9 @@ different group ID. Drive onsite repositories. +++ -*** Gateway methods in Tramp have been removed. Instead, the Tramp -manual documents how to configure ssh and PuTTY accordingly. +*** Gateway methods in Tramp have been removed. +Instead, the Tramp manual documents how to configure ssh and PuTTY +accordingly. +++ *** Setting the "ENV" environment variable in @@ -1088,13 +1090,14 @@ to a format suitable for reverse lookup zone files. ** Ispell +++ -*** Enchant (version 2.1.0 or later required) is now supported as a -spell-checker. Enchant is a meta-spell-checker that uses providers +*** Enchant is now supported as a spell-checker. + +Enchant is a meta-spell-checker that uses providers such as Hunspell to do the actual checking. With it, users can use spell-checkers not directly supported by Emacs, such as Voikko, Hspell and AppleSpell, more easily share personal word-lists with other programs, and configure different spelling-checkers for different -languages. +languages. (Version 2.1.0 or later of Enchant is required.) ** Flymake @@ -1140,9 +1143,9 @@ similarly but it doesn't prepend a '.'. +++ ** Certain cond/pcase/cl-case forms are now compiled using a faster jump -table implementation. This uses a new bytecode op 'switch', which isn't -compatible with previous Emacs versions. This functionality can be disabled -by setting 'byte-compile-cond-use-jump-table' to nil. +table implementation. This uses a new bytecode op 'switch', which +isn't compatible with previous Emacs versions. This functionality can +be disabled by setting 'byte-compile-cond-use-jump-table' to nil. --- ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term @@ -1502,12 +1505,12 @@ avoids debugger like 'user-error'. +++ ** The function 'line-number-at-pos' now takes a second optional -argument 'absolute'. If this parameter is nil, the default, this +argument 'absolute'. If this parameter is nil, the default, this function keeps on returning the line number taking potential narrowing -into account. If this parameter is non-nil, the function ignores +into account. If this parameter is non-nil, the function ignores narrowing and returns the absolute line number. -** Changes in Frame- and Window- Handling +** Changes in Frame and Window Handling +++ *** Resizing a frame no longer runs 'window-configuration-change-hook'. @@ -1640,8 +1643,10 @@ assign window parameters to the window used for displaying the buffer. +++ *** New function 'display-buffer-reuse-mode-window' is an action function -suitable for use in 'display-buffer-alist'. For example, to avoid creating -a new window when opening man pages when there's already one, use +suitable for use in 'display-buffer-alist'. For example, to avoid +creating a new window when opening man pages when there's already one, +use + (add-to-list 'display-buffer-alist '("\\`\\*Man .*\\*\\'" . (display-buffer-reuse-mode-window commit b3400d82d430ccc76cb5cf5afa4f84c4635512ec Author: Eli Zaretskii Date: Wed Aug 30 19:23:59 2017 +0300 Sync NEWS with the documentation * etc/NEWS: Mark entries according to documentation. * doc/lispref/functions.texi (Mapping Functions): Document 'mapcan'. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 06de2e2f73..0d407ab966 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -930,11 +930,11 @@ the @code{call-interactively} function. @xref{Interactive Call}. A @dfn{mapping function} applies a given function (@emph{not} a special form or macro) to each element of a list or other collection. Emacs Lisp has several such functions; this section describes -@code{mapcar}, @code{mapc}, and @code{mapconcat}, which map over a -list. @xref{Definition of mapatoms}, for the function @code{mapatoms} -which maps over the symbols in an obarray. @xref{Definition of -maphash}, for the function @code{maphash} which maps over key/value -associations in a hash table. +@code{mapcar}, @code{mapc}, @code{mapconcat}, and @code{mapcan}, which +map over a list. @xref{Definition of mapatoms}, for the function +@code{mapatoms} which maps over the symbols in an obarray. +@xref{Definition of maphash}, for the function @code{maphash} which +maps over key/value associations in a hash table. These mapping functions do not allow char-tables because a char-table is a sparse array whose nominal range of indices is very large. To map @@ -986,6 +986,26 @@ Return the list of results." @end example @end defun +@defun mapcan function sequence +This function applies @var{function} to each element of +@var{sequence}, like @code{mapcar}, but instead of collecting the +results into a list, it returns a single list with all the elements of +the results (which must be lists), by altering the results (using +@code{nconc}; @pxref{Rearrangement}). Like with @code{mapcar}, +@var{sequence} can be of any type except a char-table. + +@group +@example +;; @r{Contrast this:} +(mapcar 'list '(a b c d)) + @result{} ((a) (b) (c) (d)) +;; @r{with this:} +(mapcan 'list '(a b c d)) + @result{} (a b c d) +@end example +@end group +@end defun + @defun mapc function sequence @code{mapc} is like @code{mapcar} except that @var{function} is used for side-effects only---the values it returns are ignored, not collected diff --git a/etc/NEWS b/etc/NEWS index d2016e1352..c152029fa4 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -152,6 +152,7 @@ given file is on a case-insensitive filesystem. of curved quotes for 'electric-quote-mode', allowing user to choose the types of quotes to be used. +--- ** The new user option 'electric-quote-context-sensitive' makes 'electric-quote-mode' context sensitive. If it is non-nil, you can type an ASCII apostrophe to insert an opening or closing quote, @@ -161,6 +162,7 @@ line, after a whitespace character, and after an opening parenthesis; and it will replace the apostrophe by a closing quote character in all other cases. +--- ** The new variable 'electric-quote-inhibit-functions' controls when to disable electric quoting based on context. Major modes can add functions to this list; Emacs will temporarily disable @@ -270,9 +272,6 @@ part of minibuffers. ** 'find-library' now takes a prefix argument to pop to a different window. ---- -** 'process-attributes' on Darwin systems now returns more information. - +++ ** Several accessors for the value returned by 'file-attributes' have been added. They are: 'file-attribute-type', @@ -316,13 +315,14 @@ to deal with asynchronous sockets is to avoid interacting with them until they have changed status to "run". This is most easily done from a process sentinel. +--- ** 'make-network-process' and 'open-network-stream' sometimes allowed :service to be an integer string (e.g., :service "993") and sometimes required an integer (e.g., :service 993). This difference has been eliminated, and integer strings work everywhere. +--- ** It is possible to disable attempted recovery on fatal signals. - Two new variables support disabling attempts to recover from stack overflow and to avoid automatic auto-save when Emacs is delivered a fatal signal. 'attempt-stack-overflow-recovery', if set to 'nil', @@ -337,11 +337,11 @@ probability of data corruption due to techniques Emacs uses to recover in these situations. +++ -** 'interrupt-process' consults now the list -'interrupt-process-functions', which function has to be called in -order to deliver the SIGINT signal. This allows Tramp to send the -SIGINT signal to remote asynchronous processes. The hitherto existing -implementation has been moved to 'internal-default-interrupt-process'. +** 'interrupt-process' now consults the list 'interrupt-process-functions', +to determine which function has to be called in order to deliver the +SIGINT signal. This allows Tramp to send the SIGINT signal to remote +asynchronous processes. The hitherto existing implementation has been +moved to 'internal-default-interrupt-process'. +++ ** File local and directory local variables are now initialized each @@ -383,8 +383,7 @@ The old behaviour of using 'prin1' can be restored by customizing the new option 'debugger-print-function'. +++ -** NUL bytes in strings copied to the system clipboard are now -replaced with "\0". +** NUL bytes in text copied to the system clipboard are now replaced with "\0". +++ ** The new variable 'x-ctrl-keysym' has been added to the existing @@ -418,14 +417,9 @@ want to reverse the direction of the scroll, customize 'mwheel-flip-direction'. +++ -** Emacsclient has a new option -u/--suppress-output. The option -suppresses display of return values from the server process. - ---- -** New user option 'dig-program-options' and extended functionality -for DNS-querying functions 'nslookup-host', 'dns-lookup-host', -and 'run-dig'. Each function now accepts an optional name server -argument interactively (with a prefix argument) and non-interactively. +** Emacsclient has a new option -u/--suppress-output. +This option suppresses display of return values from the server +process. +++ ** Emacsclient has a new option -T/--tramp. @@ -435,13 +429,21 @@ environment variable on a remote machine to emacsclient, and use the local Emacs to edit remote files via Tramp. See the node "emacsclient Options" in the user manual for the details. +--- +** New user option 'dig-program-options' and extended functionality +for DNS-querying functions 'nslookup-host', 'dns-lookup-host', +and 'run-dig'. Each function now accepts an optional name server +argument interactively (with a prefix argument) and non-interactively. + +++ ** 'describe-key-briefly' now ignores mouse movement events. +++ ** The new variable 'eval-expression-print-maximum-character' prevents -large integers from being displayed as characters. +large integers from being displayed as characters by 'M-:' and similar +commands. +--- ** Two new commands for finding the source code of Emacs Lisp libraries: 'find-library-other-window' and 'find-library-other-frame'. @@ -449,9 +451,11 @@ libraries: 'find-library-other-window' and 'find-library-other-frame'. ** The new variable 'display-raw-bytes-as-hex' allows to change the display of raw bytes from octal to hex. ++++ ** You can now provide explicit field numbers in format specifiers. For example, '(format "%2$s %1$s" "X" "Y")' produces "Y X". +--- ** 'comment-indent-function' values may now return a cons to specify a range of indentation. @@ -465,48 +469,9 @@ minor mode or the global `global-display-line-numbers-mode'. When using these modes, customize `display-line-numbers-type' with the same value as you would use with `display-line-numbers'. -If `display-line-numbers' is set to t, Emacs will display the number -of each line before the line. If set to 'relative', Emacs will -display the line number relative to the line showing point, with that -line's number displayed as absolute. If set to 'visual', Emacs will -display a relative number for every screen line, i.e. it will count -screen lines rather than buffer lines. The default is nil, which -doesn't display the line numbers. - -In 'relative' and 'visual' modes, the variable -'display-line-numbers-current-absolute' controls what number is -displayed for the line showing point. By default, this variable's -value is t, which means display the absolute line number for the line -showing point. Customizing this variable to a nil value will cause -Emacs to show zero instead, which preserves horizontal space of the -window in large buffers. - Line numbers are not displayed at all in minibuffer windows and in tooltips, as they are not useful there. -The new face 'line-number' is used to display the line numbers. The -new face 'line-number-current-line' can be customized to display the -current line's number differently from all the other line numbers; by -default these two faces are identical. - -You can also customize the new buffer-local variable -'display-line-numbers-width' to specify a fixed minimal with of the -area allocated to line-number display. The default is nil, meaning -that Emacs will dynamically calculate the area width, enlarging or -shrinking it as needed. Setting it to a non-negative integer -specifies that as the minimal width; selecting a value that is large -enough to display all line numbers in a buffer will then keep the -line-number display area of constant width at all times, if that is -desired. - -When using `display-line-numbers-mode', you can customize the variable -`display-line-numbers-grow-only' to a non-nil value; this means that -Emacs may grow the above area width dynamically, but never shrink it. -Under this mode, customizing the variable -`display-line-numbers-width-start' to a non-nil value will cause Emacs -to set `display-line-numbers-width' to the minimum width necessary to -display all line numbers in the current buffer when first visiting it. - Lisp programs can disable line-number display for a particular screen line by putting the 'display-line-numbers-disable' text property or overlay property on the first character of that screen line. This is @@ -563,16 +528,19 @@ line in *Occur* buffer. 'undo', undo the last replacement; bound to 'u'. 'undo-all', undo all replacements; bound to 'U'. +--- ** 'delete-trailing-whitespace' deletes whitespace after form feed. In modes where form feed was treated as a whitespace character, 'delete-trailing-whitespace' would keep lines containing it unchanged. It now deletes whitespace after the last form feed thus behaving the same as in modes where the character is not whitespace. -** No more prompt about changed file when the file's content is unchanged. -Instead of only checking the modification time, Emacs now also checks -the file's actual content before prompting the user. +--- +** Emacs no longer prompts about editing a changed file when the file's +content is unchanged. Instead of only checking the modification time, +Emacs now also checks the file's actual content before prompting the user. +--- ** Various casing improvements. *** 'upcase', 'upcase-region' et al. convert title case characters @@ -590,6 +558,7 @@ Strings such as ΌΣΟΣ are now correctly converted to Όσος when capitalized instead of incorrect Όσοσ (compare lowercase sigma at the end of the word). ++++ ** Emacs can now auto-save buffers to visited files in a more robust manner via the new mode 'auto-save-visited-mode'. Unlike 'auto-save-visited-file-name', this mode uses the normal saving @@ -605,6 +574,7 @@ Negative prefix arg flips the direction of selection. Also, defun are selected unless they are separated from the defun by a blank line. +--- ** New command 'replace-buffer-contents'. This command replaces the contents of the accessible portion of the current buffer with the contents of the accessible portion of a @@ -626,6 +596,7 @@ paragraphs, for the purposes of bidirectional display. * Changes in Specialized Modes and Packages in Emacs 26.1 +--- ** New function `cl-generic-p'. ** Dired @@ -638,22 +609,43 @@ remaining directories without more prompts. *** Dired supports wildcards in the directory part of the file names. +++ -*** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced -by the current file name. +*** You can now use '`?`' in 'dired-do-shell-command'. +It gets replaced by the current file name, like ' ? '. -*** html2text is now marked obsolete. ++++ +*** A new option 'dired-always-read-filesystem' default to nil. +If non-nil, buffers visiting files are reverted before search them; +for instance, in 'dired-mark-files-containing-regexp' a non-nil value +of this option means the file is revisited in a temporary buffer; +this temporary buffer is the actual buffer searched: the original buffer +visiting the file is not modified. -*** smerge-refine-regions can refine regions in separate buffers ++++ +*** In wdired, when editing files to contain slash characters, +the resulting directories are automatically created. Whether to do +this is controlled by the 'wdired-create-parent-directories' variable. -*** Info menu and index completion uses substring completion by default. ++++ +*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for +viewing HTML files and the like. + +--- +** html2text is now marked obsolete. + +--- +** smerge-refine-regions can refine regions in separate buffers + +--- +** Info menu and index completion uses substring completion by default. This can be customized via the info-menu category in completion-category-override. +++ -*** The ancestor buffer is shown by default in 3way merges. +** The ancestor buffer is shown by default in 3way merges. A new option ediff-show-ancestor and a new toggle ediff-toggle-show-ancestor. +--- ** TeX: Add luatex and xetex as alternatives to pdftex ** Electric-Buffer-menu @@ -742,6 +734,7 @@ whose content matches a regexp; bound to '% g'. ** Browse-URL +--- *** Support for opening links to man pages in Man or WoMan mode. ** Comint @@ -760,23 +753,6 @@ where to place point after C-c M-r and C-c M-s. displayed in the mode line. These are updated as compilation proceeds. -+++ -*** A new option 'dired-always-read-filesystem' default to nil. -If non-nil, buffers visiting files are reverted before search them; -for instance, in 'dired-mark-files-containing-regexp' a non-nil value -of this option means the file is revisited in a temporary buffer; -this temporary buffer is the actual buffer searched: the original buffer -visiting the file is not modified. - -+++ -*** In wdired, when editing files to contain slash characters, -the resulting directories are automatically created. Whether to do -this is controlled by the 'wdired-create-parent-directories' variable. - -+++ -*** 'W' is now bound to 'browse-url-of-dired-file', and is useful for -viewing HTML files and the like. - ** Grep --- @@ -785,12 +761,14 @@ available, which allows distinguishing the filename from contents if they contain colons. This can be controlled by the new custom option 'grep-use-null-filename-separator'. +--- *** The grep/rgrep/lgrep functions will now ask about saving files before running. This is controlled by the 'grep-save-buffers' variable. ** Edebug +--- *** Edebug can be prevented from pausing 1 second after reaching a breakpoint (e.g. with "f" and "o") by customizing the new option 'edebug-sit-on-break'. @@ -802,6 +780,7 @@ code. ** Eshell +--- *** 'eshell-input-filter's value is now a named function 'eshell-input-filter-default', and has a new custom option 'eshell-input-filter-initial-space' to ignore adding commands prefixed @@ -840,6 +819,7 @@ avoid accidentally accessing remote links may rebind 'w' and 'u' in ** Ido +--- *** The commands 'find-alternate-file-other-window', 'dired-other-window', 'dired-other-frame', and 'display-buffer-other-window' are now remapped to Ido equivalents if @@ -884,20 +864,25 @@ at image boundaries. ** Image-Dired +--- *** Now provides a minor mode 'image-dired-minor-mode' which replaces the function 'image-dired-setup-dired-keybindings'. +--- *** Thumbnail generation is now asynchronous The number of concurrent processes is limited by the variable 'image-dired-thumb-job-limit'. +--- *** 'image-dired-thumbnail-storage' has a new option 'standard-large' for generating 256x256 thumbnails according to the Thumbnail Managing Standard. +--- *** Inherits movement keys from 'image-mode' for viewing full images. This includes the usual char, line, and page movement commands. +--- *** All the -options types have been changed to argument lists instead of shell command strings. This change affects 'image-dired-cmd-create-thumbnail-options', @@ -909,8 +894,10 @@ instead of shell command strings. This change affects 'image-dired-cmd-pngnq-options', 'image-dired-cmd-pngcrush-options', 'image-dired-cmd-create-standard-thumbnail-options' +--- *** Recognizes more tools by default, including pngnq-s9 and OptiPNG +--- *** 'find-file' and related commands now work on thumbnails and displayed images, providing a default argument of the original file name via an addition to 'file-name-at-point-functions'. @@ -1054,6 +1041,7 @@ provide indentation should use 'prog-widen' instead of 'widen' and ** ERC +--- *** New variable 'erc-default-port-tls' used to connect to TLS IRC servers. @@ -1087,6 +1075,7 @@ branch-related commands on a keymap bound to 'B'. ** CC mode +--- *** Opening a .h file will turn C or C++ mode depending on language used. This is done with the help of 'c-or-c++-mode' function which analyses contents of the buffer to determine whether it's a C or C++ source @@ -1110,8 +1099,7 @@ languages. ** Flymake +++ -*** Emacs does no longer prompt the user before killing Flymake -processes on exit. +*** Emacs no longer prompts the user before killing Flymake processes on exit. * New Modes and Packages in Emacs 26.1 @@ -1141,6 +1129,7 @@ editing Less files. * Incompatible Lisp Changes in Emacs 26.1 +--- *** password-data is now a hash-table so that `password-read' can use any object for the `key' argument. @@ -1155,6 +1144,7 @@ table implementation. This uses a new bytecode op 'switch', which isn't compatible with previous Emacs versions. This functionality can be disabled by setting 'byte-compile-cond-use-jump-table' to nil. +--- ** 'C-up', 'C-down', 'C-left' and 'C-right' are now defined in term mode to send the same escape sequences that xterm does. This makes things like forward-word in readline work. @@ -1170,6 +1160,7 @@ Instead, text properties are added by query-replace-read-from. Additionally, the new nil value restores pre-24.5 behavior of not providing replacement pairs via the history. +--- ** Some obsolete functions, variables, and faces have been removed: *** make-variable-frame-local. Variables cannot be frame-local any more. *** From subr.el: window-dot, set-window-dot, read-input, show-buffer, @@ -1200,6 +1191,7 @@ of curved quotes in format arguments to functions like 'message' and 'format-message'. In particular, when this variable's value is 'grave', all quotes in formats are output as-is. +--- ** Functions like 'check-declare-file' and 'check-declare-directory' now generate less chatter and more-compact diagnostics. The auxiliary function 'check-declare-errmsg' has been removed. @@ -1211,17 +1203,18 @@ Standard #18. If you only want to match space and tab, use [ \t] instead. +++ -** 'min' and 'max' no longer round their results. Formerly, they -returned a floating-point value if any argument was floating-point, -which was sometimes numerically incorrect. For example, on a 64-bit -host (max 1e16 10000000000000001) now returns its second argument -instead of its first. +** 'min' and 'max' no longer round their results. +Formerly, they returned a floating-point value if any argument was +floating-point, which was sometimes numerically incorrect. For +example, on a 64-bit host (max 1e16 10000000000000001) now returns its +second argument instead of its first. +++ ** The variable 'old-style-backquotes' has been made internal and renamed to 'lread--old-style-backquotes'. No user code should use this variable. +--- ** To avoid confusion caused by "smart quotes", the reader no longer accepts Lisp symbols which begin with the following quotation characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. @@ -1238,15 +1231,18 @@ longer quietly mutate the target of a local symbolic link, so that Emacs can access and copy them reliably regardless of their contents. The following changes are involved. +--- *** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to symbolic links whose targets begin with "/" and contain ":". For example, if a symbolic link "x" has a target "/y:z", (file-symlink-p "x") now returns "/y:z" rather than "/:/y:z". +--- *** 'make-symbolic-link' no longer looks for file name handlers when creating a local symbolic link. For example, (make-symbolic-link "/y:z" "x") now creates a symlink to "/y:z" instead of failing. ++++ *** 'make-symbolic-link' now expands a link target with leading "~" only when the optional third arg is an integer, as when invoked interactively. For example, (make-symbolic-link "~y" "x") now creates @@ -1266,6 +1262,7 @@ break. ** The arguments LOCKNAME and MUSTBENEW of 'write-region' are propagated to file name handlers now. +--- ** When built against recent versions of GTK+, Emacs always uses gtk_window_move for moving frames and ignores the value of the variable 'x-gtk-use-window-move'. The variable is now obsolete. @@ -1273,13 +1270,16 @@ variable 'x-gtk-use-window-move'. The variable is now obsolete. * Lisp Changes in Emacs 26.1 ++++ ** New optional argument TEXT in 'make-temp-file'. +--- ** New function `define-symbol-prop'. +++ ** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. ++++ ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. @@ -1309,19 +1309,25 @@ to decide which buffers to ask about, if the PRED argument is nil. The default value of 'save-some-buffers-default-predicate' is nil, which means ask about all file-visiting buffers. +--- ** string-(to|as|make)-(uni|multi)byte are now declared obsolete. + ++++ ** New variable 'while-no-input-ignore-events' which allow setting which special events 'while-no-input' should ignore. It is a list of symbols. +--- ** New function 'undo-amalgamate-change-group' to get rid of undo-boundaries between two states. +--- ** New var 'definition-prefixes' is a hash table mapping prefixes to the files where corresponding definitions can be found. This can be used to fetch definitions that are not yet loaded, for example for 'C-h f'. +--- ** New var 'syntax-ppss-table' to control the syntax-table used in 'syntax-ppss'. @@ -1331,6 +1337,7 @@ gets evaluated after the new mode's hook has run. This can be used to incorporate configuration changes made in the mode hook into the mode's setup. +--- ** Autoload files can be generated without timestamps, by setting 'autoload-timestamps' to nil. FIXME As an experiment, nil is the current default. @@ -1354,6 +1361,7 @@ of an arbitrary function. This generalizes 'subr-arity' for functions that are not built-in primitives. We recommend using this new function instead of 'subr-arity'. +--- ** New function 'region-bounds' can be used in the interactive spec to provide region boundaries (for rectangular regions more than one) to an interactively callable function as a single argument instead of @@ -1375,6 +1383,7 @@ outermost parenthesis. ** 'read-color' will now display the color names using the color itself as the background color. +--- ** The function 'redirect-debugging-output' now works on platforms other than GNU/Linux. @@ -1443,8 +1452,9 @@ ABBR is a time zone abbreviation. The affected functions are +++ ** 'format-time-string' now formats "%q" to the calendar quarter. -** New built-in function 'mapcan' which avoids unnecessary consing (and garbage -collection). ++++ +** New built-in function 'mapcan'. +It avoids unnecessary consing (and garbage collection). +++ ** 'car' and 'cdr' compositions 'cXXXr' and 'cXXXXr' are now part of Elisp. @@ -1453,6 +1463,7 @@ collection). ** 'if-let*', 'when-let*', and 'and-let*' are new in subr-x.el. The incumbent 'if-let' and 'when-let' are now aliases. +--- ** Low-level list functions like 'length' and 'member' now do a better job of signaling list cycles instead of looping indefinitely. @@ -1609,12 +1620,13 @@ internal border. WINDOW for redisplay. +++ -*** Support for side windows is now official. The display action -function 'display-buffer-in-side-window' will display its buffer in a -side window. Functions for toggling all side windows on a frame, -changing and reversing the layout of side windows and returning the main -(major non-side) window of a frame are provided. For details consult -the section "Side Windows" in the Elisp manual. +*** Support for side windows is now official. +The display action function 'display-buffer-in-side-window' will +display its buffer in a side window. Functions for toggling all side +windows on a frame, changing and reversing the layout of side windows +and returning the main (major non-side) window of a frame are +provided. For details consult the section "Side Windows" in the Elisp +manual. +++ *** Support for atomic windows - rectangular compositions of windows @@ -1671,12 +1683,13 @@ manual. ** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality can be replicated simply by setting 'comment-auto-fill-only-comments'. -** New pcase pattern 'rx' to match against a rx-style regular -expression. +** New pcase pattern 'rx' to match against a rx-style regular expression. +For details, see the doc string of 'rx--pcase-macroexpander'. * Changes in Emacs 26.1 on Non-Free Operating Systems ++++ ** Intercepting hotkeys on Windows 7 and later now works better. The new keyboard hooking code properly grabs system hotkeys such as Win-* and Alt-TAB, in a way that Emacs can get at them before the @@ -1686,6 +1699,7 @@ Windows NT and later you can now register any hotkey combination. (On Windows 9X, the previous limitations, spelled out in the Emacs manual, still apply.) +--- ** 'convert-standard-filename' no longer mirrors slashes on MS-Windows. Previously, on MS-Windows this function converted slash characters in file names into backslashes. It no longer does that. If your Lisp @@ -1699,7 +1713,8 @@ code. One possible way is this: (aset file-name (match-beginning 0) ?\\) (setq start (match-end 0)))) -** GUI sessions now treat SIGINT like Posix platforms do. +--- +** GUI sessions on MS-Windows now treat SIGINT like Posix platforms do. The effect of delivering a Ctrl-C (SIGINT) signal to a GUI Emacs on MS-Windows is now the same as on Posix platforms -- Emacs saves the session and exits. In particular, this will happen if you start @@ -1716,17 +1731,24 @@ This is in contrast to the default action on POSIX Systems, where it causes the receiving process to terminate with a core dump if no debugger has been attached to it. +--- ** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work on macOS. +--- ** Emacs can now be run as a GUI application from the command line on macOS. ++++ ** 'ns-appearance' and 'ns-transparent-titlebar' change the appearance of frame decorations on macOS 10.9+. +--- ** 'ns-use-thin-smoothing' enables thin font smoothing on macOS 10.8+. +--- +** 'process-attributes' on Darwin systems now returns more information. + ---------------------------------------------------------------------- This file is part of GNU Emacs. commit 9376ea3f6c736f62cc064088b2e020a9f89bae63 Author: Michael Albinus Date: Wed Aug 30 12:00:26 2017 +0200 Improve symlinks for Tramp * lisp/files.el (files--splice-dirname-file): Quote whole file. * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link): Do not expand TARGET, it could be remote. (tramp-sh-handle-file-truename): Check for cyclic symlink also in case of readlink. Quote result if it looks remote. (tramp-sh-handle-file-local-copy): Use `file-truename'. * test/lisp/net/tramp-tests.el (tramp-test08-file-local-copy) (tramp-test09-insert-file-contents): Test also file missing. (tramp-test21-file-links): Extend test. diff --git a/lisp/files.el b/lisp/files.el index 7754be2964..8cec3d45dc 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1165,7 +1165,8 @@ directory name and leading `~' and `/:' are not special in FILE." (if (eq (find-file-name-handler dirname 'file-symlink-p) (find-file-name-handler file 'file-symlink-p)) file - (file-name-quote file)) + ;; If `file' is remote, we want to quote it at the beginning. + (let (file-name-handler-alist) (file-name-quote file))) (concat dirname file))) (defun file-truename (filename &optional counter prev-dirs) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6494b0957b..85966f122d 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1086,7 +1086,7 @@ component is used as the target of the symlink." ;; If TARGET is a Tramp name, use just the localname component. (when (and (tramp-tramp-file-p target) (tramp-file-name-equal-p - v (tramp-dissect-file-name (expand-file-name target)))) + v (tramp-dissect-file-name target))) (setq target (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name target))))) @@ -1132,7 +1132,12 @@ component is used as the target of the symlink." (tramp-shell-quote-argument localname))) (with-current-buffer (tramp-get-connection-buffer v) (goto-char (point-min)) - (setq result (buffer-substring (point-min) (point-at-eol))))) + (setq result (buffer-substring (point-min) (point-at-eol)))) + (when (and (file-symlink-p filename) + (string-equal result localname)) + (tramp-error + v 'file-error + "Apparent cycle of symbolic links for %s" filename))) ;; Use Perl implementation. ((and (tramp-get-remote-perl v) @@ -1214,8 +1219,11 @@ component is used as the target of the symlink." "/")) (when (string= "" result) (setq result "/"))))) - - (when quoted (setq result (tramp-compat-file-name-quote result))) + ;; If the resulting localname looks remote, we must quote it + ;; for security reasons. + (when (or quoted (file-remote-p result)) + (let (file-name-handler-alist) + (setq result (tramp-compat-file-name-quote result)))) (tramp-message v 4 "True name of `%s' is `%s'" localname result) result)))) @@ -3072,7 +3080,7 @@ the result will be a local, non-Tramp, file name." (defun tramp-sh-handle-file-local-copy (filename) "Like `file-local-copy' for Tramp files." (with-parsed-tramp-file-name filename nil - (unless (file-exists-p filename) + (unless (file-exists-p (file-truename filename)) (tramp-error v tramp-file-missing "Cannot make local copy of non-existing file `%s'" filename)) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 201ac10dcc..662163f3fe 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1762,7 +1762,13 @@ This checks also `file-name-as-directory', `file-name-directory', (tramp-copy-size-limit 4) (tramp-inline-compress-start-size 2)) (delete-file tmp-name2) - (should (setq tmp-name2 (file-local-copy tmp-name1))))) + (should (setq tmp-name2 (file-local-copy tmp-name1)))) + ;; Error case. + (delete-file tmp-name1) + (delete-file tmp-name2) + (should-error + (setq tmp-name2 (file-local-copy tmp-name1)) + :type tramp-file-missing)) ;; Cleanup. (ignore-errors @@ -1776,19 +1782,23 @@ This checks also `file-name-as-directory', `file-name-directory', (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted))) (unwind-protect - (progn + (with-temp-buffer (write-region "foo" nil tmp-name) - (with-temp-buffer - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foo")) - (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "foofoo")) - ;; Insert partly. - (insert-file-contents tmp-name nil 1 3) - (should (string-equal (buffer-string) "oofoofoo")) - ;; Replace. - (insert-file-contents tmp-name nil nil nil 'replace) - (should (string-equal (buffer-string) "foo")))) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foo")) + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foofoo")) + ;; Insert partly. + (insert-file-contents tmp-name nil 1 3) + (should (string-equal (buffer-string) "oofoofoo")) + ;; Replace. + (insert-file-contents tmp-name nil nil nil 'replace) + (should (string-equal (buffer-string) "foo")) + ;; Error case. + (delete-file tmp-name) + (should-error + (insert-file-contents tmp-name) + :type tramp-file-missing)) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) @@ -2681,6 +2691,16 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) (should (file-equal-p tmp-name1 tmp-name2)) + ;; Symbolic links could look like a remote file name. + ;; They must be quoted then. + (delete-file tmp-name2) + (make-symbolic-link "/penguin:motd:" tmp-name2) + (should (file-symlink-p tmp-name2)) + (should + (string-equal + (file-truename tmp-name2) + (tramp-compat-file-name-quote + (concat (file-remote-p tmp-name2) "/penguin:motd:")))) ;; `tmp-name3' is a local file name. (make-symbolic-link tmp-name1 tmp-name3) (should (file-symlink-p tmp-name3)) @@ -2698,6 +2718,48 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (delete-file tmp-name2) (delete-file tmp-name3))) + ;; Symbolic links could be nested. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (make-directory tmp-name1) + (should (file-directory-p tmp-name1)) + (let* ((tramp-test-temporary-file-directory + (file-truename tmp-name1)) + (tmp-name2 (tramp--test-make-temp-name nil quoted)) + (tmp-name3 tmp-name2) + (number-nesting 50)) + (dotimes (_ number-nesting) + (make-symbolic-link + tmp-name3 + (setq tmp-name3 (tramp--test-make-temp-name nil quoted)))) + (should + (string-equal + (file-truename tmp-name2) + (file-truename tmp-name3))) + (should-error + (with-temp-buffer (insert-file-contents tmp-name2)) + :type tramp-file-missing) + (should-error + (with-temp-buffer (insert-file-contents tmp-name3)) + :type tramp-file-missing))) + + ;; Cleanup. + (ignore-errors (delete-directory tmp-name1 'recursive))) + + ;; Detect cyclic symbolic links. + (unwind-protect + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link tmp-name2 tmp-name1) + (should (file-symlink-p tmp-name1)) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-symlink-p tmp-name2)) + (should-error (file-truename tmp-name1) :type 'file-error)) + + ;; Cleanup. + (ignore-errors + (delete-file tmp-name1) + (delete-file tmp-name2))) + ;; `file-truename' shall preserve trailing link of directories. (unless (file-symlink-p tramp-test-temporary-file-directory) (let* ((dir1 (directory-file-name tramp-test-temporary-file-directory)) @@ -4019,7 +4081,7 @@ process sentinels. They shall not disturb each other." ;; Create temporary buffers. The number of buffers ;; corresponds to the number of processes; it could be ;; increased in order to make pressure on Tramp. - (dotimes (_i number-proc) + (dotimes (_ number-proc) (setq buffers (cons (generate-new-buffer "foo") buffers))) ;; Open asynchronous processes. Set process filter and sentinel. commit 9ef61c17af49886d150b938f51040ff3a1da1c80 Author: Martin Rudalics Date: Wed Aug 30 10:27:36 2017 +0200 Preserve display's foreground color when clearing internal borders (Bug#28278) * src/xterm.c (x_after_update_window_line): Preserve display's foreground color when clearing internal borders (Bug#28278). diff --git a/src/xterm.c b/src/xterm.c index eff1519bf4..64e89708b2 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -1382,12 +1382,13 @@ x_after_update_window_line (struct window *w, struct glyph_row *desired_row) { unsigned long color = face->background; Display *display = FRAME_X_DISPLAY (f); + GC gc = f->output_data.x->normal_gc; - XSetForeground (display, f->output_data.x->normal_gc, color); - x_fill_rectangle (f, f->output_data.x->normal_gc, - 0, y, width, height); - x_fill_rectangle (f, f->output_data.x->normal_gc, - FRAME_PIXEL_WIDTH (f) - width, y, width, height); + XSetForeground (display, gc, color); + x_fill_rectangle (f, gc, 0, y, width, height); + x_fill_rectangle (f, gc, FRAME_PIXEL_WIDTH (f) - width, y, + width, height); + XSetForeground (display, gc, FRAME_FOREGROUND_PIXEL (f)); } else { commit 8710d11b481f3e6ec88276e11b12665983f0468f Author: Noam Postavsky Date: Tue Aug 29 21:59:42 2017 -0400 Use cl-print for all values printed by `describe-variable' * lisp/help-fns.el (describe-variable): Use cl-prin1 for original and global values too. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index cb0b2d71d3..15b2c07ba2 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -883,7 +883,10 @@ it is displayed along with the global value." (not (equal origval :help-eval-error))) (princ "\nOriginal value was \n") (setq from (point)) - (pp origval) + (cl-prin1 origval) + (save-restriction + (narrow-to-region from (point)) + (save-excursion (pp-buffer))) (if (< (point) (+ from 20)) (delete-region (1- from) from))))))) (terpri) @@ -909,7 +912,10 @@ it is displayed along with the global value." ;; probably print it raw once and check it's a ;; sensible size before prettyprinting. -- fx (let ((from (point))) - (pp global-val) + (cl-prin1 global-val) + (save-restriction + (narrow-to-region from (point)) + (save-excursion (pp-buffer))) ;; See previous comment for this function. ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) commit 112fbe35153b2cb66b4daca32a84b18192c814db Author: Noam Postavsky Date: Sun Aug 13 10:06:45 2017 -0400 Minor simplification for byte-compile-constant-push * lisp/emacs-lisp/bytecomp.el (byte-compile-constant): Move the meat of the code from here... (byte-compile-constant-push): ... to here. No need to bind byte-compile--for-effect anymore. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 48bbd61871..dc8839e6f9 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3342,15 +3342,14 @@ for symbols generated by the byte compiler itself." (defun byte-compile-constant (const) (if byte-compile--for-effect (setq byte-compile--for-effect nil) - (when (symbolp const) - (byte-compile-set-symbol-position const)) - (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) + (inline (byte-compile-push-constant const)))) ;; Use this for a constant that is not the value of its containing form. ;; This ignores byte-compile--for-effect. (defun byte-compile-push-constant (const) - (let ((byte-compile--for-effect nil)) - (inline (byte-compile-constant const)))) + (when (symbolp const) + (byte-compile-set-symbol-position const)) + (byte-compile-out 'byte-constant (byte-compile-get-constant const))) ;; Compile those primitive ordinary functions ;; which have special byte codes just for speed. commit 70bb510a7eb1a3010cfa034884b7e5ab2063ece3 Author: Paul Eggert Date: Tue Aug 29 19:17:54 2017 -0700 Prefer file-name-quote to concat "/:" Suggested by Michael Albinus (Bug#28264#13). * lisp/files.el (files--splice-dirname-file): Use file-name-quote rather than attempting to do it by hand. diff --git a/lisp/files.el b/lisp/files.el index 5f55aa75a7..7754be2964 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1156,16 +1156,16 @@ names beginning with `~'." (defun files--splice-dirname-file (dirname file) "Splice DIRNAME to FILE like the operating system would. If FILENAME is relative, return DIRNAME concatenated to FILE. -Otherwise return FILE, quoted with `/:' if DIRNAME and FILE have +Otherwise return FILE, quoted as needed if DIRNAME and FILE have different handlers; although this quoting is dubious if DIRNAME -is remote, it is not clear what would be better. This function +is magic, it is not clear what would be better. This function differs from `expand-file-name' in that DIRNAME must be a directory name and leading `~' and `/:' are not special in FILE." (if (files--name-absolute-system-p file) (if (eq (find-file-name-handler dirname 'file-symlink-p) (find-file-name-handler file 'file-symlink-p)) file - (concat "/:" file)) + (file-name-quote file)) (concat dirname file))) (defun file-truename (filename &optional counter prev-dirs) commit 0001ff27c4a114fdfe75c8e35b0970ecd939a53d Author: Paul Eggert Date: Tue Aug 29 18:56:36 2017 -0700 * configure.ac: fix typo in previous change diff --git a/configure.ac b/configure.ac index 609ecdc8f1..2e0b416053 100644 --- a/configure.ac +++ b/configure.ac @@ -1042,7 +1042,7 @@ edit_cflags=" AC_ARG_ENABLE(link-time-optimization, [AS_HELP_STRING([--enable-link-time-optimization], [build with link-time optimization - (experimental; see INSTALL)])]) + (experimental; see INSTALL)])], if test "${enableval}" != "no"; then ac_lto_supported=no if test "$emacs_cv_clang" = yes; then commit 9b4b2e9fc8dfd37ad8f44940a16330c477f896ea Author: Paul Eggert Date: Tue Aug 29 14:52:57 2017 -0700 Be more conservative in link time optimization doc While testing --enable-link-time-optimization with GCC 7.1.1 I ran into a serious GCC code-generation bug which makes me think that --enable-link-time-optimization should be discouraged for typical installs (Bug#28213). See: https://bugzilla.redhat.com/show_bug.cgi?id=1486455 diff --git a/INSTALL b/INSTALL index 33084b9da3..b018055f02 100644 --- a/INSTALL +++ b/INSTALL @@ -339,17 +339,13 @@ Use --disable-silent-rules to cause 'make' to give more details about the commands it executes. This can be helpful when debugging a build that goes awry. 'make V=1' also enables the extra chatter. -Use --enable-link-time-optimization to enable link-time optimizer. If -you're using GNU compiler, this feature is supported since version 4.5.0. -If 'configure' can determine number of online CPUS on your system, final -link-time optimization and code generation is executed in parallel using -one job per each available online CPU. - -This option is also supported for clang. You should have GNU binutils -with 'gold' linker and plugin support, and clang with LLVMgold.so plugin. -Read http://llvm.org/docs/GoldPlugin.html for details. Also note that -this feature is still experimental, so prepare to build binutils and -clang from the corresponding source code repositories. +Use --enable-link-time-optimization to enable link-time optimization. +With GCC, you need GCC 4.5.0 and later, and 'configure' arranges for +linking to be parallelized if possible. With Clang, you need GNU +binutils with the gold linker and plugin support, along with the LLVM +gold plugin . Link time +optimization is not the default as it tends to cause crashes and to +make Emacs slower. The '--prefix=PREFIXDIR' option specifies where the installation process should put emacs and its data files. This defaults to '/usr/local'. diff --git a/configure.ac b/configure.ac index 3dee40704d..609ecdc8f1 100644 --- a/configure.ac +++ b/configure.ac @@ -1041,12 +1041,8 @@ edit_cflags=" AC_ARG_ENABLE(link-time-optimization, [AS_HELP_STRING([--enable-link-time-optimization], - [build emacs with link-time optimization. - This requires GCC 4.5.0 or later, or clang. - (Note that clang support is experimental - see INSTALL.) - It also makes Emacs harder to debug, and when we tried it - with GCC 4.9.0 x86-64 it made Emacs slower, so it's not - recommended for typical use.])], + [build with link-time optimization + (experimental; see INSTALL)])]) if test "${enableval}" != "no"; then ac_lto_supported=no if test "$emacs_cv_clang" = yes; then commit e13bdfee1742a7cc1eff5dc3bfbe2d71ea3532ef Author: Paul Eggert Date: Tue Aug 29 14:35:37 2017 -0700 Make garbage collection more conservative Check for a pointer anywhere within the object, as opposed to just the start of the object. This is needed for gcc -Os -flto on x86-64 (Bug#28213). This change means that the garbage collector is more conservative, and will incorrectly keep objects that it does not need to, but that is better than incorrectly discarding objects that should be kept. * src/alloc.c (ADVANCE, VINDEX): Now functions, not macros; this is easier to debug. (setup_on_free_list): Rename from SETUP_ON_FREE_LIST. Now a function with two args, not a macro with three. All callers changed. (live_string_holding, live_cons_holding, live_symbol_holding) (live_misc_holding, live_vector_holding, live_buffer_holding): New functions, which check for any object containing the addressed byte, not just for an object at the given address. (live_string_p, live_cons_p, live_symbol_p, live_misc_p) (live_vector_p, live_buffer_p): Redefine in terms of the new functions. (live_float_p): Refactor slightly to match the new functions. (mark_maybe_object, mark_maybe_pointer): Use the new functions. Don’t bother checking mark bits, as mark_object already does that, and omitting the checks here simplifies the code. Although mark_maybe_object can continue to insist that tagged pointers still address the start of the object, mark_maybe_pointer now is more conservative and checks for pointers anywhere into an object. diff --git a/src/alloc.c b/src/alloc.c index 6e57b2024b..300f5e420d 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2961,25 +2961,23 @@ verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS)); /* Common shortcut to advance vector pointer over a block data. */ -#define ADVANCE(v, nbytes) ((struct Lisp_Vector *) ((char *) (v) + (nbytes))) +static struct Lisp_Vector * +ADVANCE (struct Lisp_Vector *v, ptrdiff_t nbytes) +{ + void *vv = v; + char *cv = vv; + void *p = cv + nbytes; + return p; +} /* Common shortcut to calculate NBYTES-vector index in VECTOR_FREE_LISTS. */ -#define VINDEX(nbytes) (((nbytes) - VBLOCK_BYTES_MIN) / roundup_size) - -/* Common shortcut to setup vector on a free list. */ - -#define SETUP_ON_FREE_LIST(v, nbytes, tmp) \ - do { \ - (tmp) = ((nbytes - header_size) / word_size); \ - XSETPVECTYPESIZE (v, PVEC_FREE, 0, (tmp)); \ - eassert ((nbytes) % roundup_size == 0); \ - (tmp) = VINDEX (nbytes); \ - eassert ((tmp) < VECTOR_MAX_FREE_LIST_INDEX); \ - set_next_vector (v, vector_free_lists[tmp]); \ - vector_free_lists[tmp] = (v); \ - total_free_vector_slots += (nbytes) / word_size; \ - } while (0) +static ptrdiff_t +VINDEX (ptrdiff_t nbytes) +{ + eassume (VBLOCK_BYTES_MIN <= nbytes); + return (nbytes - VBLOCK_BYTES_MIN) / roundup_size; +} /* This internal type is used to maintain the list of large vectors which are allocated at their own, e.g. outside of vector blocks. @@ -3041,6 +3039,22 @@ static EMACS_INT total_vectors; static EMACS_INT total_vector_slots, total_free_vector_slots; +/* Common shortcut to setup vector on a free list. */ + +static void +setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) +{ + eassume (header_size <= nbytes); + ptrdiff_t nwords = (nbytes - header_size) / word_size; + XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords); + eassert (nbytes % roundup_size == 0); + ptrdiff_t vindex = VINDEX (nbytes); + eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX); + set_next_vector (v, vector_free_lists[vindex]); + vector_free_lists[vindex] = v; + total_free_vector_slots += nbytes / word_size; +} + /* Get a new vector block. */ static struct vector_block * @@ -3105,7 +3119,7 @@ allocate_vector_from_block (size_t nbytes) which should be set on an appropriate free list. */ restbytes = index * roundup_size + VBLOCK_BYTES_MIN - nbytes; eassert (restbytes % roundup_size == 0); - SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); + setup_on_free_list (ADVANCE (vector, nbytes), restbytes); return vector; } @@ -3121,7 +3135,7 @@ allocate_vector_from_block (size_t nbytes) if (restbytes >= VBLOCK_BYTES_MIN) { eassert (restbytes % roundup_size == 0); - SETUP_ON_FREE_LIST (ADVANCE (vector, nbytes), restbytes, index); + setup_on_free_list (ADVANCE (vector, nbytes), restbytes); } return vector; } @@ -3253,10 +3267,7 @@ sweep_vectors (void) space was coalesced into the only free vector. */ free_this_block = 1; else - { - size_t tmp; - SETUP_ON_FREE_LIST (vector, total_bytes, tmp); - } + setup_on_free_list (vector, total_bytes); } } @@ -4171,7 +4182,7 @@ refill_memory_reserve (void) block to the red-black tree with calls to mem_insert, and function lisp_free removes it with mem_delete. Functions live_string_p etc call mem_find to lookup information about a given pointer in the - tree, and use that to determine if the pointer points to a Lisp + tree, and use that to determine if the pointer points into a Lisp object or not. */ /* Initialize this part of alloc.c. */ @@ -4549,82 +4560,113 @@ mem_delete_fixup (struct mem_node *x) } -/* Value is non-zero if P is a pointer to a live Lisp string on - the heap. M is a pointer to the mem_block for P. */ +/* If P is a pointer into a live Lisp string object on the heap, + return the object. Otherwise, return nil. M is a pointer to the + mem_block for P. -static bool -live_string_p (struct mem_node *m, void *p) + This and other *_holding functions look for a pointer anywhere into + the object, not merely for a pointer to the start of the object, + because some compilers sometimes optimize away the latter. See + Bug#28213. */ + +static Lisp_Object +live_string_holding (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_STRING) { struct string_block *b = m->start; - ptrdiff_t offset = (char *) p - (char *) &b->strings[0]; + char *cp = p; + ptrdiff_t offset = cp - (char *) &b->strings[0]; - /* P must point to the start of a Lisp_String structure, and it + /* P must point into a Lisp_String structure, and it must not be on the free-list. */ - return (offset >= 0 - && offset % sizeof b->strings[0] == 0 - && offset < (STRING_BLOCK_SIZE * sizeof b->strings[0]) - && ((struct Lisp_String *) p)->data != NULL); + if (0 <= offset && offset < STRING_BLOCK_SIZE * sizeof b->strings[0]) + { + struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; + if (s->data) + return make_lisp_ptr (s, Lisp_String); + } } - else - return 0; + return Qnil; } +static bool +live_string_p (struct mem_node *m, void *p) +{ + return !NILP (live_string_holding (m, p)); +} -/* Value is non-zero if P is a pointer to a live Lisp cons on - the heap. M is a pointer to the mem_block for P. */ +/* If P is a pointer into a live Lisp cons object on the heap, return + the object. Otherwise, return nil. M is a pointer to the + mem_block for P. */ -static bool -live_cons_p (struct mem_node *m, void *p) +static Lisp_Object +live_cons_holding (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_CONS) { struct cons_block *b = m->start; - ptrdiff_t offset = (char *) p - (char *) &b->conses[0]; + char *cp = p; + ptrdiff_t offset = cp - (char *) &b->conses[0]; - /* P must point to the start of a Lisp_Cons, not be + /* P must point into a Lisp_Cons, not be one of the unused cells in the current cons block, and not be on the free-list. */ - return (offset >= 0 - && offset % sizeof b->conses[0] == 0 - && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) - && (b != cons_block - || offset / sizeof b->conses[0] < cons_block_index) - && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); + if (0 <= offset && offset < CONS_BLOCK_SIZE * sizeof b->conses[0] + && (b != cons_block + || offset / sizeof b->conses[0] < cons_block_index)) + { + struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; + if (!EQ (s->car, Vdead)) + return make_lisp_ptr (s, Lisp_Cons); + } } - else - return 0; + return Qnil; } +static bool +live_cons_p (struct mem_node *m, void *p) +{ + return !NILP (live_cons_holding (m, p)); +} -/* Value is non-zero if P is a pointer to a live Lisp symbol on - the heap. M is a pointer to the mem_block for P. */ -static bool -live_symbol_p (struct mem_node *m, void *p) +/* If P is a pointer into a live Lisp symbol object on the heap, + return the object. Otherwise, return nil. M is a pointer to the + mem_block for P. */ + +static Lisp_Object +live_symbol_holding (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_SYMBOL) { struct symbol_block *b = m->start; - ptrdiff_t offset = (char *) p - (char *) &b->symbols[0]; + char *cp = p; + ptrdiff_t offset = cp - (char *) &b->symbols[0]; - /* P must point to the start of a Lisp_Symbol, not be + /* P must point into the Lisp_Symbol, not be one of the unused cells in the current symbol block, and not be on the free-list. */ - return (offset >= 0 - && offset % sizeof b->symbols[0] == 0 - && offset < (SYMBOL_BLOCK_SIZE * sizeof b->symbols[0]) - && (b != symbol_block - || offset / sizeof b->symbols[0] < symbol_block_index) - && !EQ (((struct Lisp_Symbol *)p)->function, Vdead)); + if (0 <= offset && offset < SYMBOL_BLOCK_SIZE * sizeof b->symbols[0] + && (b != symbol_block + || offset / sizeof b->symbols[0] < symbol_block_index)) + { + struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; + if (!EQ (s->function, Vdead)) + return make_lisp_symbol (s); + } } - else - return 0; + return Qnil; } +static bool +live_symbol_p (struct mem_node *m, void *p) +{ + return !NILP (live_symbol_holding (m, p)); +} -/* Value is non-zero if P is a pointer to a live Lisp float on + +/* Return true if P is a pointer to a live Lisp float on the heap. M is a pointer to the mem_block for P. */ static bool @@ -4633,7 +4675,8 @@ live_float_p (struct mem_node *m, void *p) if (m->type == MEM_TYPE_FLOAT) { struct float_block *b = m->start; - ptrdiff_t offset = (char *) p - (char *) &b->floats[0]; + char *cp = p; + ptrdiff_t offset = cp - (char *) &b->floats[0]; /* P must point to the start of a Lisp_Float and not be one of the unused cells in the current float block. */ @@ -4648,38 +4691,48 @@ live_float_p (struct mem_node *m, void *p) } -/* Value is non-zero if P is a pointer to a live Lisp Misc on - the heap. M is a pointer to the mem_block for P. */ +/* If P is a pointer to a live Lisp Misc on the heap, return the object. + Otherwise, return nil. M is a pointer to the mem_block for P. */ -static bool -live_misc_p (struct mem_node *m, void *p) +static Lisp_Object +live_misc_holding (struct mem_node *m, void *p) { if (m->type == MEM_TYPE_MISC) { struct marker_block *b = m->start; - ptrdiff_t offset = (char *) p - (char *) &b->markers[0]; + char *cp = p; + ptrdiff_t offset = cp - (char *) &b->markers[0]; - /* P must point to the start of a Lisp_Misc, not be + /* P must point into a Lisp_Misc, not be one of the unused cells in the current misc block, and not be on the free-list. */ - return (offset >= 0 - && offset % sizeof b->markers[0] == 0 - && offset < (MARKER_BLOCK_SIZE * sizeof b->markers[0]) - && (b != marker_block - || offset / sizeof b->markers[0] < marker_block_index) - && ((union Lisp_Misc *) p)->u_any.type != Lisp_Misc_Free); + if (0 <= offset && offset < MARKER_BLOCK_SIZE * sizeof b->markers[0] + && (b != marker_block + || offset / sizeof b->markers[0] < marker_block_index)) + { + union Lisp_Misc *s = p = cp -= offset % sizeof b->markers[0]; + if (s->u_any.type != Lisp_Misc_Free) + return make_lisp_ptr (s, Lisp_Misc); + } } - else - return 0; + return Qnil; } +static bool +live_misc_p (struct mem_node *m, void *p) +{ + return !NILP (live_misc_holding (m, p)); +} -/* Value is non-zero if P is a pointer to a live vector-like object. +/* If P is a pointer to a live vector-like object, return the object. + Otherwise, return nil. M is a pointer to the mem_block for P. */ -static bool -live_vector_p (struct mem_node *m, void *p) +static Lisp_Object +live_vector_holding (struct mem_node *m, void *p) { + struct Lisp_Vector *vp = p; + if (m->type == MEM_TYPE_VECTOR_BLOCK) { /* This memory node corresponds to a vector block. */ @@ -4691,33 +4744,59 @@ live_vector_p (struct mem_node *m, void *p) vector which is not on a free list. FIXME: check whether some allocation patterns (probably a lot of short vectors) may cause a substantial overhead of this loop. */ - while (VECTOR_IN_BLOCK (vector, block) - && vector <= (struct Lisp_Vector *) p) + while (VECTOR_IN_BLOCK (vector, block) && vector <= vp) { - if (!PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE) && vector == p) - return true; - else - vector = ADVANCE (vector, vector_nbytes (vector)); + struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); + if (vp < next && !PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FREE)) + return make_lisp_ptr (vector, Lisp_Vectorlike); + vector = next; } } - else if (m->type == MEM_TYPE_VECTORLIKE && p == large_vector_vec (m->start)) - /* This memory node corresponds to a large vector. */ - return 1; - return 0; + else if (m->type == MEM_TYPE_VECTORLIKE) + { + /* This memory node corresponds to a large vector. */ + struct Lisp_Vector *vector = large_vector_vec (m->start); + struct Lisp_Vector *next = ADVANCE (vector, vector_nbytes (vector)); + if (vector <= vp && vp < next) + return make_lisp_ptr (vector, Lisp_Vectorlike); + } + return Qnil; } +static bool +live_vector_p (struct mem_node *m, void *p) +{ + return !NILP (live_vector_holding (m, p)); +} -/* Value is non-zero if P is a pointer to a live buffer. M is a - pointer to the mem_block for P. */ +/* If P is a pointer into a live buffer, return the buffer. + Otherwise, return nil. M is a pointer to the mem_block for P. */ + +static Lisp_Object +live_buffer_holding (struct mem_node *m, void *p) +{ + /* P must point into the block, and the buffer + must not have been killed. */ + if (m->type == MEM_TYPE_BUFFER) + { + struct buffer *b = m->start; + char *cb = m->start; + char *cp = p; + ptrdiff_t offset = cp - cb; + if (0 <= offset && offset < sizeof *b && !NILP (b->name_)) + { + Lisp_Object obj; + XSETBUFFER (obj, b); + return obj; + } + } + return Qnil; +} static bool live_buffer_p (struct mem_node *m, void *p) { - /* P must point to the start of the block, and the buffer - must not have been killed. */ - return (m->type == MEM_TYPE_BUFFER - && p == m->start - && !NILP (((struct buffer *) p)->name_)); + return !NILP (live_buffer_holding (m, p)); } /* Mark OBJ if we can prove it's a Lisp_Object. */ @@ -4743,34 +4822,28 @@ mark_maybe_object (Lisp_Object obj) switch (XTYPE (obj)) { case Lisp_String: - mark_p = (live_string_p (m, po) - && !STRING_MARKED_P ((struct Lisp_String *) po)); + mark_p = EQ (obj, live_string_holding (m, po)); break; case Lisp_Cons: - mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj))); + mark_p = EQ (obj, live_cons_holding (m, po)); break; case Lisp_Symbol: - mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit); + mark_p = EQ (obj, live_symbol_holding (m, po)); break; case Lisp_Float: - mark_p = (live_float_p (m, po) && !FLOAT_MARKED_P (XFLOAT (obj))); + mark_p = live_float_p (m, po); break; case Lisp_Vectorlike: - /* Note: can't check BUFFERP before we know it's a - buffer because checking that dereferences the pointer - PO which might point anywhere. */ - if (live_vector_p (m, po)) - mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj)); - else if (live_buffer_p (m, po)) - mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj)); + mark_p = (EQ (obj, live_vector_holding (m, po)) + || EQ (obj, live_buffer_holding (m, po))); break; case Lisp_Misc: - mark_p = (live_misc_p (m, po) && !XMISCANY (obj)->gcmarkbit); + mark_p = EQ (obj, live_misc_holding (m, po)); break; default: @@ -4834,45 +4907,33 @@ mark_maybe_pointer (void *p) break; case MEM_TYPE_BUFFER: - if (live_buffer_p (m, p) && !VECTOR_MARKED_P ((struct buffer *)p)) - XSETVECTOR (obj, p); + obj = live_buffer_holding (m, p); break; case MEM_TYPE_CONS: - if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p)) - XSETCONS (obj, p); + obj = live_cons_holding (m, p); break; case MEM_TYPE_STRING: - if (live_string_p (m, p) - && !STRING_MARKED_P ((struct Lisp_String *) p)) - XSETSTRING (obj, p); + obj = live_string_holding (m, p); break; case MEM_TYPE_MISC: - if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit) - XSETMISC (obj, p); + obj = live_misc_holding (m, p); break; case MEM_TYPE_SYMBOL: - if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit) - XSETSYMBOL (obj, p); + obj = live_symbol_holding (m, p); break; case MEM_TYPE_FLOAT: - if (live_float_p (m, p) && !FLOAT_MARKED_P (p)) - XSETFLOAT (obj, p); + if (live_float_p (m, p)) + obj = make_lisp_ptr (p, Lisp_Float); break; case MEM_TYPE_VECTORLIKE: case MEM_TYPE_VECTOR_BLOCK: - if (live_vector_p (m, p)) - { - Lisp_Object tem; - XSETVECTOR (tem, p); - if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem))) - obj = tem; - } + obj = live_vector_holding (m, p); break; default: commit 9baeed3514fe60189f3bf935c380da92659b7f59 Author: Paul Eggert Date: Tue Aug 29 14:20:47 2017 -0700 Improve stack-top heuristic This is needed for gcc -Os -flto on x86-64; otherwise, GC misses part of the stack when scanning for heap roots, causing Emacs to crash later (Bug#28213). The problem is that Emacs's hack for getting an address near the stack top does not work when link-time optimization moves stack variables around. * configure.ac (HAVE___BUILTIN_FRAME_ADDRESS): New macro. * lib-src/make-docfile.c (DEFUN_noinline): New constant. (write_globals, scan_c_stream): Support noinline. * src/alloc.c (NEAR_STACK_TOP): New macro. (SET_STACK_TOP_ADDRESS): Use it. (flush_stack_call_func, Fgarbage_collect): Now noinline. diff --git a/configure.ac b/configure.ac index 443344de4c..3dee40704d 100644 --- a/configure.ac +++ b/configure.ac @@ -3958,6 +3958,15 @@ AC_CHECK_FUNCS([aligned_alloc posix_memalign], [break]) AC_CHECK_DECLS([aligned_alloc], [], [], [[#include ]]) dnl Cannot use AC_CHECK_FUNCS +AC_CACHE_CHECK([for __builtin_frame_address], + [emacs_cv_func___builtin_frame_address], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([], [__builtin_frame_address (0);])], + [emacs_cv_func___builtin_frame_address=yes], + [emacs_cv_func___builtin_frame_address=no])]) +if test $emacs_cv_func___builtin_frame_address = yes; then + AC_DEFINE([HAVE___BUILTIN_FRAME_ADDRESS], 1, + [Define to 1 if you have the '__builtin_frame_address' function.]) +fi AC_CACHE_CHECK([for __builtin_unwind_init], emacs_cv_func___builtin_unwind_init, [AC_LINK_IFELSE([AC_LANG_PROGRAM([], [__builtin_unwind_init ();])], diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index ecd6447ab7..c48f202a51 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -592,7 +592,7 @@ struct global }; /* Bit values for FLAGS field from the above. Applied for DEFUNs only. */ -enum { DEFUN_noreturn = 1, DEFUN_const = 2 }; +enum { DEFUN_noreturn = 1, DEFUN_const = 2, DEFUN_noinline = 4 }; /* All the variable names we saw while scanning C sources in `-g' mode. */ @@ -742,6 +742,8 @@ write_globals (void) { if (globals[i].flags & DEFUN_noreturn) fputs ("_Noreturn ", stdout); + if (globals[i].flags & DEFUN_noinline) + fputs ("NO_INLINE ", stdout); printf ("EXFUN (%s, ", globals[i].name); if (globals[i].v.value == -1) @@ -1062,7 +1064,8 @@ scan_c_stream (FILE *infile) attributes: attribute1 attribute2 ...) (Lisp_Object arg...) - Now only 'noreturn' and 'const' attributes are used. */ + Now only ’const’, ’noinline’ and 'noreturn' attributes + are used. */ /* Advance to the end of docstring. */ c = getc (infile); @@ -1108,6 +1111,8 @@ scan_c_stream (FILE *infile) g->flags |= DEFUN_noreturn; if (strstr (input_buffer, "const")) g->flags |= DEFUN_const; + if (strstr (input_buffer, "noinline")) + g->flags |= DEFUN_noinline; } continue; } diff --git a/src/alloc.c b/src/alloc.c index 2cee646256..6e57b2024b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5061,22 +5061,31 @@ typedef union # endif #endif +/* Yield an address close enough to the top of the stack that the + garbage collector need not scan above it. Callers should be + declared NO_INLINE. */ +#ifdef HAVE___BUILTIN_FRAME_ADDRESS +# define NEAR_STACK_TOP(addr) ((void) (addr), __builtin_frame_address (0)) +#else +# define NEAR_STACK_TOP(addr) (addr) +#endif + /* Set *P to the address of the top of the stack. This must be a macro, not a function, so that it is executed in the caller’s environment. It is not inside a do-while so that its storage - survives the macro. */ + survives the macro. Callers should be declared NO_INLINE. */ #ifdef HAVE___BUILTIN_UNWIND_INIT # define SET_STACK_TOP_ADDRESS(p) \ stacktop_sentry sentry; \ __builtin_unwind_init (); \ - *(p) = &sentry + *(p) = NEAR_STACK_TOP (&sentry) #else # define SET_STACK_TOP_ADDRESS(p) \ stacktop_sentry sentry; \ __builtin_unwind_init (); \ test_setjmp (); \ sys_setjmp (sentry.j); \ - *(p) = &sentry + (stack_bottom < &sentry.c) + *(p) = NEAR_STACK_TOP (&sentry + (stack_bottom < &sentry.c)) #endif /* Mark live Lisp objects on the C stack. @@ -5148,7 +5157,7 @@ mark_stack (char *bottom, char *end) It is invalid to run any Lisp code or to allocate any GC memory from FUNC. */ -void +NO_INLINE void flush_stack_call_func (void (*func) (void *arg), void *arg) { void *end; @@ -6097,7 +6106,8 @@ where each entry has the form (NAME SIZE USED FREE), where: to return them to the OS). However, if there was overflow in pure space, `garbage-collect' returns nil, because real GC can't be done. -See Info node `(elisp)Garbage Collection'. */) +See Info node `(elisp)Garbage Collection'. */ + attributes: noinline) (void) { void *end; commit f1fdb5bc575728bd6c9f13a18939d9c271a74e83 Author: Paul Eggert Date: Tue Aug 29 12:49:22 2017 -0700 Align stack bottom properly. This is needed for gcc -Os -flto on x86-64 (Bug#28213). * src/emacs.c (main): Align stack-bottom variable as a pointer, since mark_memory requires this. diff --git a/src/emacs.c b/src/emacs.c index 0fec716758..44f6285795 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -672,7 +672,10 @@ close_output_streams (void) int main (int argc, char **argv) { - char stack_bottom_variable; + /* Variable near the bottom of the stack, and aligned appropriately + for pointers. */ + void *stack_bottom_variable; + bool do_initial_setlocale; bool dumping; int skip_args = 0; @@ -688,7 +691,7 @@ main (int argc, char **argv) char *original_pwd = 0; /* Record (approximately) where the stack begins. */ - stack_bottom = &stack_bottom_variable; + stack_bottom = (char *) &stack_bottom_variable; #ifndef CANNOT_DUMP dumping = !initialized && (strcmp (argv[argc - 1], "dump") == 0 commit 02255c5fbc7e6dc0206db978994617cc72de4bb8 Author: Eli Zaretskii Date: Tue Aug 29 21:53:49 2017 +0300 Avoid spinning waiting for git-gui.exe on Windows * src/w32proc.c (waitpid): If GetExitCodeProcess returns STILL_ACTIVE, and we were called with WNOHANG, pretend that the process exited. (Bug#28268) diff --git a/src/w32proc.c b/src/w32proc.c index ffd5f0d0a1..71bd28d3c2 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1492,12 +1492,17 @@ waitpid (pid_t pid, int *status, int options) } if (retval == STILL_ACTIVE) { - /* Should never happen. */ + /* Should never happen. But it does, with invoking git-gui.exe + asynchronously. So we punt, and just report this process as + exited with exit code 259, when we are called with WNOHANG + from child_status_changed, because in that case we already + _know_ the process has died. */ DebPrint (("Wait.WaitForMultipleObjects returned an active process\n")); - if (pid > 0 && dont_wait) - return 0; - errno = EINVAL; - return -1; + if (!(pid > 0 && dont_wait)) + { + errno = EINVAL; + return -1; + } } /* Massage the exit code from the process to match the format expected commit 1454ad6f068f1d94070943b6784bc127a3119055 Author: Eli Zaretskii Date: Tue Aug 29 19:39:15 2017 +0300 Document '--module-assertions' * doc/emacs/cmdargs.texi (Initial Options): Document the '--module-assertions' command-line option. * doc/lispref/loading.texi (Dynamic Modules): Add a cross-reference to the description of '--module-assertions'. * etc/NEWS: Update the NEWS entry for --module-assertions. diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index 0b1a400b36..a1807ad9dd 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -365,6 +365,14 @@ own@footnote{This option has no effect on MS-Windows.}. Enable the Emacs Lisp debugger for errors in the init file. @xref{Error Debugging,, Entering the Debugger on an Error, elisp, The GNU Emacs Lisp Reference Manual}. + +@item --module-assertions +@opindex --module-assertions +@cindex module verification +Enable expensive correctness checks when dealing with dynamically +loadable modules. This is intended for module authors that wish to +verify that their module conforms to the module API requirements. The +option makes Emacs abort if a module-related assertion triggers. @end table @node Command Example diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index 80dcb48898..0ab8f89a3f 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -1184,3 +1184,8 @@ object. Loadable modules in Emacs are enabled by using the @kbd{--with-modules} option at configure time. + +If you write your own dynamic modules, you may wish to verify their +conformance to the Emacs dynamic module API. Invoking Emacs with the +@kbd{--module-assertions} option will help you in this matter. +@xref{Initial Options,,,emacs, The GNU Emacs Manual}. diff --git a/etc/NEWS b/etc/NEWS index 9930a3bc2c..d2016e1352 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -87,11 +87,13 @@ modern init systems such as systemd, which manage many of the traditional aspects of daemon behavior themselves. '--bg-daemon' is now an alias for '--daemon'. -** New option '--module-assertions'. If the user supplies this -option, Emacs will perform expensive correctness checks when dealing -with dynamic modules. This is intended for module authors that wish -to verify that their module conforms to the module requirements. The -option makes Emacs abort if a module-related assertion triggers. ++++ +** New option '--module-assertions'. +When given this option, Emacs will perform expensive correctness +checks when dealing with dynamic modules. This is intended for module +authors that wish to verify that their module conforms to the module +requirements. The option makes Emacs abort if a module-related +assertion triggers. +++ ** Emacs now supports 24-bit colors on capable text terminals commit 67e565fad53955fbd1cc35b1b26235c6cee37a48 Author: Alan Third Date: Thu Aug 24 21:59:33 2017 +0100 Add news entry about new macOS features * etc/NEWS: Add entry about ns-appearance, ns-transparent-titlebar and ns-use-thin-smoothing. diff --git a/etc/NEWS b/etc/NEWS index e8d6ea9c6d..9930a3bc2c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1720,6 +1720,11 @@ on macOS. ** Emacs can now be run as a GUI application from the command line on macOS. +** 'ns-appearance' and 'ns-transparent-titlebar' change the appearance +of frame decorations on macOS 10.9+. + +** 'ns-use-thin-smoothing' enables thin font smoothing on macOS 10.8+. + ---------------------------------------------------------------------- This file is part of GNU Emacs. commit fdde98113c5d1c2d4eb5c25fa750c976d90f8555 Author: Alan Third Date: Sat Aug 26 09:44:42 2017 +0100 Fix cross macOS version building (bug#28222) * src/macfont.h (CGContextSetFontSmoothingStyle): Function declaration. * src/macfont.m (macfont_draw): Limit new code to macOS 10.8 and up. diff --git a/src/macfont.h b/src/macfont.h index 32899908be..3a66d2d005 100644 --- a/src/macfont.h +++ b/src/macfont.h @@ -82,3 +82,10 @@ typedef const struct _EmacsScreenFont *ScreenFontRef; /* opaque */ extern void mac_register_font_driver (struct frame *f); extern void *macfont_get_nsctfont (struct font *font); extern void macfont_update_antialias_threshold (void); + +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 +/* This is an undocumented function that is probably not available + pre-10.8. */ +extern void CGContextSetFontSmoothingStyle(CGContextRef, int) + __attribute__((weak_import)); +#endif diff --git a/src/macfont.m b/src/macfont.m index 59891353cd..33c28f7349 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2888,11 +2888,14 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no if (no_antialias_p) CGContextSetShouldAntialias (context, false); - if (!NILP (ns_use_thin_smoothing)) +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1080 + if (!NILP (ns_use_thin_smoothing) + && CGContextSetFontSmoothingStyle != NULL) { CGContextSetShouldSmoothFonts(context, YES); CGContextSetFontSmoothingStyle(context, 16); } +#endif CGContextSetTextMatrix (context, atfm); CGContextSetTextPosition (context, text_position.x, text_position.y); commit 1b0d72244d5df61d9fbe10808808b3c045a3382b Author: Ben Bonfil Date: Sat Aug 26 09:41:41 2017 +0100 Enable thin font smoothing in macOS (bug#28222) * src/nsterm.m (syms_of_nsterm): Define var ns-use-thin-smoothing. * src/macfont.m (macfont_draw): Use font smoothing. Copyright-paperwork-exempt: yes diff --git a/src/macfont.m b/src/macfont.m index 19145f92c0..59891353cd 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2888,6 +2888,12 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no if (no_antialias_p) CGContextSetShouldAntialias (context, false); + if (!NILP (ns_use_thin_smoothing)) + { + CGContextSetShouldSmoothFonts(context, YES); + CGContextSetFontSmoothingStyle(context, 16); + } + CGContextSetTextMatrix (context, atfm); CGContextSetTextPosition (context, text_position.x, text_position.y); diff --git a/src/nsterm.m b/src/nsterm.m index 22f8efd6b9..ff3329d1ce 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -9133,6 +9133,10 @@ Convert an X font name (XLFD) to an NS font name. "Non-nil (the default) means to render text antialiased."); ns_antialias_text = Qt; + DEFVAR_LISP ("ns-use-thin-smoothing", ns_use_thin_smoothing, + "Non-nil turns on a font smoothing method that produces thinner strokes."); + ns_use_thin_smoothing = Qnil; + DEFVAR_LISP ("ns-confirm-quit", ns_confirm_quit, "Whether to confirm application quit using dialog."); ns_confirm_quit = Qnil; commit 573ccb9803f326a1ba309b131c6db77fa98191d3 Author: Eli Zaretskii Date: Tue Aug 29 19:13:19 2017 +0300 Minor improvement in documentation of display-line-numbers * doc/emacs/display.texi (Display Custom): Document the display-line-numbers-mode and related options. diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 45cfb950f0..2aa79e1161 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1751,6 +1751,15 @@ Mode}), and need to move by exact number of screen lines. Any other non-@code{nil} value is treated as @code{t}. @end table +@findex display-line-numbers-mode +@findex global-display-line-numbers-mode +@vindex display-line-numbers-type +A convenient way of turning on display of line numbers is @w{@kbd{M-x +display-line-numbers-mode @key{RET}}}. This mode has a globalized +variant, @code{global-display-line0numbers-mode}. The user option +@code{display-line-numbers-type} controls which sub-mode of +line-number display, described above, will these modes activate. + @vindex display-line-numbers-current-absolute When Emacs displays relative line numbers, you can control the number displayed before the current line, the line showing point. By commit bf0045d7a4cd4c7d4df3fa34b8a12795e8ee73aa Author: Eli Zaretskii Date: Tue Aug 29 18:13:44 2017 +0300 Avoid aborting in 'waitpid' on MS-Windows * src/w32proc.c (waitpid): Don't allow quitting if called with WNOHANG in OPTIONS. (Bug#28268) diff --git a/src/w32proc.c b/src/w32proc.c index 76af55f998..ffd5f0d0a1 100644 --- a/src/w32proc.c +++ b/src/w32proc.c @@ -1449,7 +1449,11 @@ waitpid (pid_t pid, int *status, int options) do { - maybe_quit (); + /* When child_status_changed calls us with WNOHANG in OPTIONS, + we are supposed to be non-interruptible, so don't allow + quitting in that case. */ + if (!dont_wait) + maybe_quit (); active = WaitForMultipleObjects (nh, wait_hnd, FALSE, timeout_ms); } while (active == WAIT_TIMEOUT && !dont_wait); commit b65cb981cce96eeae3690ffddac6f3ebe314036c Author: Rasmus Date: Tue Aug 29 16:47:21 2017 +0200 ; Fix Org sync 3ad8ca429bac * etc/refcards/orgcard.tex: Restore dropped line from 54aadd94f See http://permalink.gmane.org/gmane.emacs.devel/217877 diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 1c4f4501c1..ecfd62f730 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,7 +1,7 @@ % Reference Card for Org Mode \def\orgversionnumber{9.0.10} \def\versionyear{2017} % latest update -\def\year{2017} % latest copyright year +\input emacsver.tex %**start of header \newcount\columnsperpage commit 01832ec21f1a880366f7d957e84b0d9c4d75b182 Author: Stefan Monnier Date: Tue Aug 29 09:44:19 2017 -0400 * lisp/progmodes/sh-script.el: Test "in-string" of the right char! (sh-syntax-propertize-function): Fix off-by-one error. Fixes bug#23526. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 54c47b719f..ea2e98424f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1138,7 +1138,7 @@ subshells can nest." (syntax-propertize-rules (sh-here-doc-open-re (2 (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1) (match-beginning 2)))) + (1+ (match-beginning 0)) (match-string 1) (match-beginning 2)))) ("\\s|" (0 (prog1 nil (sh-syntax-propertize-here-doc end)))) ;; A `#' begins a comment when it is unquoted and at the ;; beginning of a word. In the shell, words are separated by commit 3ad8ca429bac5e1354881cf4411d6f41dab36b44 Author: Rasmus Date: Tue Aug 29 10:07:08 2017 +0200 Update Org to v9.0.10 Please see etc/ORG-NEWS for major changes. Note, this is a bugfix release. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 2d537946be..067ae7bbc5 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -4,7 +4,8 @@ @settitle The Org Manual @include docstyle.texi -@set VERSION 9.0.9 +@set VERSION 9.0.10 +@set DATE 2017-08-27 @c Version and Contact Info @set MAINTAINERSITE @uref{http://orgmode.org,maintainers web page} @@ -499,6 +500,12 @@ Capture templates * Template expansion:: Filling in information about time and context * Templates in contexts:: Only show a template in a specific context +Protocols for external access + +* @code{store-link} protocol:: Store a link, push URL to kill-ring. +* @code{capture} protocol:: Fill a buffer with external information. +* @code{open-source} protocol:: Edit published contents. + Archiving * Moving subtrees:: Moving a tree to an archive file @@ -830,7 +837,7 @@ different formats such as HTML, @LaTeX{}, Open Document, and Markdown. New export backends can be derived from existing ones, or defined from scratch. Org files can include source code blocks, which makes Org uniquely suited for -authoring technical documents with code examples. Org source code blocks are +authoring technical documents with code examples. Org source code blocks are fully functional; they can be evaluated in place and their results can be captured in the file. This makes it possible to create a single file reproducible research compendium. @@ -7310,7 +7317,11 @@ dynamic insertion of content. The templates are expanded in the order given her @r{%^@{prompt|default|completion2|completion3...@}.} @r{The arrow keys access a prompt-specific history.} %\1 @dots{} %\N @r{Insert the text entered at the Nth %^@{@var{prompt}@}, where @code{N} is} - @r{a number, starting from 1.} + @r{a number, starting from 1.@footnote{As required in Emacs + Lisp, it is necessary to escape any backslash character in + a string with another backslash. So, in order to use + @samp{%\1} placeholder, you need to write @samp{%\\1} in + the template.}} %? @r{After completing the template, position cursor here.} @end smallexample @@ -7505,16 +7516,202 @@ For more information, including how to read atom feeds, see @node Protocols @section Protocols for external access @cindex protocols, for external access -@cindex emacsserver -You can set up Org for handling protocol calls from outside applications that -are passed to Emacs through the @file{emacsserver}. For example, you can +Org protocol is a mean to trigger custom actions in Emacs from external +applications. Any application that supports calling external programs with +an URL as argument may be used with this functionality. For example, you can configure bookmarks in your web browser to send a link to the current page to -Org and create a note from it using capture (@pxref{Capture}). Or you -could create a bookmark that will tell Emacs to open the local source file of -a remote website you are looking at with the browser. See -@uref{http://orgmode.org/worg/org-contrib/org-protocol.php} for detailed -documentation and setup instructions. +Org and create a note from it using capture (@pxref{Capture}). You can also +create a bookmark that tells Emacs to open the local source file of a remote +website you are browsing. + +@cindex Org protocol, set-up +@cindex Installing Org protocol +In order to use Org protocol from an application, you need to register +@samp{org-protocol://} as a valid scheme-handler. External calls are passed +to Emacs through the @code{emacsclient} command, so you also need to ensure +an Emacs server is running. More precisely, when the application calls + +@example +emacsclient org-protocol://PROTOCOL?key1=val1&key2=val2 +@end example + +@noindent +Emacs calls the handler associated to @samp{PROTOCOL} with argument +@samp{(:key1 val1 :key2 val2)}. + +@cindex protocol, new protocol +@cindex defining new protocols +Org protocol comes with three predefined protocols, detailed in the following +sections. Configure @code{org-protocol-protocol-alist} to define your own. + +@menu +* @code{store-link} protocol:: Store a link, push URL to kill-ring. +* @code{capture} protocol:: Fill a buffer with external information. +* @code{open-source} protocol:: Edit published contents. +@end menu + +@node @code{store-link} protocol +@subsection @code{store-link} protocol +@cindex store-link protocol +@cindex protocol, store-link + +Using @code{store-link} handler, you can copy links, insertable through +@kbd{M-x org-insert-link} or yanking thereafter. More precisely, the command + +@example +emacsclient org-protocol://store-link?url=URL&title=TITLE +@end example + +@noindent +stores the following link: + +@example +[[URL][TITLE]] +@end example + +In addition, @samp{URL} is pushed on the kill-ring for yanking. You need to +encode @samp{URL} and @samp{TITLE} if they contain slashes, and probably +quote those for the shell. + +To use this feature from a browser, add a bookmark with an arbitrary name, +e.g., @samp{Org: store-link} and enter this as @emph{Location}: + +@example +javascript:location.href='org-protocol://store-link?url='+ + encodeURIComponent(location.href); +@end example + +@node @code{capture} protocol +@subsection @code{capture} protocol +@cindex capture protocol +@cindex protocol, capture + +@cindex capture, %:url placeholder +@cindex %:url template expansion in capture +@cindex capture, %:title placeholder +@cindex %:title template expansion in capture +Activating @code{capture} handler pops up a @samp{Capture} buffer and fills +the capture template associated to the @samp{X} key with them. The template +refers to the data through @code{%:url} and @code{%:title} placeholders. +Moreover, any selected text in the browser is appended to the body of the +entry. + +@example +emacsclient org-protocol://capture?template=X?url=URL?title=TITLE?body=BODY +@end example + +To use this feature, add a bookmark with an arbitrary name, e.g. +@samp{Org: capture} and enter this as @samp{Location}: + +@example +javascript:location.href='org-protocol://template=x'+ + '&url='+encodeURIComponent(window.location.href)+ + '&title='+encodeURIComponent(document.title)+ + '&body='+encodeURIComponent(window.getSelection()); +@end example + +@vindex org-protocol-default-template-key +The result depends on the capture template used, which is set in the bookmark +itself, as in the example above, or in +@code{org-protocol-default-template-key}. + +@node @code{open-source} protocol +@subsection @code{open-source} protocol +@cindex open-source protocol +@cindex protocol, open-source + +The @code{open-source} handler is designed to help with editing local sources +when reading a document. To that effect, you can use a bookmark with the +following location: + +@example +javascript:location.href='org-protocol://open-source?&url='+ + encodeURIComponent(location.href) +@end example + +@cindex protocol, open-source, :base-url property +@cindex :base-url property in open-source protocol +@cindex protocol, open-source, :working-directory property +@cindex :working-directory property in open-source protocol +@cindex protocol, open-source, :online-suffix property +@cindex :online-suffix property in open-source protocol +@cindex protocol, open-source, :working-suffix property +@cindex :working-suffix property in open-source protocol +@vindex org-protocol-project-alist +The variable @code{org-protocol-project-alist} maps URLs to local file names, +by stripping URL parameters from the end and replacing the @code{:base-url} +with @code{:working-diretory} and @code{:online-suffix} with +@code{:working-suffix}. For example, assuming you own a local copy of +@url{http://orgmode.org/worg/} contents at @file{/home/user/worg}, you can +set @code{org-protocol-project-alist} to the following + +@lisp +(setq org-protocol-project-alist + '(("Worg" + :base-url "http://orgmode.org/worg/" + :working-directory "/home/user/worg/" + :online-suffix ".html" + :working-suffix ".org"))) +@end lisp + +@noindent +If you are now browsing +@url{http://orgmode.org/worg/org-contrib/org-protocol.html} and find a typo +or have an idea about how to enhance the documentation, simply click the +bookmark and start editing. + +@cindex handle rewritten URL in open-source protocol +@cindex protocol, open-source rewritten URL +However, such mapping may not yield the desired results. Suppose you +maintain an online store located at @url{http://example.com/}. The local +sources reside in @file{/home/user/example/}. It is common practice to serve +all products in such a store through one file and rewrite URLs that do not +match an existing file on the server. That way, a request to +@url{http://example.com/print/posters.html} might be rewritten on the server +to something like +@url{http://example.com/shop/products.php/posters.html.php}. The +@code{open-source} handler probably cannot find a file named +@file{/home/user/example/print/posters.html.php} and fails. + +@cindex protocol, open-source, :rewrites property +@cindex :rewrites property in open-source protocol +Such an entry in @code{org-protocol-project-alist} may hold an additional +property @code{:rewrites}. This property is a list of cons cells, each of +which maps a regular expression to a path relative to the +@code{:working-directory}. + +Now map the URL to the path @file{/home/user/example/products.php} by adding +@code{:rewrites} rules like this: + +@lisp +(setq org-protocol-project-alist + '(("example.com" + :base-url "http://example.com/" + :working-directory "/home/user/example/" + :online-suffix ".php" + :working-suffix ".php" + :rewrites (("example.com/print/" . "products.php") + ("example.com/$" . "index.php"))))) +@end lisp + +@noindent +Since @samp{example.com/$} is used as a regular expression, it maps +@url{http://example.com/}, @url{https://example.com}, +@url{http://www.example.com/} and similar to +@file{/home/user/example/index.php}. + +The @code{:rewrites} rules are searched as a last resort if and only if no +existing file name is matched. + +@cindex protocol, open-source, set-up mapping +@cindex set-up mappings in open-source protocol +@findex org-protocol-create +@findex org-protocol-create-for-org +Two functions can help you filling @code{org-protocol-project-alist} with +valid contents: @code{org-protocol-create} and +@code{org-protocol-create-for-org}. The latter is of use if you're editing +an Org file that is part of a publishing project. @node Refile and copy @section Refile and copy @@ -8081,7 +8278,7 @@ you can use the following instead: @end example That will give you three days' warning: on the anniversary date itself and the -two days prior. The argument is optional: if omitted, it defaults to 7. +two days prior. The argument is optional: if omitted, it defaults to 7. @subsubheading Appointment reminders @cindex @file{appt.el} @@ -11443,8 +11640,8 @@ The default is ``xhtml-strict''. Org's HTML exporter does not by default enable new block elements introduced with the HTML5 standard. To enable them, set @code{org-html-html5-fancy} to non-@code{nil}. Or use an @code{OPTIONS} line in the file to set -@code{html5-fancy}. HTML5 documents can now have arbitrary #+BEGIN and #+END -blocks. For example: +@code{html5-fancy}. HTML5 documents can now have arbitrary @code{#+BEGIN} +and @code{#+END} blocks. For example: @example #+BEGIN_aside @@ -13590,7 +13787,7 @@ itself does not appear in the structure of the document. Copyright information is printed on the back of the title page. @example -* Copying +* Legalese :PROPERTIES: :COPYING: t :END: @@ -15142,8 +15339,8 @@ customization options for extracting source code. When Org tangles @samp{src} code blocks, it expands, merges, and transforms them. Then Org recomposes them into one or more separate files, as configured through the options. During this @emph{tangling} process, Org -expands variables in the source code, and resolves any ``noweb'' style -references (@pxref{Noweb reference syntax}). +expands variables in the source code, and resolves any Noweb style references +(@pxref{Noweb reference syntax}). @subsubheading Header arguments @@ -15319,6 +15516,7 @@ Org supports the following languages for the @samp{src} code blocks: Additional documentation for some languages are at @uref{http://orgmode.org/worg/org-contrib/babel/languages.html}. +@vindex org-babel-load-languages By default, only @code{emacs-lisp} is enabled for evaluation. To enable or disable other languages, customize the @code{org-babel-load-languages} variable either through the Emacs customization interface, or by adding code @@ -16148,12 +16346,11 @@ Do not insert newlines to pad the tangled @samp{src} code blocks. By default Org expands @samp{src} code blocks during tangling. The @code{:no-expand} header argument turns off such expansions. Note that one side-effect of expansion by @code{org-babel-expand-src-block} also assigns -values to @code{:var} (@pxref{var}) variables. Expansions also replace -``noweb'' references with their targets (@pxref{Noweb reference syntax}). -Some of these expansions may cause premature assignment, hence this option. -This option makes a difference only for tangling. It has no effect when -exporting since @samp{src} code blocks for execution have to be expanded -anyway. +values to @code{:var} (@pxref{var}) variables. Expansions also replace Noweb +references with their targets (@pxref{Noweb reference syntax}). Some of +these expansions may cause premature assignment, hence this option. This +option makes a difference only for tangling. It has no effect when exporting +since @samp{src} code blocks for execution have to be expanded anyway. @node session @subsubsection @code{:session} @@ -16182,42 +16379,56 @@ subsequent source code language blocks change session names. @subsubsection @code{:noweb} @cindex @code{:noweb}, src header argument -The @code{:noweb} header argument controls expansion of ``noweb'' syntax +The @code{:noweb} header argument controls expansion of Noweb syntax references (@pxref{Noweb reference syntax}). Expansions occur when source code blocks are evaluated, tangled, or exported. @itemize @bullet @item @code{no} -Default. No expansion of ``Noweb'' syntax references in the body of the code +Default. No expansion of Noweb syntax references in the body of the code when evaluating, tangling, or exporting. @item @code{yes} -Expansion of ``Noweb'' syntax references in the body of the @samp{src} code -block when evaluating, tangling, or exporting. +Expansion of Noweb syntax references in the body of the @samp{src} code block +when evaluating, tangling, or exporting. @item @code{tangle} -Expansion of ``Noweb'' syntax references in the body of the @samp{src} code -block when tangling. No expansion when evaluating or exporting. +Expansion of Noweb syntax references in the body of the @samp{src} code block +when tangling. No expansion when evaluating or exporting. @item @code{no-export} -Expansion of ``Noweb'' syntax references in the body of the @samp{src} code -block when evaluating or tangling. No expansion when exporting. +Expansion of Noweb syntax references in the body of the @samp{src} code block +when evaluating or tangling. No expansion when exporting. @item @code{strip-export} -Expansion of ``Noweb'' syntax references in the body of the @samp{src} code -block when expanding prior to evaluating or tangling. Removes ``noweb'' -syntax references when exporting. +Expansion of Noweb syntax references in the body of the @samp{src} code block +when expanding prior to evaluating or tangling. Removes Noweb syntax +references when exporting. @item @code{eval} -Expansion of ``Noweb'' syntax references in the body of the @samp{src} code -block only before evaluating. +Expansion of Noweb syntax references in the body of the @samp{src} code block +only before evaluating. @end itemize @subsubheading Noweb prefix lines -Noweb insertions now honor prefix characters that appear before -@code{<>}. This behavior is illustrated in the following example. -Because the @code{<>} noweb reference appears behind the SQL comment -syntax, each line of the expanded noweb reference will be commented. +Noweb insertions now honor prefix characters that appear before the Noweb +syntax reference. + +This behavior is illustrated in the following example. Because the +@code{<>} noweb reference appears behind the SQL comment syntax, +each line of the expanded noweb reference will be commented. + +With: -This @samp{src} code block: +@example +#+NAME: example +#+BEGIN_SRC text +this is the +multi-line body of example +#+END_SRC +@end example + +this @samp{src} code block: @example +#+BEGIN_SRC sql :noweb yes -- <> +#+END_SRC @end example expands to: @@ -16230,17 +16441,60 @@ expands to: Since this change will not affect noweb replacement text without newlines in them, inline noweb references are acceptable. +This feature can also be used for management of indentation in exported code snippets. + +With: + +@example +#+NAME: if-true +#+BEGIN_SRC python :exports none +print('Do things when True') +#+END_SRC + +#+NAME: if-false +#+BEGIN_SRC python :exports none +print('Do things when False') +#+END_SRC +@end example + +this @samp{src} code block: + +@example +#+BEGIN_SRC python :noweb yes :results output +if True: + <> +else: + <> +#+END_SRC +@end example + +expands to: + +@example +if True: + print('Do things when True') +else: + print('Do things when False') +@end example + +and evaluates to: + +@example +Do things when True +@end example + @node noweb-ref @subsubsection @code{:noweb-ref} @cindex @code{:noweb-ref}, src header argument -When expanding ``noweb'' style references, Org concatenates @samp{src} code -blocks by matching the reference name to either the block name or the +When expanding Noweb style references, Org concatenates @samp{src} code +blocks by matching the reference name to either the code block name or the @code{:noweb-ref} header argument. For simple concatenation, set this @code{:noweb-ref} header argument at the sub-tree or file level. In the example Org file shown next, the body of the -source code in each block is extracted for concatenation to a pure code file. +source code in each block is extracted for concatenation to a pure code file +when tangled. @example #+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh @@ -16300,8 +16554,8 @@ A note of warning: when @code{:cache} is used for a @code{:session}, caching may cause unexpected results. When the caching mechanism tests for any source code changes, it will not -expand ``noweb'' style references (@pxref{Noweb reference syntax}). For -reasons why, see @uref{http://thread.gmane.org/gmane.emacs.orgmode/79046}. +expand Noweb style references (@pxref{Noweb reference syntax}). For reasons +why, see @uref{http://thread.gmane.org/gmane.emacs.orgmode/79046}. The @code{:cache} header argument can have one of two values: @code{yes} or @code{no}. @@ -16743,38 +16997,80 @@ prints ``2''. Results show that. @cindex syntax, noweb @cindex source code, noweb reference -Org supports named blocks in ``noweb'' style syntax. For ``noweb'' literate +Org supports named blocks in Noweb style syntax. For Noweb literate programming details, see @uref{http://www.cs.tufts.edu/~nr/noweb/}). @example <> @end example -For the header argument @code{:noweb yes}, Org expands ``noweb'' style -references in the @samp{src} code block before evaluation. +For the header argument @code{:noweb yes}, Org expands Noweb style references +in the @samp{src} code block before evaluation. -For the header argument @code{:noweb no}, Org does not expand ``noweb'' style +For the header argument @code{:noweb no}, Org does not expand Noweb style references in the @samp{src} code block before evaluation. -The default is @code{:noweb no}. +The default is @code{:noweb no}. Org defaults to @code{:noweb no} so as not +to cause errors in languages where Noweb syntax is ambiguous. Change Org's +default to @code{:noweb yes} for languages where there is no risk of +confusion. -Org offers a more flexible way to resolve ``noweb'' style references +Org offers a more flexible way to resolve Noweb style references (@pxref{noweb-ref}). -Org can handle naming of @emph{results} block, rather than the body of the -@samp{src} code block, using ``noweb'' style references. - -For ``noweb'' style reference, append parenthesis to the code block name for -arguments, as shown in this example: +Org can include the @emph{results} of a code block rather than its body. To +that effect, append parentheses, possibly including arguments, to the code +block name, as show below. @example <> @end example -Note: Org defaults to @code{:noweb no} so as not to cause errors in languages -such as @samp{Ruby} where ``noweb'' syntax is equally valid characters. For -example, @code{<>}. Change Org's default to @code{:noweb yes} for -languages where there is no risk of confusion. +Note that when using the above approach to a code block's results, the code +block name set by @code{#+NAME} keyword is required; the reference set by +@code{:noweb-ref} will not work. + +Here is an example that demonstrates how the exported content changes when +Noweb style references are used with parentheses versus without. + +With: + +@example +#+NAME: some-code +#+BEGIN_SRC python :var num=0 :results output :exports none +print(num*10) +#+END_SRC +@end example + +this code block: + +@example +#+BEGIN_SRC text :noweb yes +<> +#+END_SRC +@end example + +expands to: + +@example +print(num*10) +@end example + +Below, a similar Noweb style reference is used, but with parentheses, while +setting a variable @code{num} to 10: + +@example +#+BEGIN_SRC text :noweb yes +<> +#+END_SRC +@end example + +Note that now the expansion contains the @emph{results} of the code block +@code{some-code}, not the code block itself: + +@example +100 +@end example For faster tangling of large Org mode files, set @code{org-babel-use-quick-and-dirty-noweb-expansion} variable to @code{t}. @@ -17004,12 +17300,9 @@ structural elements, such as @code{#+BEGIN_SRC} and @code{#+END_SRC}. Easy templates use an expansion mechanism, which is native to Org, in a process similar to @file{yasnippet} and other Emacs template expansion packages. -@kbd{@key{<}} @kbd{@key{s}} @kbd{@key{TAB}} completes the @samp{src} code -block. - -@kbd{<} @kbd{l} @kbd{@key{TAB}} +@kbd{<} @kbd{s} @kbd{@key{TAB}} expands to a @samp{src} code block. -expands to: +@kbd{<} @kbd{l} @kbd{@key{TAB}} expands to: #+BEGIN_EXPORT latex @@ -17082,7 +17375,7 @@ Org evaluates code in the following circumstances: Org evaluates @samp{src} code blocks in an Org file during export. Org also evaluates a @samp{src} code block with the @kbd{C-c C-c} key chord. Users exporting or running code blocks must load files only from trusted sources. -Be weary of customizing variables that remove or alter default security +Be wary of customizing variables that remove or alter default security measures. @defopt org-confirm-babel-evaluate diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index f8399dbf1e..ff1000e78e 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -157,7 +157,7 @@ should be written instead ,* Headline :PROPERTIES: :header-args: :exports code -:header-args: :var a=1 b=2 +:header-args+: :var a=1 b=2 :header-args+: :var c=3 :END: #+END_EXAMPLE diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index 0170a18abc..1c4f4501c1 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,7 +1,7 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.0.9} +\def\orgversionnumber{9.0.10} \def\versionyear{2017} % latest update -\input emacsver.tex +\def\year{2017} % latest copyright year %**start of header \newcount\columnsperpage diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index cc60f4e4a7..7b218081fa 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -33,7 +33,6 @@ (require 'ob-core) (require 'org-compat) (require 'comint) -(require 'tramp) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -148,10 +147,6 @@ FILE exists at end of evaluation." (process-send-string (get-buffer-process buffer) (if (= (aref string (1- (length string))) ?\n) string (concat string "\n"))) - ;; From Tramp 2.1.19 the following cache flush is not necessary - (when (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v ""))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index c630b70f91..527fb2204a 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1752,16 +1752,20 @@ NAME, or nil if no such block exists. Set match data according to `org-babel-named-src-block-regexp'." (save-excursion (goto-char (point-min)) - (ignore-errors - (org-next-block 1 nil (org-babel-named-src-block-regexp-for-name name))))) + (let ((regexp (org-babel-named-src-block-regexp-for-name name))) + (or (and (looking-at regexp) + (progn (goto-char (match-beginning 1)) + (line-beginning-position))) + (ignore-errors (org-next-block 1 nil regexp)))))) (defun org-babel-src-block-names (&optional file) "Returns the names of source blocks in FILE or the current buffer." (when file (find-file file)) (save-excursion (goto-char (point-min)) - (let ((re (org-babel-named-src-block-regexp-for-name)) - names) + (let* ((re (org-babel-named-src-block-regexp-for-name)) + (names (and (looking-at re) + (list (match-string-no-properties 9))))) (while (ignore-errors (org-next-block 1 nil re)) (push (match-string-no-properties 9) names)) names))) @@ -2269,21 +2273,22 @@ INFO may provide the values of these header arguments (in the ((member "prepend" result-params))) ; already there (setq results-switches (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish &optional no-escape no-newlines - inline-start inline-finish) - (when inline - (setq start inline-start) - (setq finish inline-finish) - (setq no-newlines t)) - (goto-char end) - (insert (concat finish (unless no-newlines "\n"))) - (goto-char beg) - (insert (concat start (unless no-newlines "\n"))) - (unless no-escape - (org-escape-code-in-region (min (point) end) end)) - (goto-char end) - (unless no-newlines (goto-char (point-at-eol))) - (setq end (point-marker)))) + (let ((wrap + (lambda (start finish &optional no-escape no-newlines + inline-start inline-finish) + (when inline + (setq start inline-start) + (setq finish inline-finish) + (setq no-newlines t)) + (let ((before-finish (marker-position end))) + (goto-char end) + (insert (concat finish (unless no-newlines "\n"))) + (goto-char beg) + (insert (concat start (unless no-newlines "\n"))) + (unless no-escape + (org-escape-code-in-region + (min (point) before-finish) before-finish)) + (goto-char end)))) (tabulablep (lambda (r) ;; Non-nil when result R can be turned into @@ -2337,7 +2342,7 @@ INFO may provide the values of these header arguments (in the (insert (org-macro-escape-arguments (org-babel-chomp result "\n")))) (t (goto-char beg) (insert result))) - (setq end (point-marker)) + (setq end (copy-marker (point) t)) ;; possibly wrap result (cond ((assq :wrap (nth 2 info)) @@ -2374,11 +2379,12 @@ INFO may provide the values of these header arguments (in the ((and (not (funcall tabulablep result)) (not (member "file" result-params))) (let ((org-babel-inline-result-wrap - ;; Hard code {{{results(...)}}} on top of customization. + ;; Hard code {{{results(...)}}} on top of + ;; customization. (format "{{{results(%s)}}}" org-babel-inline-result-wrap))) - (org-babel-examplify-region beg end results-switches inline) - (setq end (point)))))) + (org-babel-examplify-region + beg end results-switches inline))))) ;; Possibly indent results in par with #+results line. (when (and (not inline) (numberp indent) (> indent 0) ;; In this case `table-align' does the work @@ -2391,6 +2397,7 @@ INFO may provide the values of these header arguments (in the (message "Code block returned no value.") (message "Code block produced no output.")) (message "Code block evaluation complete."))) + (set-marker end nil) (when outside-scope (narrow-to-region visible-beg visible-end)) (set-marker visible-beg nil) (set-marker visible-end nil))))))) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index c0bd12a879..989561db7b 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -41,41 +41,38 @@ their value. It is used as the optional LEXICAL argument to (defun org-babel-expand-body:emacs-lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (org-babel--get-vars params)) - (result-params (cdr (assq :result-params params))) - (print-level nil) (print-length nil) - (body (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body "\n)") - (concat body "\n")))) - (if (or (member "code" result-params) - (member "pp" result-params)) - (concat "(pp " body ")") body))) + (let ((vars (org-babel--get-vars params)) + (print-level nil) + (print-length nil)) + (if (null vars) (concat body "\n") + (format "(let (%s)\n%s\n)" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + body)))) (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion (let* ((lexical (cdr (assq :lexical params))) - (result - (eval (read (format (if (member "output" - (cdr (assq :result-params params))) - "(with-output-to-string %s)" - "(progn %s)") - (org-babel-expand-body:emacs-lisp - body params))) - - (if (listp lexical) - lexical - (member lexical '("yes" "t")))))) - (org-babel-result-cond (cdr (assq :result-params params)) + (result-params (cdr (assq :result-params params))) + (body (format (if (member "output" result-params) + "(with-output-to-string %s\n)" + "(progn %s\n)") + (org-babel-expand-body:emacs-lisp body params))) + (result (eval (read (if (or (member "code" result-params) + (member "pp" result-params)) + (concat "(pp " body ")") + body)) + (if (listp lexical) + lexical + (member lexical '("yes" "t")))))) + (org-babel-result-cond result-params (let ((print-level nil) (print-length nil)) - (if (or (member "scalar" (cdr (assq :result-params params))) - (member "verbatim" (cdr (assq :result-params params)))) + (if (or (member "scalar" result-params) + (member "verbatim" result-params)) (format "%S" result) (format "%s" result))) (org-babel-reassemble-table diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index f90dd53bb0..598461874f 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -6992,11 +6992,16 @@ The optional argument TYPE tells the agenda type." (list 'face (org-get-todo-face (match-string 2 x))) x) (when (match-end 1) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))))) + (setq x + (concat + (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + ;; Remove `display' property as the icon could leak + ;; on the white space. + (org-add-props " " (org-plist-delete (text-properties-at 0 x) + 'display)) + (substring x (match-end 3))))))) x))) (defsubst org-cmp-values (a b property) @@ -7592,7 +7597,7 @@ also press `-' or `+' to switch between filtering and excluding." (org-global-tags-completion-table))) (let ((completion-ignore-case t)) (setq tag (completing-read - "Tag: " org-global-tags-completion-table)))) + "Tag: " org-global-tags-completion-table nil t)))) (cond ((eq char ?\r) (org-agenda-filter-show-all-tag) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index 63e23cc118..43207308ba 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -242,8 +242,10 @@ be replaced with content and expanded: happens after expanding non-interactive %-escapes, those can be used to fill the expression. %<...> The result of format-time-string on the ... format specification. - %t Time stamp, date only. - %T Time stamp with date and time. + %t Time stamp, date only. The time stamp is the current time, + except when called from agendas with `\\[org-agenda-capture]' or + with `org-capture-use-agenda-date' set. + %T Time stamp as above, with date and time. %u, %U Like the above, but inactive time stamps. %i Initial content, copied from the active region. If %i is indented, the entire inserted text will be indented as well. @@ -261,7 +263,8 @@ be replaced with content and expanded: %^g Prompt for tags, with completion on tags in target file. %^G Prompt for tags, with completion on all tags in all agenda files. %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like: %^{Please specify birthday}t + You may define a prompt like: %^{Please specify birthday}t. + The default date is that of %t, see above. %^C Interactive selection of which kill or clip to use. %^L Like %^C, but insert as link. %^{prop}p Prompt the user for a value for property `prop'. @@ -1126,6 +1129,7 @@ may have been stored before." (mapconcat 'identity (split-string txt "\n") "\n ")))) ;; Prepare surrounding empty lines. + (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) (setq beg (point)) (unless (eolp) (save-excursion (insert "\n"))) @@ -1143,10 +1147,9 @@ may have been stored before." (insert txt) (org-capture-empty-lines-after) (org-capture-position-for-last-stored beg) - (forward-char 1) (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) + (org-capture-mark-kill-region beg end) + (org-capture-narrow beg end) (if (or (re-search-backward "%\\?" beg t) (re-search-forward "%\\?" end t)) (replace-match "")))) @@ -1575,12 +1578,16 @@ The template may still contain \"%?\" for cursor positioning." (replace-match "\\1" nil nil v-a) v-a)) (v-n user-full-name) - (v-k (and (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) + (v-k (if (marker-buffer org-clock-marker) + (org-no-properties org-clock-heading) + "")) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string - (buffer-file-name (marker-buffer org-clock-marker)) - org-clock-heading))) + (format "%s::*%s" + (buffer-file-name (marker-buffer org-clock-marker)) + v-k) + v-k) + "")) (v-f (or (org-capture-get :original-file-nondirectory) "")) (v-F (or (org-capture-get :original-file) "")) (org-capture--clipboards @@ -1744,24 +1751,27 @@ The template may still contain \"%?\" for cursor positioning." (_ (error "Invalid `org-capture--clipboards' value: %S" org-capture--clipboards))))) ("p" (org-set-property prompt nil)) - ((guard key) + ((or "t" "T" "u" "U") ;; These are the date/time related ones. (let* ((upcase? (equal (upcase key) key)) - (org-time-was-given upcase?) - (org-end-time-was-given) + (org-end-time-was-given nil) (time (org-read-date upcase? t nil prompt))) - (org-insert-time-stamp - time org-time-was-given - (member key '("u" "U")) - nil nil (list org-end-time-was-given)))) - (_ + (let ((org-time-was-given upcase?)) + (org-insert-time-stamp + time org-time-was-given + (member key '("u" "U")) + nil nil (list org-end-time-was-given))))) + (`nil (push (org-completing-read (concat (or prompt "Enter string") (and default (format " [%s]" default)) ": ") completions nil nil nil nil default) strings) - (insert (car strings))))))))) + (insert (car strings))) + (_ + (error "Unknown template placeholder: \"%%^%s\"" + key)))))))) ;; Replace %n escapes with nth %^{...} string. (setq strings (nreverse strings)) @@ -1892,9 +1902,7 @@ Assume sexps have been marked with (if jump-to-captured '(:jump-to-captured t))))) org-remember-templates)))) -;;; The function was made obsolete by commit 65399674d5 of -;;; 2013-02-22. This make-obsolete call was added 2016-09-01. -(make-obsolete 'org-capture-import-remember-templates "use the `org-capture-templates' variable instead." "Org 9.0") + (provide 'org-capture) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index cb6a6c9ad1..aa5c375cef 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1418,11 +1418,13 @@ for a todo state to switch to, overriding the existing value (defun org-clock-get-sum-start () "Return the time from which clock times should be counted. -This is for the currently running clock as it is displayed -in the mode line. This function looks at the properties -LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the -corresponding variable `org-clock-mode-line-total' and then -decides which time to use." + +This is for the currently running clock as it is displayed in the +mode line. This function looks at the properties LAST_REPEAT and +in particular CLOCK_MODELINE_TOTAL and the corresponding variable +`org-clock-mode-line-total' and then decides which time to use. + +The time is always returned as UTC." (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL") (symbol-name org-clock-mode-line-total))) (lr (org-entry-get nil "LAST_REPEAT"))) @@ -1432,13 +1434,13 @@ decides which time to use." (current-time)) ((equal cmt "today") (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time)) + (let* ((dt (org-decode-time nil t)) (hour (nth 2 dt)) (day (nth 3 dt))) (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day))) (setf (nth 2 dt) org-extend-today-until) - (setq dt (append (list 0 0) (nthcdr 2 dt))) - (apply 'encode-time dt))) + (setq dt (append (list 0 0) (nthcdr 2 dt) '(t))) + (apply #'encode-time dt))) ((or (equal cmt "all") (and (or (not cmt) (equal cmt "auto")) (not lr))) @@ -1448,9 +1450,7 @@ decides which time to use." (and (or (not cmt) (equal cmt "auto")) lr)) (setq org--msg-extra "showing task time since last repeat.") - (if (not lr) - nil - (org-time-string-to-time lr))) + (and lr (org-time-string-to-time lr t))) (t nil)))) (defun org-clock-find-position (find-unclosed) @@ -1803,14 +1803,15 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) (lmax 30) (ltimes (make-vector lmax 0)) - (t1 0) (level 0) - ts te dt + (tstart (cond ((stringp tstart) (org-time-string-to-seconds tstart t)) + ((consp tstart) (float-time tstart)) + (t tstart))) + (tend (cond ((stringp tend) (org-time-string-to-seconds tend t)) + ((consp tend) (float-time tend)) + (t tend))) + (t1 0) time) - (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) - (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) - (if (consp tstart) (setq tstart (float-time tstart))) - (if (consp tend) (setq tend (float-time tend))) (remove-text-properties (point-min) (point-max) `(,(or propname :org-clock-minutes) t :org-clock-force-headline-inclusion t)) @@ -1819,26 +1820,27 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (while (re-search-backward re nil t) (cond ((match-end 2) - ;; Two time stamps - (setq ts (match-string 2) - te (match-string 3) - ts (float-time - (apply #'encode-time (org-parse-time-string ts nil t))) - te (float-time - (apply #'encode-time (org-parse-time-string te nil t))) - ts (if tstart (max ts tstart) ts) - te (if tend (min te tend) te) - dt (- te ts) - t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) + ;; Two time stamps. + (let* ((ts (float-time + (apply #'encode-time + (save-match-data + (org-parse-time-string + (match-string 2) nil t))))) + (te (float-time + (apply #'encode-time + (org-parse-time-string (match-string 3) nil t)))) + (dt (- (if tend (min te tend) te) + (if tstart (max ts tstart) ts)))) + (when (> dt 0) (cl-incf t1 (floor (/ dt 60)))))) ((match-end 4) - ;; A naked time + ;; A naked time. (setq t1 (+ t1 (string-to-number (match-string 5)) (* 60 (string-to-number (match-string 4)))))) - (t ;; A headline - ;; Add the currently clocking item time to the total + (t ;A headline + ;; Add the currently clocking item time to the total. (when (and org-clock-report-include-clocking-task - (equal (org-clocking-buffer) (current-buffer)) - (equal (marker-position org-clock-hd-marker) (point)) + (eq (org-clocking-buffer) (current-buffer)) + (eq (marker-position org-clock-hd-marker) (point)) tstart tend (>= (float-time org-clock-start-time) tstart) @@ -2701,16 +2703,14 @@ LEVEL is an integer. Indent by two spaces per level above 1." (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts))) (setq ts (float-time (encode-time 0 0 0 day month year))))) (ts - (setq ts (float-time - (apply #'encode-time (org-parse-time-string ts nil t)))))) + (setq ts (float-time (apply #'encode-time (org-parse-time-string ts)))))) (cond ((numberp te) ;; Likewise for te. (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te))) (setq te (float-time (encode-time 0 0 0 day month year))))) (te - (setq te (float-time - (apply #'encode-time (org-parse-time-string te nil t)))))) + (setq te (float-time (apply #'encode-time (org-parse-time-string te)))))) (setq tsb (if (eq step0 'week) (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index e1d40369f1..68a1166c81 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -60,6 +60,12 @@ (defalias 'format-message 'format) (defalias 'gui-get-selection 'x-get-selection)) +(defun org-decode-time (&optional time zone) + "Backward-compatible function for `decode-time'." + (if (< emacs-major-version 25) + (decode-time time) + (decode-time time zone))) + ;;; Obsolete aliases (remove them after the next major release). @@ -293,6 +299,12 @@ See `org-link-parameters' for documentation on the other parameters." (define-obsolete-function-alias 'org-babel-number-p 'org-babel--string-to-number "Org 9.0") +;;; The function was made obsolete by commit 65399674d5 of 2013-02-22. +;;; This make-obsolete call was added 2016-09-01. +(make-obsolete 'org-capture-import-remember-templates + "use the `org-capture-templates' variable instead." + "Org 9.0") + ;;;; Obsolete link types diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 41b4a3ac78..f4fe6447a6 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -2983,16 +2983,8 @@ Assume point is at the beginning of the LaTeX fragment." (save-excursion (let* ((begin (point)) (after-fragment - (if (eq (char-after) ?$) - (if (eq (char-after (1+ (point))) ?$) - (search-forward "$$" nil t 2) - (and (not (eq (char-before) ?$)) - (search-forward "$" nil t 2) - (not (memq (char-before (match-beginning 0)) - '(?\s ?\t ?\n ?, ?.))) - (looking-at-p - "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") - (point))) + (cond + ((not (eq ?$ (char-after))) (pcase (char-after (1+ (point))) (?\( (search-forward "\\)" nil t)) (?\[ (search-forward "\\]" nil t)) @@ -3000,10 +2992,23 @@ Assume point is at the beginning of the LaTeX fragment." ;; Macro. (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\ \\|\\({[^{}\n]*}\\)\\)*") - (match-end 0)))))) - (post-blank (if (not after-fragment) (throw 'no-object nil) - (goto-char after-fragment) - (skip-chars-forward " \t"))) + (match-end 0))))) + ((eq ?$ (char-after (1+ (point)))) + (search-forward "$$" nil t 2)) + (t + (and (not (eq ?$ (char-before))) + (not (memq (char-after (1+ (point))) + '(?\s ?\t ?\n ?, ?. ?\;))) + (search-forward "$" nil t 2) + (not (memq (char-before (match-beginning 0)) + '(?\s ?\t ?\n ?, ?.))) + (looking-at-p + "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") + (point))))) + (post-blank + (if (not after-fragment) (throw 'no-object nil) + (goto-char after-fragment) + (skip-chars-forward " \t"))) (end (point))) (list 'latex-fragment (list :value (buffer-substring-no-properties begin after-fragment) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index 10c96179b6..4a22b15050 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -142,11 +142,11 @@ useful to make it ever so slightly different." ;; Inline tasks line prefixes (aset org-indent--inlinetask-line-prefixes n - (org-add-props (if (bound-and-true-p org-inlinetask-show-first-star) - (concat org-indent-inlinetask-first-star - (substring heading-prefix 1)) - heading-prefix) - nil 'face 'org-indent))) + (cond ((<= n 1) "") + ((bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring heading-prefix 1))) + (t (org-add-props heading-prefix nil 'face 'org-indent))))) ;; Text line prefixes. (aset org-indent--text-line-prefixes n diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 3a6a7f4db0..92537fc2cc 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -205,7 +205,8 @@ default." (require 'erc) (require 'erc-log) (let* ((server (car (car link))) - (port (or (string-to-number (cadr (pop link))) erc-default-port)) + (port (let ((p (cadr (pop link)))) + (if p (string-to-number p) erc-default-port))) (server-buffer) (buffer-list (erc-buffer-filter diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el index 5abda7c4a6..9007bf8f95 100644 --- a/lisp/org/org-lint.el +++ b/lisp/org/org-lint.el @@ -724,7 +724,7 @@ Use \"export %s\" instead" (org-element-map ast 'footnote-reference (lambda (f) (let ((label (org-element-property :label f))) - (and label + (and (eq 'standard (org-element-property :type f)) (not (member label definitions)) (list (org-element-property :begin f) (format "Missing definition for footnote [%s]" diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index 3dc9c5450e..3b8f8140c9 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -186,56 +186,54 @@ found in the buffer with no definition in TEMPLATES. Optional argument KEYWORDS, when non-nil is a list of keywords, as strings, where macro expansion is allowed." - (save-excursion - (goto-char (point-min)) - (let ((properties-regexp - (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) - record) - (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (unless (save-match-data (org-in-commented-heading-p)) - (let* ((datum (save-match-data (org-element-context))) - (type (org-element-type datum)) - (macro - (cond - ((eq type 'macro) datum) - ;; In parsed keywords and associated node - ;; properties, force macro recognition. - ((or (and (eq type 'keyword) - (member (org-element-property :key datum) - keywords)) - (and (eq type 'node-property) - (string-match-p properties-regexp - (org-element-property :key - datum)))) - (save-excursion - (goto-char (match-beginning 0)) - (org-element-macro-parser)))))) - (when macro - (let* ((value (org-macro-expand macro templates)) - (begin (org-element-property :begin macro)) - (signature (list begin - macro - (org-element-property :args macro)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the - ;; same position twice. - (cond ((member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key macro))) - (value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end macro)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of - ;; recursive expansions. - (save-excursion (insert value))) - (finalize - (error "Undefined Org macro: %s; aborting" - (org-element-property :key macro)))))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'" + (regexp-opt keywords))) + record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (unless (save-match-data (org-in-commented-heading-p)) + (let* ((datum (save-match-data (org-element-context))) + (type (org-element-type datum)) + (macro + (cond + ((eq type 'macro) datum) + ;; In parsed keywords and associated node + ;; properties, force macro recognition. + ((or (and (eq type 'keyword) + (member (org-element-property :key datum) keywords)) + (and (eq type 'node-property) + (string-match-p properties-regexp + (org-element-property :key datum)))) + (save-excursion + (goto-char (match-beginning 0)) + (org-element-macro-parser)))))) + (when macro + (let* ((value (org-macro-expand macro templates)) + (begin (org-element-property :begin macro)) + (signature (list begin + macro + (org-element-property :args macro)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the + ;; same position twice. + (cond ((member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key macro))) + (value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end macro)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of + ;; recursive expansions. + (save-excursion (insert value))) + (finalize + (error "Undefined Org macro: %s; aborting" + (org-element-property :key macro)))))))))))) (defun org-macro-escape-arguments (&rest args) "Build macro's arguments string from ARGS. diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index ca47e5a5a3..aae59d3c1f 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -304,6 +304,43 @@ error when the user input is empty." (allow-empty? nil) (t (user-error "Empty input is not valid"))))) +(defconst org-unique-local-variables + '(org-element--cache + org-element--cache-objects + org-element--cache-sync-keys + org-element--cache-sync-requests + org-element--cache-sync-timer) + "List of local variables that cannot be transferred to another buffer.") + +(defun org-get-local-variables () + "Return a list of all local variables in an Org mode buffer." + (delq nil + (mapcar + (lambda (x) + (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) + (name (car binding))) + (and (not (get name 'org-state)) + (not (memq name org-unique-local-variables)) + (string-match-p + "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ +auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name name)) + binding))) + (with-temp-buffer + (org-mode) + (buffer-local-variables))))) + +(defun org-clone-local-variables (from-buffer &optional regexp) + "Clone local variables from FROM-BUFFER. +Optional argument REGEXP selects variables to clone." + (dolist (pair (buffer-local-variables from-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (when (and (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match-p regexp (symbol-name name)))) + (ignore-errors (set (make-local-variable name) value))))))) + + (provide 'org-macs) ;;; org-macs.el ends here diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 9fee09f38e..192ccadfde 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -693,7 +693,7 @@ encryption program does not understand them." (defun org-mobile-encrypt-file (infile outfile) "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." (shell-command - (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s" + (format "openssl enc -md md5 -aes-256-cbc -salt -pass %s -in %s -out %s" (shell-quote-argument (concat "pass:" (org-mobile-encryption-password))) (shell-quote-argument (expand-file-name infile)) @@ -702,7 +702,7 @@ encryption program does not understand them." (defun org-mobile-decrypt-file (infile outfile) "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." (shell-command - (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s" + (format "openssl enc -md md5 -d -aes-256-cbc -salt -pass %s -in %s -out %s" (shell-quote-argument (concat "pass:" (org-mobile-encryption-password))) (shell-quote-argument (expand-file-name infile)) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 8254356745..cd4b216aae 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -520,7 +520,9 @@ The location for a browser's bookmark should look like this: ;; As we enter this function for a match on our protocol, the return value ;; defaults to nil. (let ((result nil) - (f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url))) + (f (org-protocol-sanitize-uri + (plist-get (org-protocol-parse-parameters fname nil '(:url)) + :url)))) (catch 'result (dolist (prolist org-protocol-project-alist) (let* ((base-url (plist-get (cdr prolist) :base-url)) @@ -554,7 +556,7 @@ The location for a browser's bookmark should look like this: ;; Try to match a rewritten URL and map it to ;; a real file. Compare redirects without ;; suffix. - (when (string-match-p (car rewrite) f2) + (when (string-match-p (car rewrite) f1) (throw 'result (concat wdir (cdr rewrite)))))))) ;; -- end of redirects -- diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 0e04d4b5a8..9a3ff53aa4 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -424,11 +424,10 @@ Assume point is in the corresponding edit buffer." (buffer-string)))) (defun org-src--edit-element - (datum name &optional major write-back contents remote) + (datum name &optional initialize write-back contents remote) "Edit DATUM contents in a dedicated buffer NAME. -MAJOR is the major mode used in the edit buffer. A nil value is -equivalent to `fundamental-mode'. +INITIALIZE is a function to call upon creating the buffer. When WRITE-BACK is non-nil, assume contents will replace original region. Moreover, if it is a function, apply it in the edit @@ -489,12 +488,13 @@ Leave point in edit buffer." (unless preserve-ind (org-do-remove-indentation)) (set-buffer-modified-p nil) (setq buffer-file-name nil) - ;; Start major mode. - (if (not major) (fundamental-mode) + ;; Initialize buffer. + (when (functionp initialize) (let ((org-inhibit-startup t)) - (condition-case e (funcall major) - (error (message "Language mode `%s' fails with: %S" - major (nth 1 e)))))) + (condition-case e + (funcall initialize) + (error (message "Initialization fails with: %S" + (error-message-string e)))))) ;; Transmit buffer-local variables for exit function. It must ;; be done after initializing major mode, as this operation ;; may reset them otherwise. @@ -837,7 +837,10 @@ A coderef format regexp can only match at the end of a line." (org-src--edit-element definition (format "*Edit footnote [%s]*" label) - #'org-mode + (let ((source (current-buffer))) + (lambda () + (org-mode) + (org-clone-local-variables source))) (lambda () (if (not inline?) (delete-region (point) (search-forward "]")) (delete-region (point) (search-forward ":" nil t 2)) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 357fdcfa44..6b4e21b646 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1335,7 +1335,7 @@ Only data lines count for this." (org-table-check-inside-data-field)) (save-excursion (let ((c 0) - (pos (point))) + (pos (line-beginning-position))) (goto-char (org-table-begin)) (while (<= (point) pos) (when (looking-at org-table-dataline-regexp) (cl-incf c)) @@ -1532,28 +1532,31 @@ non-nil, the one above is used." (dline1 (org-table-current-dline)) (dline2 (+ dline1 (if up -1 1))) (tonew (if up 0 2)) - txt hline2p) + hline2p) + (when (and up (= (point-min) (line-beginning-position))) + (user-error "Cannot move row further")) (beginning-of-line tonew) - (unless (org-at-table-p) + (when (or (and (not up) (eobp)) (not (org-at-table-p))) (goto-char pos) (user-error "Cannot move row further")) (setq hline2p (looking-at org-table-hline-regexp)) (goto-char pos) - (beginning-of-line 1) - (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) - (beginning-of-line 0) - (org-move-to-column col) - (unless (or hline1p hline2p - (not (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm - "Fix formulas? ")))) - (org-table-fix-formulas - "@" (list (cons (number-to-string dline1) (number-to-string dline2)) - (cons (number-to-string dline2) (number-to-string dline1))))))) + (let ((row (delete-and-extract-region (line-beginning-position) + (line-beginning-position 2)))) + (beginning-of-line tonew) + (unless (bolp) (insert "\n")) ;at eob without a newline + (insert row) + (unless (bolp) (insert "\n")) ;missing final newline in ROW + (beginning-of-line 0) + (org-move-to-column col) + (unless (or hline1p hline2p + (not (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm + "Fix formulas? ")))) + (org-table-fix-formulas + "@" (list + (cons (number-to-string dline1) (number-to-string dline2)) + (cons (number-to-string dline2) (number-to-string dline1)))))))) ;;;###autoload (defun org-table-insert-row (&optional arg) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index 2db3eae2d8..182290a707 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.0.9")) + (let ((org-release "9.0.10")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "release_9.0.9")) + (let ((org-git-version "release_9.0.10")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index 5d10eed151..87758fdfdd 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -128,6 +128,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-clock-timestamps-down "org-clock" (&optional n)) (declare-function org-clock-timestamps-up "org-clock" (&optional n)) (declare-function org-clock-update-time-maybe "org-clock" ()) +(declare-function org-clocking-buffer "org-clock" ()) (declare-function org-clocktable-shift "org-clock" (dir n)) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-cache-refresh "org-element" (pos)) @@ -1119,8 +1120,8 @@ Or return the original if not disputed." (defcustom org-ellipsis nil "The ellipsis to use in the Org mode outline. -When nil, just use the standard three dots. -When a string, use that string instead. +When nil, just use the standard three dots. When a non-empty string, +use that string instead. The change affects only Org mode (which will then use its own display table). Changing this requires executing `\\[org-mode]' in a buffer to become @@ -1128,10 +1129,10 @@ effective." :group 'org-startup :type '(choice (const :tag "Default" nil) (string :tag "String" :value "...#")) - :safe #'string-or-null-p) + :safe (lambda (v) (and (string-or-null-p v) (not (equal "" v))))) (defvar org-display-table nil - "The display table for org-mode, in case `org-ellipsis' is non-nil.") + "The display table for Org mode, in case `org-ellipsis' is non-nil.") (defgroup org-keywords nil "Keywords in Org mode." @@ -3573,8 +3574,10 @@ See also `org-tag-persistent-alist' to sidestep this behavior." :group 'org-tags :type '(repeat (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) + (cons :tag "Tag with key" + (string :tag "Tag name") + (character :tag "Access char")) + (list :tag "Tag" (string :tag "Tag name")) (const :tag "Start radio group" (:startgroup)) (const :tag "Start tag group, non distinct" (:startgrouptag)) (const :tag "Group tags delimiter" (:grouptags)) @@ -3606,8 +3609,10 @@ on a per-file basis, insert anywhere in the file: :group 'org-tags :type '(repeat (choice - (cons (string :tag "Tag name") + (cons :tag "Tag with key" + (string :tag "Tag name") (character :tag "Access char")) + (list :tag "Tag" (string :tag "Tag name")) (const :tag "Start radio group" (:startgroup)) (const :tag "Start tag group, non distinct" (:startgrouptag)) (const :tag "Group tags delimiter" (:grouptags)) @@ -4852,7 +4857,9 @@ Otherwise, these types are allowed: :group 'org-sparse-trees) (defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change." + "Re-hide all archived subtrees after a visibility state change. +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'." (when (and (not org-cycle-open-archived-trees) (not (memq state '(overview folded)))) (save-excursion @@ -5582,15 +5589,13 @@ The following commands are available: (setq-local outline-regexp org-outline-regexp) (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) - (when (and org-ellipsis - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) - (fboundp 'make-glyph-code)) + (when (and (stringp org-ellipsis) (not (equal "" org-ellipsis))) (unless org-display-table (setq org-display-table (make-display-table))) (set-display-table-slot org-display-table 4 (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis)) - (if (stringp org-ellipsis) org-ellipsis "...")))) + org-ellipsis))) (setq buffer-display-table org-display-table)) (org-set-regexps-and-options) (org-set-font-lock-defaults) @@ -6210,9 +6215,10 @@ by a #." 'keymap org-mouse-map)) (org-rear-nonsticky-at (match-end 0)) (when org-display-custom-times - (if (match-end 3) - (org-display-custom-time (match-beginning 3) (match-end 3)) - (org-display-custom-time (match-beginning 1) (match-end 1)))) + ;; If it's a date range, activate custom time for second date. + (when (match-end 3) + (org-display-custom-time (match-beginning 3) (match-end 3))) + (org-display-custom-time (match-beginning 1) (match-end 1))) t)) (defvar-local org-target-link-regexp nil @@ -7318,12 +7324,13 @@ open and agenda-wise Org files." (defun org-cycle-hide-drawers (state &optional exceptions) "Re-hide all drawers after a visibility state change. -When non-nil, optional argument EXCEPTIONS is a list of strings -specifying which drawers should not be hidden." +STATE should be one of the symbols listed in the docstring of +`org-cycle-hook'. When non-nil, optional argument EXCEPTIONS is +a list of strings specifying which drawers should not be hidden." (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) (save-excursion - (let* ((globalp (memq state '(contents all))) + (let* ((globalp (eq state 'all)) (beg (if globalp (point-min) (point))) (end (if globalp (point-max) (if (eq state 'children) @@ -9049,14 +9056,6 @@ A non-nil value for INTERACTIVE? is used to signal that this function is being called interactively." (interactive (list current-prefix-arg nil nil nil nil t)) (let ((case-func (if with-case 'identity 'downcase)) - (cmstr - ;; The clock marker is lost when using `sort-subr', let's - ;; store the clocking string. - (when (equal (marker-buffer org-clock-marker) (current-buffer)) - (save-excursion - (goto-char org-clock-marker) - (buffer-substring-no-properties (line-beginning-position) - (point))))) start beg end stars re re2 txt what tmp) ;; Find beginning and end of region to sort @@ -9138,9 +9137,20 @@ function is being called interactively." (save-restriction (narrow-to-region start end) - (let ((dcst (downcase sorting-type)) + (let ((restore-clock? + ;; The clock marker is lost when using `sort-subr'; mark + ;; the clock with temporary `:org-clock-marker-backup' + ;; text property. + (when (and (eq (org-clocking-buffer) (current-buffer)) + (<= start (marker-position org-clock-marker)) + (>= end (marker-position org-clock-marker))) + (org-with-silent-modifications + (put-text-property (1- org-clock-marker) org-clock-marker + :org-clock-marker-backup t)) + t)) + (dcst (downcase sorting-type)) (case-fold-search nil) - (now (current-time))) + (now (current-time))) (sort-subr (/= dcst sorting-type) ;; This function moves to the beginning character of the "record" to @@ -9222,14 +9232,14 @@ function is being called interactively." (concat "Function for comparing keys " "(empty for default `sort-subr' predicate): ") 'allow-empty)))) - ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))))) + ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))) + (when restore-clock? + (move-marker org-clock-marker + (1+ (next-single-property-change + start :org-clock-marker-backup))) + (remove-text-properties (1- org-clock-marker) org-clock-marker + '(:org-clock-marker-backup t))))) (run-hooks 'org-after-sorting-entries-or-items-hook) - ;; Reset the clock marker if needed - (when cmstr - (save-excursion - (goto-char start) - (search-forward cmstr nil t) - (move-marker org-clock-marker (point)))) (message "Sorting entries...done"))) ;;; The orgstruct minor mode @@ -9590,42 +9600,6 @@ Possible values in the list of contexts are `table', `headline', and `item'." (org-in-item-p))) (goto-char pos)))) -(defconst org-unique-local-variables - '(org-element--cache - org-element--cache-objects - org-element--cache-sync-keys - org-element--cache-sync-requests - org-element--cache-sync-timer) - "List of local variables that cannot be transferred to another buffer.") - -(defun org-get-local-variables () - "Return a list of all local variables in an Org mode buffer." - (delq nil - (mapcar - (lambda (x) - (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) - (name (car binding))) - (and (not (get name 'org-state)) - (not (memq name org-unique-local-variables)) - (string-match-p - "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ -auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name name)) - binding))) - (with-temp-buffer - (org-mode) - (buffer-local-variables))))) - -(defun org-clone-local-variables (from-buffer &optional regexp) - "Clone local variables from FROM-BUFFER. -Optional argument REGEXP selects variables to clone." - (dolist (pair (buffer-local-variables from-buffer)) - (pcase pair - (`(,name . ,value) ;ignore unbound variables - (when (and (not (memq name org-unique-local-variables)) - (or (null regexp) (string-match-p regexp (symbol-name name)))) - (set (make-local-variable name) value)))))) - ;;;###autoload (defun org-run-like-in-org-mode (cmd) "Run a command, pretending that the current buffer is in Org mode. @@ -10780,9 +10754,10 @@ When optional argument REFERENCE-BUFFER is non-nil, it should specify a buffer from where the link search should happen. This is used internally by `org-open-link-from-string'. -On top of syntactically correct links, this function will open -the link at point in comments or comment blocks and the first -link in a property drawer line." +On top of syntactically correct links, this function will also +try to open links and time-stamps in comments, example +blocks... i.e., whenever point is on something looking like +a timestamp or a link." (interactive "P") ;; On a code block, open block's results. (unless (call-interactively 'org-babel-open-src-block-result) @@ -10795,38 +10770,51 @@ link in a property drawer line." ;; the closest one. (org-element-lineage (org-element-context) - '(clock comment comment-block footnote-definition - footnote-reference headline inlinetask keyword link - node-property timestamp) + '(clock footnote-definition footnote-reference headline + inlinetask link timestamp) t)) (type (org-element-type context)) (value (org-element-property :value context))) (cond - ((not context) (user-error "No link found")) - ;; Exception: open timestamps and links in properties - ;; drawers, keywords and comments. - ((memq type '(comment comment-block keyword node-property)) - (call-interactively #'org-open-at-point-global)) ;; On a headline or an inlinetask, but not on a timestamp, - ;; a link, a footnote reference or on tags. - ((and (memq type '(headline inlinetask)) - ;; Not on tags. - (let ((case-fold-search nil)) - (save-excursion - (beginning-of-line) - (looking-at org-complex-heading-regexp)) - (or (not (match-beginning 5)) - (< (point) (match-beginning 5))))) - (let* ((data (org-offer-links-in-entry (current-buffer) (point) arg)) - (links (car data)) - (links-end (cdr data))) - (if links - (dolist (link (if (stringp links) (list links) links)) - (search-forward link nil links-end) - (goto-char (match-beginning 0)) - (org-open-at-point)) - (require 'org-attach) - (org-attach-reveal 'if-exists)))) + ;; a link, a footnote reference. + ((memq type '(headline inlinetask)) + (org-match-line org-complex-heading-regexp) + (if (and (match-beginning 5) + (>= (point) (match-beginning 5)) + (< (point) (match-end 5))) + ;; On tags. + (org-tags-view arg (substring (match-string 5) 0 -1)) + ;; Not on tags. + (pcase (org-offer-links-in-entry (current-buffer) (point) arg) + (`(nil . ,_) + (require 'org-attach) + (org-attach-reveal 'if-exists)) + (`(,links . ,links-end) + (dolist (link (if (stringp links) (list links) links)) + (search-forward link nil links-end) + (goto-char (match-beginning 0)) + (org-open-at-point)))))) + ;; On a footnote reference or at definition's label. + ((or (eq type 'footnote-reference) + (and (eq type 'footnote-definition) + (save-excursion + ;; Do not validate action when point is on the + ;; spaces right after the footnote label, in + ;; order to be on par with behaviour on links. + (skip-chars-forward " \t") + (let ((begin + (org-element-property :contents-begin context))) + (if begin (< (point) begin) + (= (org-element-property :post-affiliated context) + (line-beginning-position))))))) + (org-footnote-action)) + ;; No valid context. Ignore catch-all types like `headline'. + ;; If point is on something looking like a link or + ;; a time-stamp, try opening it. It may be useful in + ;; comments, example blocks... + ((memq type '(footnote-definition headline inlinetask nil)) + (call-interactively #'org-open-at-point-global)) ;; On a clock line, make sure point is on the timestamp ;; before opening it. ((and (eq type 'clock) @@ -10842,14 +10830,6 @@ link in a property drawer line." (point))) (user-error "No link found")) ((eq type 'timestamp) (org-follow-timestamp-link)) - ;; On tags within a headline or an inlinetask. - ((and (memq type '(headline inlinetask)) - (let ((case-fold-search nil)) - (save-excursion (beginning-of-line) - (looking-at org-complex-heading-regexp)) - (and (match-beginning 5) - (>= (point) (match-beginning 5))))) - (org-tags-view arg (substring (match-string 5) 0 -1))) ((eq type 'link) ;; When link is located within the description of another ;; link (e.g., an inline image), always open the parent @@ -10919,20 +10899,6 @@ link in a property drawer line." (widen)) (goto-char destination)))) (t (browse-url-at-point)))))) - ;; On a footnote reference or at a footnote definition's label. - ((or (eq type 'footnote-reference) - (and (eq type 'footnote-definition) - (save-excursion - ;; Do not validate action when point is on the - ;; spaces right after the footnote label, in - ;; order to be on par with behaviour on links. - (skip-chars-forward " \t") - (let ((begin - (org-element-property :contents-begin context))) - (if begin (< (point) begin) - (= (org-element-property :post-affiliated context) - (line-beginning-position))))))) - (org-footnote-action)) (t (user-error "No link found"))))) (run-hook-with-args 'org-follow-link-hook))) @@ -11985,7 +11951,9 @@ prefix argument (`C-u C-u C-u C-c C-w')." (if (and arg (not (equal arg 3))) (progn (pop-to-buffer-same-window nbuf) - (goto-char pos) + (goto-char (cond (pos) + ((org-notes-order-reversed-p) (point-min)) + (t (point-max)))) (org-show-context 'org-goto)) (if regionp (progn @@ -12682,7 +12650,7 @@ When called through ELisp, arg is also interpreted in the following way: (replace-match next t t) (cond ((equal this org-state) (message "TODO state was already %s" (org-trim next))) - ((pos-visible-in-window-p hl-pos) + ((not (pos-visible-in-window-p hl-pos)) (message "TODO state changed to %s" (org-trim next)))) (unless head (setq head (org-get-todo-sequence-head org-state) @@ -13741,7 +13709,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) (if (memq org-log-note-how '(time state)) - (let (current-prefix-arg) (org-store-log-note)) + (org-store-log-note) (let ((org-inhibit-startup t)) (org-mode)) (insert (format "# Insert note for %s. # Finish with C-c C-c, or cancel with C-c C-k.\n\n" @@ -13818,7 +13786,7 @@ EXTRA is additional text that will be inserted into the notes buffer." org-log-note-previous-state))))))) (when lines (setq note (concat note " \\\\"))) (push note lines)) - (when (and lines (not (or current-prefix-arg org-note-abort))) + (when (and lines (not org-note-abort)) (with-current-buffer (marker-buffer org-log-note-marker) (org-with-wide-buffer ;; Find location for the new note. @@ -14811,7 +14779,7 @@ it as a time string and apply `float-time' to it. If S is nil, just return 0." ((numberp s) s) ((stringp s) (condition-case nil - (float-time (apply 'encode-time (org-parse-time-string s))) + (float-time (apply #'encode-time (org-parse-time-string s nil t))) (error 0.))) (t 0.))) @@ -19030,9 +18998,7 @@ looks only before point, not after." (catch 'exit (let ((pos (point)) (dodollar (member "$" (plist-get org-format-latex-options :matchers))) - (lim (progn - (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) - (point))) + (lim (save-excursion (org-backward-paragraph) (point))) dd-on str (start 0) m re) (goto-char pos) (when dodollar @@ -19466,7 +19432,7 @@ a HTML file." (insert latex-header) (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) - (let* ((err-msg (format "Please adjust '%s' part of \ + (let* ((err-msg (format "Please adjust `%s' part of \ `org-preview-latex-process-alist'." processing-type)) (image-input-file @@ -20156,6 +20122,8 @@ overwritten, and the table is not marked as requiring realignment." (call-interactively 'org-self-insert-command))))) ((and (org-at-table-p) + (eq N 1) + (not (org-region-active-p)) (progn ;; Check if we blank the field, and if that triggers align. (and (featurep 'org-table) org-table-auto-blank-field @@ -20169,7 +20137,6 @@ overwritten, and the table is not marked as requiring realignment." ;; width. (org-table-blank-field))) t) - (eq N 1) (looking-at "[^|\n]* \\( \\)|")) ;; There is room for insertion without re-aligning the table. (delete-region (match-beginning 1) (match-end 1)) @@ -20198,14 +20165,24 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." (or (not (boundp 'visible-mode)) (not visible-mode)) (or (get-char-property (point) 'invisible) (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look - (let* ((invisible-at-point (get-char-property (point) 'invisible)) - (invisible-before-point (unless (bobp) (get-char-property - (1- (point)) 'invisible))) + ;; OK, we need to take a closer look. Do not consider + ;; invisibility obtained through text properties (e.g., link + ;; fontification), as it cannot be toggled. + (let* ((invisible-at-point + (pcase (get-char-property-and-overlay (point) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o))) + ;; Assume that point cannot land in the middle of an + ;; overlay, or between two overlays. + (invisible-before-point + (and (not invisible-at-point) + (not (bobp)) + (pcase (get-char-property-and-overlay (1- (point)) 'invisible) + (`(,_ . ,(and (pred overlayp) o)) o)))) (border-and-ok-direction (or - ;; Check if we are acting predictably before invisible text - (and invisible-at-point (not invisible-before-point) + ;; Check if we are acting predictably before invisible + ;; text. + (and invisible-at-point (memq kind '(insert delete-backward))) ;; Check if we are acting predictably after invisible text ;; This works not well, and I have turned it off. It seems @@ -20213,8 +20190,7 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; (and (not invisible-at-point) invisible-before-point ;; (memq kind '(insert delete))) ))) - (when (or (memq invisible-at-point '(outline org-hide-block t)) - (memq invisible-before-point '(outline org-hide-block t))) + (when (or invisible-at-point invisible-before-point) (when (eq org-catch-invisible-edits 'error) (user-error "Editing in invisible areas is prohibited, make them visible first")) (if (and org-custom-properties-overlays @@ -20223,9 +20199,17 @@ The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; Make the area visible (save-excursion (when invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (outline-show-subtree)) + (goto-char + (previous-single-char-property-change (point) 'invisible))) + ;; Remove whatever overlay is currently making yet-to-be + ;; edited text invisible. Also remove nested invisibility + ;; related overlays. + (delete-overlay (or invisible-at-point invisible-before-point)) + (let ((origin (if invisible-at-point (point) (1- (point))))) + (while (pcase (get-char-property-and-overlay origin 'invisible) + (`(,_ . ,(and (pred overlayp) o)) + (delete-overlay o) + t))))) (cond ((eq org-catch-invisible-edits 'show) ;; That's it, we do the edit after showing @@ -20914,16 +20898,14 @@ this numeric value." (defun org-copy-visible (beg end) "Copy the visible parts of the region." (interactive "r") - (let (snippets s) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (setq s (goto-char (point-min))) - (while (not (= (point) (point-max))) - (goto-char (org-find-invisible)) - (push (buffer-substring s (point)) snippets) - (setq s (goto-char (org-find-visible)))))) - (kill-new (apply 'concat (nreverse snippets))))) + (let ((result "")) + (while (/= beg end) + (when (get-char-property beg 'invisible) + (setq beg (next-single-char-property-change beg 'invisible nil end))) + (let ((next (next-single-char-property-change beg 'invisible nil end))) + (setq result (concat result (buffer-substring beg next))) + (setq beg next))) + (kill-new result))) (defun org-copy-special () "Copy region in table or copy current subtree. @@ -24416,74 +24398,74 @@ item, etc. It also provides some special moves for convenience: - On a table or a property drawer, jump after it. - On a verse or source block, stop after blank lines." (interactive) - (when (eobp) (user-error "Cannot move further down")) - (let* ((deactivate-mark nil) - (element (org-element-at-point)) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element)) - (contents-begin (org-element-property :contents-begin element)) - (contents-end (org-element-property :contents-end element)) - (end (let ((end (org-element-property :end element)) (parent element)) - (while (and (setq parent (org-element-property :parent parent)) - (= (org-element-property :contents-end parent) end)) - (setq end (org-element-property :end parent))) - end))) - (cond ((not element) - (skip-chars-forward " \r\t\n") - (or (eobp) (beginning-of-line))) - ;; On affiliated keywords, move to element's beginning. - ((< (point) post-affiliated) - (goto-char post-affiliated)) - ;; At a table row, move to the end of the table. Similarly, - ;; at a node property, move to the end of the property - ;; drawer. - ((memq type '(node-property table-row)) - (goto-char (org-element-property - :end (org-element-property :parent element)))) - ((memq type '(property-drawer table)) (goto-char end)) - ;; Consider blank lines as separators in verse and source - ;; blocks to ease editing. - ((memq type '(src-block verse-block)) - (when (eq type 'src-block) - (setq contents-end - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (beginning-of-line) - (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) - (if (not (re-search-forward "^[ \t]*$" contents-end t)) - (goto-char end) - (skip-chars-forward " \r\t\n") - (if (= (point) contents-end) (goto-char end) - (beginning-of-line)))) - ;; With no contents, just skip element. - ((not contents-begin) (goto-char end)) - ;; If contents are invisible, skip the element altogether. - ((org-invisible-p (line-end-position)) - (cl-case type - (headline - (org-with-limited-levels (outline-next-visible-heading 1))) - ;; At a plain list, make sure we move to the next item - ;; instead of skipping the whole list. - (plain-list (forward-char) - (org-forward-paragraph)) - (otherwise (goto-char end)))) - ((>= (point) contents-end) (goto-char end)) - ((>= (point) contents-begin) - ;; This can only happen on paragraphs and plain lists. - (cl-case type - (paragraph (goto-char end)) - ;; At a plain list, try to move to second element in - ;; first item, if possible. - (plain-list (end-of-line) - (org-forward-paragraph)))) - ;; When contents start on the middle of a line (e.g. in - ;; items and footnote definitions), try to reach first - ;; element starting after current line. - ((> (line-end-position) contents-begin) - (end-of-line) - (org-forward-paragraph)) - (t (goto-char contents-begin))))) + (unless (eobp) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (end (let ((end (org-element-property :end element)) (parent element)) + (while (and (setq parent (org-element-property :parent parent)) + (= (org-element-property :contents-end parent) end)) + (setq end (org-element-property :end parent))) + end))) + (cond ((not element) + (skip-chars-forward " \r\t\n") + (or (eobp) (beginning-of-line))) + ;; On affiliated keywords, move to element's beginning. + ((< (point) post-affiliated) + (goto-char post-affiliated)) + ;; At a table row, move to the end of the table. Similarly, + ;; at a node property, move to the end of the property + ;; drawer. + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :end (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char end)) + ;; Consider blank lines as separators in verse and source + ;; blocks to ease editing. + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-end + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (beginning-of-line) + (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) + (if (not (re-search-forward "^[ \t]*$" contents-end t)) + (goto-char end) + (skip-chars-forward " \r\t\n") + (if (= (point) contents-end) (goto-char end) + (beginning-of-line)))) + ;; With no contents, just skip element. + ((not contents-begin) (goto-char end)) + ;; If contents are invisible, skip the element altogether. + ((org-invisible-p (line-end-position)) + (cl-case type + (headline + (org-with-limited-levels (outline-next-visible-heading 1))) + ;; At a plain list, make sure we move to the next item + ;; instead of skipping the whole list. + (plain-list (forward-char) + (org-forward-paragraph)) + (otherwise (goto-char end)))) + ((>= (point) contents-end) (goto-char end)) + ((>= (point) contents-begin) + ;; This can only happen on paragraphs and plain lists. + (cl-case type + (paragraph (goto-char end)) + ;; At a plain list, try to move to second element in + ;; first item, if possible. + (plain-list (end-of-line) + (org-forward-paragraph)))) + ;; When contents start on the middle of a line (e.g. in + ;; items and footnote definitions), try to reach first + ;; element starting after current line. + ((> (line-end-position) contents-begin) + (end-of-line) + (org-forward-paragraph)) + (t (goto-char contents-begin)))))) (defun org-backward-paragraph () "Move backward to start of previous paragraph or equivalent. @@ -24498,55 +24480,55 @@ convenience: - On a table or a property drawer, move to its beginning. - On a verse or source block, stop before blank lines." (interactive) - (when (bobp) (user-error "Cannot move further up")) - (let* ((deactivate-mark nil) - (element (org-element-at-point)) - (type (org-element-type element)) - (contents-begin (org-element-property :contents-begin element)) - (contents-end (org-element-property :contents-end element)) - (post-affiliated (org-element-property :post-affiliated element)) - (begin (org-element-property :begin element))) - (cond - ((not element) (goto-char (point-min))) - ((= (point) begin) - (backward-char) - (org-backward-paragraph)) - ((<= (point) post-affiliated) (goto-char begin)) - ((memq type '(node-property table-row)) - (goto-char (org-element-property - :post-affiliated (org-element-property :parent element)))) - ((memq type '(property-drawer table)) (goto-char begin)) - ((memq type '(src-block verse-block)) - (when (eq type 'src-block) - (setq contents-begin - (save-excursion (goto-char begin) (forward-line) (point)))) - (if (= (point) contents-begin) (goto-char post-affiliated) - ;; Inside a verse block, see blank lines as paragraph - ;; separators. - (let ((origin (point))) - (skip-chars-backward " \r\t\n" contents-begin) - (when (re-search-backward "^[ \t]*$" contents-begin 'move) - (skip-chars-forward " \r\t\n" origin) - (if (= (point) origin) (goto-char contents-begin) - (beginning-of-line)))))) - ((not contents-begin) (goto-char (or post-affiliated begin))) - ((eq type 'paragraph) - (goto-char contents-begin) - ;; When at first paragraph in an item or a footnote definition, - ;; move directly to beginning of line. - (let ((parent-contents - (org-element-property - :contents-begin (org-element-property :parent element)))) - (when (and parent-contents (= parent-contents contents-begin)) - (beginning-of-line)))) - ;; At the end of a greater element, move to the beginning of the - ;; last element within. - ((>= (point) contents-end) - (goto-char (1- contents-end)) - (org-backward-paragraph)) - (t (goto-char (or post-affiliated begin)))) - ;; Ensure we never leave point invisible. - (when (org-invisible-p (point)) (beginning-of-visual-line)))) + (unless (bobp) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (post-affiliated (org-element-property :post-affiliated element)) + (begin (org-element-property :begin element))) + (cond + ((not element) (goto-char (point-min))) + ((= (point) begin) + (backward-char) + (org-backward-paragraph)) + ((<= (point) post-affiliated) (goto-char begin)) + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :post-affiliated (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char begin)) + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-begin + (save-excursion (goto-char begin) (forward-line) (point)))) + (if (= (point) contents-begin) (goto-char post-affiliated) + ;; Inside a verse block, see blank lines as paragraph + ;; separators. + (let ((origin (point))) + (skip-chars-backward " \r\t\n" contents-begin) + (when (re-search-backward "^[ \t]*$" contents-begin 'move) + (skip-chars-forward " \r\t\n" origin) + (if (= (point) origin) (goto-char contents-begin) + (beginning-of-line)))))) + ((not contents-begin) (goto-char (or post-affiliated begin))) + ((eq type 'paragraph) + (goto-char contents-begin) + ;; When at first paragraph in an item or a footnote definition, + ;; move directly to beginning of line. + (let ((parent-contents + (org-element-property + :contents-begin (org-element-property :parent element)))) + (when (and parent-contents (= parent-contents contents-begin)) + (beginning-of-line)))) + ;; At the end of a greater element, move to the beginning of the + ;; last element within. + ((>= (point) contents-end) + (goto-char (1- contents-end)) + (org-backward-paragraph)) + (t (goto-char (or post-affiliated begin)))) + ;; Ensure we never leave point invisible. + (when (org-invisible-p (point)) (beginning-of-visual-line))))) (defun org-forward-element () "Move forward by one element. diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 49562fa691..aeb38ebc10 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -2034,7 +2034,8 @@ holding export options." (format (if html5-fancy "

    %s

    \n" - "\n
    \n%s\n") + (concat "\n" (org-html-close-tag "br" nil info) "\n" + "%s\n")) (org-export-data subtitle info)) ""))))) contents diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el index 9ccbb27244..e1956ccdcf 100644 --- a/lisp/org/ox-icalendar.el +++ b/lisp/org/ox-icalendar.el @@ -879,22 +879,24 @@ The file is stored under the name chosen in "Export current agenda view to an iCalendar FILE. This function assumes major mode for current buffer is `org-agenda-mode'." - (let* ((org-export-babel-evaluate) ; Don't evaluate Babel block. + (let* ((org-export-babel-evaluate) ;don't evaluate Babel blocks (contents (org-export-string-as (with-output-to-string (save-excursion - (let ((p (point-min))) + (let ((p (point-min)) + (seen nil)) ;prevent duplicates (while (setq p (next-single-property-change p 'org-hd-marker)) (let ((m (get-text-property p 'org-hd-marker))) - (when m + (when (and m (not (member m seen))) + (push m seen) (with-current-buffer (marker-buffer m) (org-with-wide-buffer (goto-char (marker-position m)) (princ (org-element-normalize-string - (buffer-substring - (point) (progn (outline-next-heading) (point))))))))) + (buffer-substring (point) + (org-entry-end-position)))))))) (forward-line))))) 'icalendar t '(:ascii-charset utf-8 :ascii-links-to-notes nil diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el index f11a8a63a2..ec4b49585f 100644 --- a/lisp/org/ox-latex.el +++ b/lisp/org/ox-latex.el @@ -1623,15 +1623,15 @@ non-nil, only includes packages relevant to image generation, as specified in `org-latex-default-packages-alist' or `org-latex-packages-alist'." (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class (plist-get info :latex-classes)))) (class-template (or template - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))) + (let* ((class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class (plist-get info :latex-classes))))) + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1)))) (user-error "Unknown LaTeX class `%s'" class)))) (org-latex-guess-polyglossia-language (org-latex-guess-babel-language @@ -1644,7 +1644,9 @@ specified in `org-latex-default-packages-alist' or snippet? (mapconcat #'org-element-normalize-string (list (plist-get info :latex-header) - (plist-get info :latex-header-extra)) "")))) + (and (not snippet?) + (plist-get info :latex-header-extra))) + "")))) info) info))) diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index c8ea1fa045..2478cc6ab8 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -395,8 +395,9 @@ a communication channel." (org-export-get-reference destination info)))))))) ((org-export-inline-image-p link org-html-inline-image-rules) (let ((path (let ((raw-path (org-element-property :path link))) - (if (not (file-name-absolute-p raw-path)) raw-path - (expand-file-name raw-path)))) + (cond ((not (equal "file" type)) (concat type ":" raw-path)) + ((not (file-name-absolute-p raw-path)) raw-path) + (t (expand-file-name raw-path))))) (caption (org-export-data (org-export-get-caption (org-export-get-parent-element link)) info))) @@ -411,7 +412,7 @@ a communication channel." (t (let* ((raw-path (org-element-property :path link)) (path (cond - ((member type '("http" "https" "ftp")) + ((member type '("http" "https" "ftp" "mailto" "irc")) (concat type ":" raw-path)) ((string= type "file") (org-export-file-uri (funcall link-org-files-as-md raw-path))) diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 943a6be031..75554689aa 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -112,7 +112,9 @@ (:odt-table-styles nil nil org-odt-table-styles) (:odt-use-date-fields nil nil org-odt-use-date-fields) ;; Redefine regular option. - (:with-latex nil "tex" org-odt-with-latex))) + (:with-latex nil "tex" org-odt-with-latex) + ;; Retrieve LaTeX header for fragments. + (:latex-header "LATEX_HEADER" nil nil newline))) ;;; Dependencies @@ -3731,42 +3733,45 @@ contextual information." (mathml (format "Creating MathML snippet %d..." count)))) ;; Get an Org-style link to PNG image or the MathML ;; file. - (org-link - (let ((link (with-temp-buffer - (insert latex-frag) - (org-format-latex cache-subdir nil nil cache-dir - nil display-msg nil - processing-type) - (buffer-substring-no-properties - (point-min) (point-max))))) - (if (string-match-p "file:\\([^]]*\\)" link) link - (message "LaTeX Conversion failed.") - nil)))) - (when org-link + (link + (with-temp-buffer + (insert latex-frag) + ;; When converting to a PNG image, make sure to + ;; copy all LaTeX header specifications from the + ;; Org source. + (unless (eq processing-type 'mathml) + (let ((h (plist-get info :latex-header))) + (when h + (insert "\n" + (replace-regexp-in-string + "^" "#+LATEX_HEADER: " h))))) + (org-format-latex cache-subdir nil nil cache-dir + nil display-msg nil + processing-type) + (goto-char (point-min)) + (org-element-link-parser)))) + (if (not (eq 'link (org-element-type link))) + (message "LaTeX Conversion failed.") ;; Conversion succeeded. Parse above Org-style link to ;; a `link' object. - (let* ((link - (org-element-map - (org-element-parse-secondary-string org-link '(link)) - 'link #'identity info t)) - (replacement - (cl-case (org-element-type latex-*) - ;; Case 1: LaTeX environment. Mimic - ;; a "standalone image or formula" by - ;; enclosing the `link' in a `paragraph'. - ;; Copy over original attributes, captions to - ;; the enclosing paragraph. - (latex-environment - (org-element-adopt-elements - (list 'paragraph - (list :style "OrgFormula" - :name - (org-element-property :name latex-*) - :caption - (org-element-property :caption latex-*))) - link)) - ;; Case 2: LaTeX fragment. No special action. - (latex-fragment link)))) + (let ((replacement + (cl-case (org-element-type latex-*) + ;;LaTeX environment. Mimic a "standalone image + ;; or formula" by enclosing the `link' in + ;; a `paragraph'. Copy over original + ;; attributes, captions to the enclosing + ;; paragraph. + (latex-environment + (org-element-adopt-elements + (list 'paragraph + (list :style "OrgFormula" + :name + (org-element-property :name latex-*) + :caption + (org-element-property :caption latex-*))) + link)) + ;; LaTeX fragment. No special action. + (latex-fragment link)))) ;; Note down the object that link replaces. (org-element-put-property replacement :replaces (list (org-element-type latex-*) diff --git a/lisp/org/ox.el b/lisp/org/ox.el index f39a3952e7..7d2f3d1714 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -2712,14 +2712,11 @@ from tree." (org-element-map data '(footnote-definition footnote-reference) (lambda (f) (cond - ((eq (org-element-type f) 'footnote-definition) f) - ((eq (org-element-property :type f) 'standard) nil) - (t (let ((label (org-element-property :label f))) - (when label ;Skip anonymous references. - (apply - #'org-element-create - 'footnote-definition `(:label ,label :post-blank 1) - (org-element-contents f)))))))))) + ((eq 'footnote-definition (org-element-type f)) f) + ((and (eq 'inline (org-element-property :type f)) + (org-element-property :label f)) + f) + (t nil)))))) ;; If a select tag is active, also ignore the section before the ;; first headline, if any. (when selected commit c1854b1d31e1b0a3a9e91ef41110a5fa77bedb31 Author: Paul Eggert Date: Mon Aug 28 21:50:09 2017 -0700 Silence false alarms for symlinks to sources Problem reported by Glenn Morris (Bug#28264). * lisp/files.el (files--splice-dirname-file): New function. (file-truename, file-chase-links): Use it. diff --git a/lisp/files.el b/lisp/files.el index b3eab29c53..5f55aa75a7 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1153,6 +1153,21 @@ names beginning with `~'." (and (file-name-absolute-p file) (not (eq (aref file 0) ?~)))) +(defun files--splice-dirname-file (dirname file) + "Splice DIRNAME to FILE like the operating system would. +If FILENAME is relative, return DIRNAME concatenated to FILE. +Otherwise return FILE, quoted with `/:' if DIRNAME and FILE have +different handlers; although this quoting is dubious if DIRNAME +is remote, it is not clear what would be better. This function +differs from `expand-file-name' in that DIRNAME must be a +directory name and leading `~' and `/:' are not special in FILE." + (if (files--name-absolute-system-p file) + (if (eq (find-file-name-handler dirname 'file-symlink-p) + (find-file-name-handler file 'file-symlink-p)) + file + (concat "/:" file)) + (concat dirname file))) + (defun file-truename (filename &optional counter prev-dirs) "Return the truename of FILENAME. If FILENAME is not absolute, first expands it against `default-directory'. @@ -1253,10 +1268,7 @@ containing it, until no links are left at any level. ;; We can't safely use expand-file-name here ;; since target might look like foo/../bar where foo ;; is itself a link. Instead, we handle . and .. above. - (setq filename - (concat (if (files--name-absolute-system-p target) - "/:" dir) - target) + (setq filename (files--splice-dirname-file dir target) done nil) ;; No, we are done! (setq done t)))))))) @@ -1291,10 +1303,8 @@ it means chase no more than that many links and then stop." (directory-file-name (file-name-directory newname)))) ;; Now find the parent of that dir. (setq newname (file-name-directory newname))) - (setq newname (concat (if (files--name-absolute-system-p tem) - "/:" - (file-name-directory newname)) - tem)) + (setq newname (files--splice-dirname-file (file-name-directory newname) + tem)) (setq count (1+ count)))) newname)) commit 7b8699759f3332e8b5cfe6eed5a80090d9ef8948 Author: Paul Eggert Date: Mon Aug 28 21:47:16 2017 -0700 Simplify remove_slash_colon * src/process.c (remove_slash_colon): Simplify and avoid a special case for "/:" by itself. diff --git a/src/process.c b/src/process.c index 730caea677..c45a3f63ce 100644 --- a/src/process.c +++ b/src/process.c @@ -7692,7 +7692,7 @@ Lisp_Object remove_slash_colon (Lisp_Object name) { return - ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':') + (SREF (name, 0) == '/' && SREF (name, 1) == ':' ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2, SBYTES (name) - 2, STRING_MULTIBYTE (name)) : name); commit cd0360fac362879fe0d2dc832bd7d943533a8fc0 Author: Tassilo Horn Date: Mon Aug 28 18:13:59 2017 +0200 Remove font family from minibuffer-prompt face * etc/themes/tsdh-light-theme.el (tsdh-light): Remove font family from minibuffer-prompt face. diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index 8498fe2bc9..f816412dfb 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -64,7 +64,7 @@ Used and created by Tassilo Horn.") '(gnus-group-news-3-empty ((t (:foreground "tomato2")))) '(header-line ((t (:inherit mode-line :inverse-video t)))) '(hl-line ((t (:background "#f0f0f1")))) '(hl-paren-face ((t (:weight bold))) t) - '(minibuffer-prompt ((t (:foreground "#0184bc" :family "DeJaVu" :box (:line-width -1 :style released-button) :weight bold)))) + '(minibuffer-prompt ((t (:foreground "#0184bc" :box (:line-width -1 :style released-button) :weight bold)))) '(mode-line ((t (:background "#f0f0f1" :box (:line-width 1 :color "#383a42"))))) '(mode-line-inactive ((t (:inherit mode-line :foreground "#a0a1a7")))) '(org-agenda-date ((t (:inherit org-agenda-structure)))) commit 3a19e6ec235dc0496d3c406073b92b6d45588c9a Author: Michael Albinus Date: Mon Aug 28 18:08:16 2017 +0200 Further fixes in tramp-smb.el * lisp/net/tramp-smb.el (tramp-smb-handle-file-truename): New defun. (tramp-smb-file-name-handler-alist): Use it. (tramp-smb-handle-make-symbolic-link): Unquote target. * test/lisp/net/tramp-tests.el (tramp--test-ignore-make-symbolic-link-error): New defmacro. (tramp-test18-file-attributes, tramp-test21-file-links) (tramp--test-check-files): Use it. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 920e10331b..0b05cdb8cc 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -253,7 +253,7 @@ See `tramp-actions-before-shell' for more info.") (file-remote-p . tramp-handle-file-remote-p) ;; `file-selinux-context' performed by default handler. (file-symlink-p . tramp-handle-file-symlink-p) - ;; `file-truename' performed by default handler. + (file-truename . tramp-smb-handle-file-truename) (file-writable-p . tramp-smb-handle-file-writable-p) (find-backup-file-name . tramp-handle-find-backup-file-name) ;; `find-file-noselect' performed by default handler. @@ -947,6 +947,23 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (nth 0 x)))) (tramp-smb-get-file-entries directory)))))))) +(defun tramp-smb-handle-file-truename (filename) + "Like `file-truename' for Tramp files." + (format + "%s%s" + (with-parsed-tramp-file-name (expand-file-name filename) nil + (tramp-make-tramp-file-name + method user domain host port + (with-tramp-file-property v localname "file-truename" + (funcall + (if (tramp-compat-file-name-quoted-p localname) + 'tramp-compat-file-name-quote 'identity) + ;; We don't follow symlink of symlink. + (or (file-symlink-p filename) localname))))) + + ;; Preserve trailing "/". + (if (string-equal (file-name-nondirectory filename) "") "/" ""))) + (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." (if (file-exists-p filename) @@ -1147,8 +1164,9 @@ component is used as the target of the symlink." (unless (tramp-smb-send-command - v - (format "symlink \"%s\" \"%s\"" target (tramp-smb-get-localname v))) + v (format "symlink \"%s\" \"%s\"" + (tramp-compat-file-name-unquote target) + (tramp-smb-get-localname v))) (tramp-error v 'file-error "error with make-symbolic-link, see buffer `%s' for details" diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e7a55c41cf..201ac10dcc 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2374,6 +2374,20 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ignore-errors (delete-directory tmp-name1 'recursive)) (ignore-errors (delete-directory tmp-name2 'recursive)))))) +;; Method "smb" supports `make-symbolic-link' only if the remote host +;; has CIFS capabilities. tramp-adb.el and tramp-gvfs.el do not +;; support symbolic links at all. +(defmacro tramp--test-ignore-make-symbolic-link-error (&rest body) + "Run BODY, ignoring \"make-symbolic-link not supported\" file error." + (declare (indent defun) (debug t)) + `(condition-case err + (progn ,@body) + ((error quit debug) + (unless (and (eq (car err) 'file-error) + (string-equal (error-message-string err) + "make-symbolic-link not supported")) + (signal (car err) (cdr err)))))) + (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. This tests also `file-readable-p', `file-regular-p' and @@ -2429,26 +2443,22 @@ This tests also `file-readable-p', `file-regular-p' and (should (stringp (nth 2 attr))) ;; Uid. (should (stringp (nth 3 attr))) ;; Gid. - (condition-case err - (progn - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name2 'group))) - (make-symbolic-link tmp-name1 tmp-name2) - (should (file-exists-p tmp-name2)) - (should (file-symlink-p tmp-name2)) - (when (tramp--test-sh-p) - (should (file-ownership-preserved-p tmp-name2 'group))) - (setq attr (file-attributes tmp-name2)) - (should - (string-equal - (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) - (car attr)) - (file-remote-p (file-truename tmp-name1) 'localname))) - (delete-file tmp-name2)) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) + (tramp--test-ignore-make-symbolic-link-error + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (make-symbolic-link tmp-name1 tmp-name2) + (should (file-exists-p tmp-name2)) + (should (file-symlink-p tmp-name2)) + (when (tramp--test-sh-p) + (should (file-ownership-preserved-p tmp-name2 'group))) + (setq attr (file-attributes tmp-name2)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (car attr)) + (file-remote-p (file-truename tmp-name1) 'localname))) + (delete-file tmp-name2)) ;; Check, that "//" in symlinks are handled properly. (with-temp-buffer @@ -2574,18 +2584,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Check `make-symbolic-link'. (unwind-protect - (progn + (tramp--test-ignore-make-symbolic-link-error (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (make-symbolic-link tmp-name1 tmp-name2) - (file-error - (skip-unless - (not (string-equal (error-message-string err) - "make-symbolic-link not supported"))))) + (make-symbolic-link tmp-name1 tmp-name2) (should (string-equal (funcall @@ -2659,7 +2661,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (file-symlink-p tmp-name2)) (should (file-regular-p tmp-name2)) ;; `tmp-name3' is a local file name. - (should-error (add-name-to-file tmp-name1 tmp-name3))) + (should-error + (add-name-to-file tmp-name1 tmp-name3) + :type 'file-error)) ;; Cleanup. (ignore-errors @@ -2668,7 +2672,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Check `file-truename'. (unwind-protect - (progn + (tramp--test-ignore-make-symbolic-link-error (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (make-symbolic-link tmp-name1 tmp-name2) @@ -3615,31 +3619,23 @@ This requires restrictions of file name syntax." (copy-file file2 tmp-name1) (should (file-exists-p file1)) - ;; Method "smb" supports `make-symbolic-link' only if the - ;; remote host has CIFS capabilities. tramp-adb.el and - ;; tramp-gvfs.el do not support symbolic links at all. - (condition-case err - (progn - (make-symbolic-link file1 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (expand-file-name file1) (file-truename file3))) - (should - (string-equal - (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) - (car (file-attributes file3))) - (file-remote-p (file-truename file1) 'localname))) - ;; Check file contents. - (with-temp-buffer - (insert-file-contents file3) - (should (string-equal (buffer-string) elt))) - (delete-file file3)) - (file-error - (should - (string-equal (error-message-string err) - "make-symbolic-link not supported")))))) + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link file1 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (expand-file-name file1) (file-truename file3))) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (car (file-attributes file3))) + (file-remote-p (file-truename file1) 'localname))) + ;; Check file contents. + (with-temp-buffer + (insert-file-contents file3) + (should (string-equal (buffer-string) elt))) + (delete-file file3)))) ;; Check file names. (should (equal (directory-files @@ -3692,27 +3688,23 @@ This requires restrictions of file name syntax." elt)) ;; Check symlink in `directory-files-and-attributes'. - (condition-case err - (progn - (make-symbolic-link file2 file3) - (should (file-symlink-p file3)) - (should - (string-equal - (caar (directory-files-and-attributes - file1 nil (regexp-quote elt1))) - elt1)) - (should - (string-equal - (funcall - (if quoted 'tramp-compat-file-name-quote 'identity) - (cadr (car (directory-files-and-attributes - file1 nil (regexp-quote elt1))))) - (file-remote-p (file-truename file2) 'localname))) - (delete-file file3) - (should-not (file-exists-p file3))) - (file-error - (should (string-equal (error-message-string err) - "make-symbolic-link not supported")))) + (tramp--test-ignore-make-symbolic-link-error + (make-symbolic-link file2 file3) + (should (file-symlink-p file3)) + (should + (string-equal + (caar (directory-files-and-attributes + file1 nil (regexp-quote elt1))) + elt1)) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + (cadr (car (directory-files-and-attributes + file1 nil (regexp-quote elt1))))) + (file-remote-p (file-truename file2) 'localname))) + (delete-file file3) + (should-not (file-exists-p file3))) (delete-file file2) (should-not (file-exists-p file2)) commit 32cdfa0e9cd1198ace9771be7e46fa7c9a54d20b Author: Michael Albinus Date: Mon Aug 28 17:55:31 2017 +0200 ; Fix last ido patch diff --git a/lisp/ido.el b/lisp/ido.el index 5ba168b105..23669d22d1 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3678,7 +3678,7 @@ in this list." ido-temp-list))))) (ido-to-end ;; move . files to end (delq nil (mapcar - (lambda (x) (if (string-match "^\\." x) x)) + (lambda (x) (if (string-match "\\`\\." x) x)) ido-temp-list))) (if (and default (member default ido-temp-list)) (if (or ido-rotate-temp ido-rotate-file-list-default) commit b93a5f197e67f75f36f442060fe8fd72c6a8f888 Author: Paul Eggert Date: Mon Aug 28 08:38:05 2017 -0700 Don’t assume -g3 in .gdbinit * src/.gdbinit (EMACS_INT_WIDTH, USE_LSB_TAG): Use reasonable defaults if not in the symbol table. diff --git a/src/.gdbinit b/src/.gdbinit index b5a974bb38..21cdca5b2c 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -1303,8 +1303,21 @@ if hasattr(gdb, 'printing'): # This implementation should work regardless of C compiler, and # it should not attempt to run any code in the inferior. - EMACS_INT_WIDTH = int(gdb.lookup_symbol("EMACS_INT_WIDTH")[0].value()) - USE_LSB_TAG = int(gdb.lookup_symbol("USE_LSB_TAG")[0].value()) + + # If the macros EMACS_INT_WIDTH and USE_LSB_TAG are not in the + # symbol table, guess reasonable defaults. + sym = gdb.lookup_symbol ("EMACS_INT_WIDTH")[0] + if sym: + EMACS_INT_WIDTH = int (sym.value ()) + else: + sym = gdb.lookup_symbol ("EMACS_INT")[0] + EMACS_INT_WIDTH = 8 * sym.type.sizeof + sym = gdb.lookup_symbol ("USE_LSB_TAG")[0] + if sym: + USE_LSB_TAG = int (sym.value ()) + else: + USE_LSB_TAG = 1 + GCTYPEBITS = 3 VALBITS = EMACS_INT_WIDTH - GCTYPEBITS Lisp_Int0 = 2 commit 433cf5b2046f9b0a9f500dae1d072cc53f2a3c10 Author: Robert Pluim Date: Mon Aug 28 09:49:56 2017 +0200 Use string-match to check for dotfiles in ido * lisp/ido.el (ido-make-file-list): Use string-match to check for dotfiles instead of substring, as when using tramp simplified syntax ido-temp-list may contain empty strings. Copyright-paperwork-exempt: yes diff --git a/lisp/ido.el b/lisp/ido.el index defb744201..5ba168b105 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -3678,7 +3678,7 @@ in this list." ido-temp-list))))) (ido-to-end ;; move . files to end (delq nil (mapcar - (lambda (x) (if (string-equal (substring x 0 1) ".") x)) + (lambda (x) (if (string-match "^\\." x) x)) ido-temp-list))) (if (and default (member default ido-temp-list)) (if (or ido-rotate-temp ido-rotate-file-list-default) commit 043a84702f3002d711784e5fe97c9ea8690b4cfa Author: Mark Oteiza Date: Sun Aug 27 22:22:29 2017 -0400 Font-lock FDO desktop files correctly Single and double quotes do not have a special meaning in desktop files. https://standards.freedesktop.org/desktop-entry-spec/latest/ * etc/NEWS: Mention new mode. * lisp/files.el (auto-mode-alist): Split out an entry for handling the .desktop extension with conf-desktop-mode. * lisp/textmodes/conf-mode.el (conf-desktop-font-lock-keywords): New variable with rules for booleans and format specifiers. (conf-unix-mode): Remove desktop file entry example from docstring. (conf-desktop-mode): New derived major mode. diff --git a/etc/NEWS b/etc/NEWS index 6cd4bcac79..e8d6ea9c6d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1128,6 +1128,9 @@ fontification, and commenting for embedded JavaScript and CSS. ** New mode 'conf-toml-mode' is a sub-mode of conf-mode, specialized for editing TOML files. +** New mode 'conf-desktop-mode' is a sub-mode of conf-unix-mode, +specialized for editing freedesktop.org desktop entries. + ** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. ** New major mode 'less-css-mode' (a minor variant of 'css-mode') for diff --git a/lisp/files.el b/lisp/files.el index 872fc46e87..b3eab29c53 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2611,11 +2611,12 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("/config\\.\\(?:bat\\|log\\)\\'" . fundamental-mode) ;; Windows candidates may be opened case sensitively on Unix ("\\.\\(?:[iI][nN][iI]\\|[lL][sS][tT]\\|[rR][eE][gG]\\|[sS][yY][sS]\\)\\'" . conf-mode) - ("\\.\\(?:desktop\\|la\\)\\'" . conf-unix-mode) + ("\\.la\\'" . conf-unix-mode) ("\\.ppd\\'" . conf-ppd-mode) ("java.+\\.conf\\'" . conf-javaprop-mode) ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) ("\\.toml\\'" . conf-toml-mode) + ("\\.desktop\\'" . conf-desktop-mode) ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) ;; ChangeLog.old etc. Other change-log-mode entries are above; diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index b420aaa246..d03ee5eb31 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -262,6 +262,12 @@ This variable is best set in the file local variables, or through ("\\_" 0 'font-lock-keyword-face)) "Keywords to highlight in Conf TOML mode.") +(defvar conf-desktop-font-lock-keywords + `(,@conf-font-lock-keywords + ("\\_" 0 'font-lock-constant-face) + ("\\_<%[uUfFick%]\\_>" 0 'font-lock-constant-face)) + "Keywords to highlight in Conf Desktop mode.") + (defvar conf-assignment-sign ?= "Sign used for assignments (char or string).") @@ -449,16 +455,7 @@ The optional arg FONT-LOCK is the value for FONT-LOCK-KEYWORDS." ;;;###autoload (define-derived-mode conf-unix-mode conf-mode "Conf[Unix]" "Conf Mode starter for Unix style Conf files. -Comments start with `#'. -For details see `conf-mode'. Example: - -# Conf mode font-locks this right on Unix and with \\[conf-unix-mode] - -[Desktop Entry] - Encoding=UTF-8 - Name=The GIMP - Name[ca]=El GIMP - Name[cs]=GIMP" +Comments start with `#'. For details see `conf-mode'." (conf-mode-initialize "#")) ;;;###autoload @@ -677,6 +674,21 @@ value = \"some string\"" (setq-local conf-assignment-column 0) (setq-local conf-assignment-sign ?=)) +;;;###autoload +(define-derived-mode conf-desktop-mode conf-unix-mode "Conf[Desktop]" + "Conf Mode started for freedesktop.org Desktop files. +Comments start with `#' and \"assignments\" are with `='. +For details see `conf-mode'. + +# Conf mode font-locks this correctly with \\[conf-desktop-mode] + [Desktop Entry] + Name=GNU Image Manipulation Program + Name[oc]=Editor d'imatge GIMP + Exec=gimp-2.8 %U + Terminal=false" + (conf-mode-initialize "#" 'conf-desktop-font-lock-keywords) + (conf-quote-normal nil)) + (provide 'conf-mode) ;;; conf-mode.el ends here commit 9e79a31c09d673019be2a2c78bf8b7db89351819 Author: Tom Tromey Date: Sun Aug 27 12:54:01 2017 -0600 Fix auto-fill bug in js-mode * lisp/progmodes/js.el (js-do-auto-fill): New function. (js-mode): Set normal-auto-fill-function. * test/lisp/progmodes/js-tests.el (js-mode-fill-comment-bug): New test. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index e6ffe4d75a..cd315fb33c 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -2380,6 +2380,10 @@ i.e., customize JSX element indentation with `sgml-basic-offset', (fill-paragraph-function #'c-fill-paragraph)) (c-fill-paragraph justify))) +(defun js-do-auto-fill () + (let ((js--filling-paragraph t)) + (c-do-auto-fill))) + ;;; Type database and Imenu ;; We maintain a cache of semantic information, i.e., the classes and @@ -3863,6 +3867,7 @@ If one hasn't been set, or if it's stale, prompt for a new one." (setq-local comment-start "// ") (setq-local comment-end "") (setq-local fill-paragraph-function #'js-c-fill-paragraph) + (setq-local normal-auto-fill-function #'js-do-auto-fill) ;; Parse cache (add-hook 'before-change-functions #'js--flush-caches t t) diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el index 8e1bac10cd..4e27913930 100644 --- a/test/lisp/progmodes/js-tests.el +++ b/test/lisp/progmodes/js-tests.el @@ -60,6 +60,25 @@ * Load the inspector's shared head.js for use by tests that need to * open the something or other")))) +(ert-deftest js-mode-fill-comment-bug () + (with-temp-buffer + (insert "/** + * javadoc stuff here + * + * what + */ +function f( ) { + // comment-auto-fill-only-comments is a variable defined in ‘newcomment.el’. comment comment") + (js-mode) + (setq-local comment-auto-fill-only-comments t) + (setq-local fill-column 75) + (auto-fill-mode 1) + (funcall auto-fill-function) + (beginning-of-line) + ;; Filling should have inserted the correct comment start. + (should (equal (buffer-substring (point) (+ 7 (point))) + " // ")))) + (ert-deftest js-mode-regexp-syntax () (with-temp-buffer ;; Normally indentation tests are done in manual/indent, but in commit 5440b238b1ec4175dd32bc14b4098f6570b2ca85 Author: Noam Postavsky Date: Sat Aug 19 11:45:07 2017 -0400 Disable completion while entering python multiline statements The "legacy" completion mechanism sends newlines to the running python process to get the list of completions, which confuses things if the user is in the middle of entering a multiline statement (Bug#28051). It's better to disable completion in this case. * lisp/progmodes/python.el (python-shell--block-prompt): New variable. (python-shell-prompt-set-calculated-regexps): Set it. (python-shell-completion-at-point): Return 'ignore' as the completion function when the current prompt is a block prompt. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index e73b2a8488..444167f536 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2212,6 +2212,11 @@ machine then modifies `tramp-remote-process-environment' and Do not set this variable directly, instead use `python-shell-prompt-set-calculated-regexps'.") +(defvar python-shell--block-prompt nil + "Input block prompt for inferior python shell. +Do not set this variable directly, instead use +`python-shell-prompt-set-calculated-regexps'.") + (defvar python-shell--prompt-calculated-output-regexp nil "Calculated output prompt regexp for inferior python shell. Do not set this variable directly, instead use @@ -2366,6 +2371,7 @@ and `python-shell-output-prompt-regexp' using the values from (dolist (prompt (butlast detected-prompts)) (setq prompt (regexp-quote prompt)) (cl-pushnew prompt input-prompts :test #'string=)) + (setq python-shell--block-prompt (nth 1 detected-prompts)) (cl-pushnew (regexp-quote (car (last detected-prompts))) output-prompts :test #'string=)) @@ -2726,6 +2732,7 @@ variable. (set (make-local-variable 'python-shell-interpreter-args) (or python-shell--interpreter-args python-shell-interpreter-args)) (set (make-local-variable 'python-shell--prompt-calculated-input-regexp) nil) + (set (make-local-variable 'python-shell--block-prompt) nil) (set (make-local-variable 'python-shell--prompt-calculated-output-regexp) nil) (python-shell-prompt-set-calculated-regexps) (setq comint-prompt-regexp python-shell--prompt-calculated-input-regexp) @@ -3632,7 +3639,14 @@ using that one instead of current buffer's process." ;; Also, since pdb interaction is single-line ;; based, this is enough. (string-match-p python-shell-prompt-pdb-regexp prompt)) - #'python-shell-completion-get-completions) + (if (or (equal python-shell--block-prompt prompt) + (string-match-p + python-shell-prompt-block-regexp prompt)) + ;; The non-native completion mechanism sends + ;; newlines to the interpreter, so we can't use + ;; it during a multiline statement (Bug#28051). + #'ignore + #'python-shell-completion-get-completions)) (t #'python-shell-completion-native-get-completions))))) (list start end (completion-table-dynamic commit 79cc9445e182ad5d80380ccf677b947d76854ce8 Author: Michael Albinus Date: Sun Aug 27 19:16:58 2017 +0200 Tramp cleanup * lisp/net/tramp-sh.el (tramp-sh-extra-args): Remove compat code. (tramp-sh-handle-make-symbolic-link): More robust check for TARGET remoteness. * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory): Disable copying by tar temporarily, it doesn't work reliably. (tramp-smb-do-file-attributes-with-stat): Resolve symlink. (tramp-smb-handle-make-symbolic-link): Fix implementation. * lisp/net/tramp.el (tramp-handle-file-symlink-p): Simplify. * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6251248e28..6494b0957b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -562,11 +562,7 @@ This variable is only used when Tramp needs to start up another shell for tilde expansion. The extra arguments should typically prevent the shell from reading its init file." :group 'tramp - ;; This might be the wrong way to test whether the widget type - ;; `alist' is available. Who knows the right way to test it? - :type (if (get 'alist 'widget-type) - '(alist :key-type string :value-type string) - '(repeat (cons string string))) + :type '(alist :key-type regexp :value-type string) :require 'tramp) (defconst tramp-actions-before-shell @@ -1088,8 +1084,9 @@ component is used as the target of the symlink." (delete-file linkname))) ;; If TARGET is a Tramp name, use just the localname component. - (when (tramp-file-name-equal-p - v (tramp-dissect-file-name (expand-file-name target))) + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p + v (tramp-dissect-file-name (expand-file-name target)))) (setq target (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name target))))) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f734b80d53..920e10331b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -430,7 +430,8 @@ pass to the OPERATION." (delete-directory tmpdir 'recursive)))) ;; We can copy recursively. - ((and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) + ;; Does not work reliably. + (nil ;(and (or t1 t2) (tramp-smb-get-cifs-capabilities v)) (when (and (file-directory-p newname) (not (string-equal (file-name-nondirectory dirname) (file-name-nondirectory newname)))) @@ -888,6 +889,16 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." (string-to-number (match-string 2)) ;; month (string-to-number (match-string 1)))))) ;; year (forward-line)) + + ;; Resolve symlink. + (when (and (stringp id) + (tramp-smb-send-command + vec + (format "readlink \"%s\"" (tramp-smb-get-localname vec)))) + (goto-char (point-min)) + (and (looking-at ".+ -> \\(.+\\)") + (setq id (match-string 1)))) + ;; Return the result. (list id link uid gid atime mtime ctime size mode nil inode (tramp-get-device vec))))))) @@ -1105,47 +1116,43 @@ component is used as the target of the symlink." (tramp-run-real-handler 'make-symbolic-link (list target linkname ok-if-already-exists)) - (unless (tramp-equal-remote target linkname) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p target) target linkname) nil + (with-parsed-tramp-file-name linkname nil + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + (unless (tramp-smb-get-cifs-capabilities v) + (tramp-error v 'file-error "make-symbolic-link not supported")) + + ;; If TARGET is a Tramp name, use just the localname component. + (when (and (tramp-tramp-file-p target) + (tramp-file-name-equal-p + v (tramp-dissect-file-name (expand-file-name target)))) + (setq target + (tramp-file-name-localname + (tramp-dissect-file-name (expand-file-name target))))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + (unless + (tramp-smb-send-command + v + (format "symlink \"%s\" \"%s\"" target (tramp-smb-get-localname v))) (tramp-error v 'file-error - "make-symbolic-link: %s" - "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name target v1 - (with-parsed-tramp-file-name linkname v2 - (when (file-directory-p target) - (tramp-error - v2 'file-error - "make-symbolic-link: %s must not be a directory" target)) - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - v2-localname))))) - (tramp-error v2 'file-already-exists v2-localname) - (delete-file linkname))) - (unless (tramp-smb-get-cifs-capabilities v1) - (tramp-error v2 'file-error "make-symbolic-link not supported")) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v2 (file-name-directory v2-localname)) - (tramp-flush-file-property v2 v2-localname) - (unless - (tramp-smb-send-command - v1 - (format - "symlink \"%s\" \"%s\"" - (tramp-smb-get-localname v1) - (tramp-smb-get-localname v2))) - (tramp-error - v2 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (buffer-name))))))) + "error with make-symbolic-link, see buffer `%s' for details" + (buffer-name)))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bb68b9e964..1a5cda7e20 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3065,12 +3065,8 @@ User is always nil." (defun tramp-handle-file-symlink-p (filename) "Like `file-symlink-p' for Tramp files." - (with-parsed-tramp-file-name filename nil - (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) - (when (stringp x) - (if (file-name-absolute-p x) - (tramp-make-tramp-file-name method user domain host port x) - x))))) + (let ((x (tramp-compat-file-attribute-type (file-attributes filename)))) + (and (stringp x) x))) (defun tramp-handle-find-backup-file-name (filename) "Like `find-backup-file-name' for Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3dbb522a7c..e7a55c41cf 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2586,14 +2586,50 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (skip-unless (not (string-equal (error-message-string err) "make-symbolic-link not supported"))))) - (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2) - :type 'file-already-exists) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + (file-remote-p tmp-name1 'localname)) + (file-symlink-p tmp-name2))) + (should-error + (make-symbolic-link tmp-name1 tmp-name2) + :type 'file-already-exists) + ;; 0 means interactive case. + (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (should-error + (make-symbolic-link tmp-name1 tmp-name2 0) + :type 'file-already-exists)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (make-symbolic-link tmp-name1 tmp-name2 0) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + (file-remote-p tmp-name1 'localname)) + (file-symlink-p tmp-name2)))) (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) - (should (file-symlink-p tmp-name2)) - ;; `tmp-name3' is a local file name. + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + (file-remote-p tmp-name1 'localname)) + (file-symlink-p tmp-name2))) + ;; If we use the local part of `tmp-name1', it shall still work. + (make-symbolic-link + (file-remote-p tmp-name1 'localname) + tmp-name2 'ok-if-already-exists) + (should + (string-equal + (funcall + (if quoted 'tramp-compat-file-name-unquote 'identity) + (file-remote-p tmp-name1 'localname)) + (file-symlink-p tmp-name2))) + ;; `tmp-name3' is a local file name. Therefore, the link + ;; target remains unchanged, even if quoted. (make-symbolic-link tmp-name1 tmp-name3) - (should (file-symlink-p tmp-name3))) + (should + (string-equal tmp-name1 (file-symlink-p tmp-name3)))) ;; Cleanup. (ignore-errors @@ -2607,11 +2643,21 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (write-region "foo" nil tmp-name1) (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) - (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2) - :type 'file-already-exists) + (should (file-regular-p tmp-name2)) + (should-error + (add-name-to-file tmp-name1 tmp-name2) + :type 'file-already-exists) + ;; 0 means interactive case. + (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) + (should-error + (add-name-to-file tmp-name1 tmp-name2 0) + :type 'file-already-exists)) + (cl-letf (((symbol-function 'yes-or-no-p) (lambda (_prompt) t))) + (add-name-to-file tmp-name1 tmp-name2 0) + (should (file-regular-p tmp-name2))) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) (should-not (file-symlink-p tmp-name2)) + (should (file-regular-p tmp-name2)) ;; `tmp-name3' is a local file name. (should-error (add-name-to-file tmp-name1 tmp-name3))) @@ -2640,8 +2686,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (string-equal (file-truename tmp-name1) - (funcall - 'tramp-compat-file-name-unquote (file-truename tmp-name3))))) + (tramp-compat-file-name-unquote (file-truename tmp-name3))))) ;; Cleanup. (ignore-errors commit c99507645a2dbcb08224c8075bc6675dd1b09bbc Author: Glenn Morris Date: Sun Aug 27 10:06:30 2017 -0700 Fix previous xterm.h change for non-gtk builds * src/xterm.h (GTK_CHECK_VERSION) [!USE_GTK]: Define it. diff --git a/src/xterm.h b/src/xterm.h index 8521cb4c9f..b16d3023f0 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -48,6 +48,7 @@ typedef Widget xt_or_gtk_widget; #ifdef USE_GTK #include #include +#endif /* USE_GTK */ /* True iff GTK's version is at least I.J.K. */ #ifndef GTK_CHECK_VERSION @@ -62,6 +63,7 @@ typedef Widget xt_or_gtk_widget; # endif #endif +#ifdef USE_GTK /* Some definitions to reduce conditionals. */ typedef GtkWidget *xt_or_gtk_widget; #undef XSync commit 853ed4533bbddf16c50ad12ed1db70fa252715fb Author: Philipp Stephani Date: Sun Aug 27 13:13:16 2017 +0200 Fix GdkSettings-related deprecation warnings * src/gtkutil.c (xg_initialize): Don’t set deprecated and ignored gtk-menu-bar-accel setting in new versions of GTK+. Use g_object_set instead of deprecated gtk_settngs_set_string_property otherwise. diff --git a/src/gtkutil.c b/src/gtkutil.c index a2e9f26675..a2e322b1da 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -5244,6 +5244,7 @@ xg_initialize (void) settings = gtk_settings_get_for_screen (gdk_display_get_default_screen (gdk_display_get_default ())); +#if ! GTK_CHECK_VERSION (3, 10, 0) /* Remove F10 as a menu accelerator, it does not mix well with Emacs key bindings. It doesn't seem to be any way to remove properties, so we set it to "" which in means "no key". */ @@ -5251,13 +5252,18 @@ xg_initialize (void) "gtk-menu-bar-accel", "", EMACS_CLASS); +#endif /* Make GTK text input widgets use Emacs style keybindings. This is Emacs after all. */ +#if GTK_CHECK_VERSION (3, 16, 0) + g_object_set (settings, "gtk-key-theme-name", "Emacs", NULL); +#else gtk_settings_set_string_property (settings, "gtk-key-theme-name", "Emacs", EMACS_CLASS); +#endif /* Make dialogs close on C-g. Since file dialog inherits from dialog, this works for them also. */ commit fe49aa17d505f13926eac2212b89effec9bd3c98 Author: Philipp Stephani Date: Sun Aug 27 12:38:46 2017 +0200 Always use gtk_window_move in new versions * src/gtkutil.c (my_log_handler): Don’t define in new versions of GTK+. (xg_set_geometry): Always use gtk_window_move in new versions of GTK+. * src/xterm.c (syms_of_xterm): Document that x-gtk-use-window-move is ignored. * lisp/subr.el (x-gtk-use-window-move): Make obsolete. diff --git a/etc/NEWS b/etc/NEWS index d53e0d25f7..6cd4bcac79 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1261,6 +1261,10 @@ break. ** The arguments LOCKNAME and MUSTBENEW of 'write-region' are propagated to file name handlers now. +** When built against recent versions of GTK+, Emacs always uses +gtk_window_move for moving frames and ignores the value of the +variable 'x-gtk-use-window-move'. The variable is now obsolete. + * Lisp Changes in Emacs 26.1 diff --git a/lisp/subr.el b/lisp/subr.el index b3f9f90234..2ad52f6a63 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1478,6 +1478,8 @@ be a list of the form returned by `event-start' and `event-end'." ;; but Stefan insists to mark it so. (make-obsolete-variable 'translation-table-for-input nil "23.1") +(make-obsolete-variable 'x-gtk-use-window-move nil "26.1") + (defvaralias 'messages-buffer-max-lines 'message-log-max) ;;;; Alternate names for functions - these are not being phased out. diff --git a/src/gtkutil.c b/src/gtkutil.c index 7a110daef1..a2e9f26675 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -792,6 +792,7 @@ xg_hide_tooltip (struct frame *f) General functions for creating widgets, resizing, events, e.t.c. ***********************************************************************/ +#if ! GTK_CHECK_VERSION (3, 22, 0) static void my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, const gchar *msg, gpointer user_data) @@ -799,6 +800,7 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, if (!strstr (msg, "visible children")) fprintf (stderr, "XX %s-WARNING **: %s\n", log_domain, msg); } +#endif /* Make a geometry string and pass that to GTK. It seems this is the only way to get geometry position right if the user explicitly @@ -810,8 +812,10 @@ xg_set_geometry (struct frame *f) { if (f->size_hint_flags & (USPosition | PPosition)) { +#if ! GTK_CHECK_VERSION (3, 22, 0) if (x_gtk_use_window_move) { +#endif /* Handle negative positions without consulting gtk_window_parse_geometry (Bug#25851). The position will be off by scrollbar width + window manager decorations. */ @@ -828,6 +832,7 @@ xg_set_geometry (struct frame *f) /* Reset size hint flags. */ f->size_hint_flags &= ~ (XNegative | YNegative); +# if ! GTK_CHECK_VERSION (3, 22, 0) } else { @@ -859,6 +864,7 @@ xg_set_geometry (struct frame *f) g_log_remove_handler ("Gtk", id); } +#endif } } diff --git a/src/xterm.c b/src/xterm.c index d9a6df75d9..eff1519bf4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13311,6 +13311,7 @@ transition between the various maximization states. */); doc: /* Non-nil means rely on gtk_window_move to set frame positions. If this variable is t (the default), the GTK build uses the function gtk_window_move to set or store frame positions and disables some time -consuming frame position adjustments. */); +consuming frame position adjustments. In newer versions of GTK, Emacs +always uses gtk_window_move and ignores the value of this variable. */); x_gtk_use_window_move = true; } commit 208a3cb05f4d954abc9dd6c8cd858ef2bedd7cb4 Author: Charles A. Roelli Date: Tue Aug 22 15:57:01 2017 +0200 Fix 'diff-goto-source' when buffer is narrowed (Bug#21262) * lisp/vc/diff-mode.el (diff-find-file-name): Save the current narrowing, and widen the buffer before searching for the name of the file corresponding to the diff. With thanks to Noam Postavsky. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index aa8d77882e..1d4af54db9 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -875,51 +875,53 @@ PREFIX is only used internally: don't use it." (set (make-local-variable 'diff-remembered-defdir) default-directory) (set (make-local-variable 'diff-remembered-files-alist) nil)) (save-excursion - (unless (looking-at diff-file-header-re) - (or (ignore-errors (diff-beginning-of-file)) - (re-search-forward diff-file-header-re nil t))) - (let ((fs (diff-hunk-file-names old))) - (if prefix (setq fs (mapcar (lambda (f) (concat prefix f)) fs))) - (or - ;; use any previously used preference - (cdr (assoc fs diff-remembered-files-alist)) - ;; try to be clever and use previous choices as an inspiration - (cl-dolist (rf diff-remembered-files-alist) - (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf)))) - (if (and newfile (file-exists-p newfile)) (cl-return newfile)))) - ;; look for each file in turn. If none found, try again but - ;; ignoring the first level of directory, ... - (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) - (file nil nil)) - ((or (null files) - (setq file (cl-do* ((files files (cdr files)) - (file (car files) (car files))) - ;; Use file-regular-p to avoid - ;; /dev/null, directories, etc. - ((or (null file) (file-regular-p file)) - file)))) - file)) - ;; .rej patches implicitly apply to - (and (string-match "\\.rej\\'" (or buffer-file-name "")) - (let ((file (substring buffer-file-name 0 (match-beginning 0)))) - (when (file-exists-p file) file))) - ;; If we haven't found the file, maybe it's because we haven't paid - ;; attention to the PCL-CVS hint. - (and (not prefix) - (boundp 'cvs-pcl-cvs-dirchange-re) - (save-excursion - (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) - (diff-find-file-name old noprompt (match-string 1))) - ;; if all else fails, ask the user - (unless noprompt - (let ((file (expand-file-name (or (car fs) "")))) - (setq file - (read-file-name (format "Use file %s: " file) - (file-name-directory file) file t - (file-name-nondirectory file))) - (set (make-local-variable 'diff-remembered-files-alist) - (cons (cons fs file) diff-remembered-files-alist)) - file)))))) + (save-restriction + (widen) + (unless (looking-at diff-file-header-re) + (or (ignore-errors (diff-beginning-of-file)) + (re-search-forward diff-file-header-re nil t))) + (let ((fs (diff-hunk-file-names old))) + (if prefix (setq fs (mapcar (lambda (f) (concat prefix f)) fs))) + (or + ;; use any previously used preference + (cdr (assoc fs diff-remembered-files-alist)) + ;; try to be clever and use previous choices as an inspiration + (cl-dolist (rf diff-remembered-files-alist) + (let ((newfile (diff-merge-strings (caar rf) (car fs) (cdr rf)))) + (if (and newfile (file-exists-p newfile)) (cl-return newfile)))) + ;; look for each file in turn. If none found, try again but + ;; ignoring the first level of directory, ... + (cl-do* ((files fs (delq nil (mapcar 'diff-filename-drop-dir files))) + (file nil nil)) + ((or (null files) + (setq file (cl-do* ((files files (cdr files)) + (file (car files) (car files))) + ;; Use file-regular-p to avoid + ;; /dev/null, directories, etc. + ((or (null file) (file-regular-p file)) + file)))) + file)) + ;; .rej patches implicitly apply to + (and (string-match "\\.rej\\'" (or buffer-file-name "")) + (let ((file (substring buffer-file-name 0 (match-beginning 0)))) + (when (file-exists-p file) file))) + ;; If we haven't found the file, maybe it's because we haven't paid + ;; attention to the PCL-CVS hint. + (and (not prefix) + (boundp 'cvs-pcl-cvs-dirchange-re) + (save-excursion + (re-search-backward cvs-pcl-cvs-dirchange-re nil t)) + (diff-find-file-name old noprompt (match-string 1))) + ;; if all else fails, ask the user + (unless noprompt + (let ((file (expand-file-name (or (car fs) "")))) + (setq file + (read-file-name (format "Use file %s: " file) + (file-name-directory file) file t + (file-name-nondirectory file))) + (set (make-local-variable 'diff-remembered-files-alist) + (cons (cons fs file) diff-remembered-files-alist)) + file))))))) (defun diff-ediff-patch () commit d309ce429912a39c4f19877f23cf36116b679818 Author: Philipp Stephani Date: Sun Aug 27 13:11:55 2017 +0200 Remove use of a deprecated GTK+ function in new versions * src/gtkutil.c (xg_make_tool_item): Use gtk_widget_set_focus_on_click if available diff --git a/src/gtkutil.c b/src/gtkutil.c index 2675cd5158..7a110daef1 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4617,7 +4617,11 @@ xg_make_tool_item (struct frame *f, if (wimage && text_image) gtk_box_pack_start (GTK_BOX (vb), wimage, TRUE, TRUE, 0); +#if GTK_CHECK_VERSION (3, 20, 0) + gtk_widget_set_focus_on_click (wb, FALSE); +#else gtk_button_set_focus_on_click (GTK_BUTTON (wb), FALSE); +#endif gtk_button_set_relief (GTK_BUTTON (wb), GTK_RELIEF_NONE); gtk_container_add (GTK_CONTAINER (wb), vb); gtk_container_add (GTK_CONTAINER (weventbox), wb); commit 2132629573472c74d0d42fc073fe62903c335f8b Author: Philipp Stephani Date: Sun Aug 27 13:15:34 2017 +0200 Stop using deprecated GdkScreen monitor functions in newer GDK * src/xfns.c (Fx_display_monitor_attributes_list): Use GdkMonitor objects instead of the deprecated GdkScreen functions in GDK 3.22+ diff --git a/src/xfns.c b/src/xfns.c index 2f8c9c2541..40f06e2d9f 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -4884,7 +4884,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */) #ifdef USE_GTK double mm_width_per_pixel, mm_height_per_pixel; GdkDisplay *gdpy; +#if ! GTK_CHECK_VERSION (3, 22, 0) GdkScreen *gscreen; +#endif gint primary_monitor = 0, n_monitors, i; Lisp_Object monitor_frames, rest, frame; static const char *source = "Gdk"; @@ -4896,11 +4898,15 @@ Internal use only, use `display-monitor-attributes-list' instead. */) mm_height_per_pixel = ((double) HeightMMOfScreen (dpyinfo->screen) / x_display_pixel_height (dpyinfo)); gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display); +#if GTK_CHECK_VERSION (3, 22, 0) + n_monitors = gdk_display_get_n_monitors (gdpy); +#else gscreen = gdk_display_get_default_screen (gdpy); #if GTK_CHECK_VERSION (2, 20, 0) primary_monitor = gdk_screen_get_primary_monitor (gscreen); #endif n_monitors = gdk_screen_get_n_monitors (gscreen); +#endif monitor_frames = Fmake_vector (make_number (n_monitors), Qnil); monitors = xzalloc (n_monitors * sizeof *monitors); @@ -4913,7 +4919,14 @@ Internal use only, use `display-monitor-attributes-list' instead. */) { GdkWindow *gwin = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); +#if GTK_CHECK_VERSION (3, 22, 0) + for (i = 0; i < n_monitors; i++) + if (gdk_display_get_monitor_at_window (gdpy, gwin) + == gdk_display_get_monitor (gdpy, i)) + break; +#else i = gdk_screen_get_monitor_at_window (gscreen, gwin); +#endif ASET (monitor_frames, i, Fcons (frame, AREF (monitor_frames, i))); } } @@ -4924,9 +4937,19 @@ Internal use only, use `display-monitor-attributes-list' instead. */) GdkRectangle rec, work; struct MonitorInfo *mi = &monitors[i]; +#if GTK_CHECK_VERSION (3, 22, 0) + GdkMonitor *monitor = gdk_display_get_monitor (gdpy, i); + if (gdk_monitor_is_primary (monitor)) + primary_monitor = i; + gdk_monitor_get_geometry (monitor, &rec); +#else gdk_screen_get_monitor_geometry (gscreen, i, &rec); +#endif -#if GTK_CHECK_VERSION (2, 14, 0) +#if GTK_CHECK_VERSION (3, 22, 0) + width_mm = gdk_monitor_get_width_mm (monitor); + height_mm = gdk_monitor_get_height_mm (monitor); +#elif GTK_CHECK_VERSION (2, 14, 0) width_mm = gdk_screen_get_monitor_width_mm (gscreen, i); height_mm = gdk_screen_get_monitor_height_mm (gscreen, i); #endif @@ -4935,7 +4958,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */) if (height_mm < 0) height_mm = rec.height * mm_height_per_pixel + 0.5; -#if GTK_CHECK_VERSION (3, 4, 0) +#if GTK_CHECK_VERSION (3, 22, 0) + gdk_monitor_get_workarea (monitor, &work); +#elif GTK_CHECK_VERSION (3, 4, 0) gdk_screen_get_monitor_workarea (gscreen, i, &work); #else /* Emulate the behavior of GTK+ 3.4. */ @@ -4968,7 +4993,9 @@ Internal use only, use `display-monitor-attributes-list' instead. */) mi->mm_width = width_mm; mi->mm_height = height_mm; -#if GTK_CHECK_VERSION (2, 14, 0) +#if GTK_CHECK_VERSION (3, 22, 0) + mi->name = g_strdup (gdk_monitor_get_model (monitor)); +#elif GTK_CHECK_VERSION (2, 14, 0) mi->name = gdk_screen_get_monitor_plug_name (gscreen, i); #endif } commit 7cb3d3bba149ec69fc03bf261556cfe92a9d2b40 Author: Philipp Stephani Date: Sun Aug 27 13:53:36 2017 +0200 Use GdkSeat in new GDK versions * src/gtkutil.c (xg_event_is_for_scrollbar): Use GdkSeat instead of GdkDeviceManager in GDK 3.20+ diff --git a/src/gtkutil.c b/src/gtkutil.c index 0c8395efe9..2675cd5158 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -4138,8 +4138,13 @@ xg_event_is_for_scrollbar (struct frame *f, const XEvent *event) GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (FRAME_X_DISPLAY (f)); GdkWindow *gwin; #ifdef HAVE_GTK3 +#if GTK_CHECK_VERSION (3, 20, 0) + GdkDevice *gdev + = gdk_seat_get_pointer (gdk_display_get_default_seat (gdpy)); +#else GdkDevice *gdev = gdk_device_manager_get_client_pointer (gdk_display_get_device_manager (gdpy)); +#endif gwin = gdk_device_get_window_at_position (gdev, NULL, NULL); #else gwin = gdk_display_get_window_at_pointer (gdpy, NULL, NULL); commit 982ec0398cea6e41bcfc022c333b6f695fc03241 Author: Philipp Stephani Date: Sun Aug 27 13:19:26 2017 +0200 * src/xterm.c (XTflash): Don’t use gdk_cairo_create in GDK 3.22+ diff --git a/src/xterm.c b/src/xterm.c index fb220b335a..d9a6df75d9 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -4018,7 +4018,13 @@ XTflash (struct frame *f) when the scroll bars and the edit widget share the same X window. */ GdkWindow *window = gtk_widget_get_window (FRAME_GTK_WIDGET (f)); #ifdef HAVE_GTK3 +#if GTK_CHECK_VERSION (3, 22, 0) + cairo_region_t *region = gdk_window_get_visible_region (window); + GdkDrawingContext *context = gdk_window_begin_draw_frame (window, region); + cairo_t *cr = gdk_drawing_context_get_cairo_context (context); +#else cairo_t *cr = gdk_cairo_create (window); +#endif cairo_set_source_rgb (cr, 1, 1, 1); cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE); #define XFillRectangle(d, win, gc, x, y, w, h) \ @@ -4132,7 +4138,12 @@ XTflash (struct frame *f) #ifdef USE_GTK #ifdef HAVE_GTK3 +#if GTK_CHECK_VERSION (3, 22, 0) + gdk_window_end_draw_frame (window, context); + cairo_region_destroy (region); +#else cairo_destroy (cr); +#endif #else g_object_unref (G_OBJECT (gc)); #endif commit a1faaf3092cf47a274c1f9b93c312bf917a50b92 Author: Philipp Stephani Date: Fri Aug 25 11:08:25 2017 +0200 Remove call of deprecated GDK function * src/xterm.h (XSync): Don’t call gdk_window_process_all_updates in GDK 3.22 or later. diff --git a/src/xterm.h b/src/xterm.h index 803feda99f..8521cb4c9f 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -49,13 +49,6 @@ typedef Widget xt_or_gtk_widget; #include #include -/* Some definitions to reduce conditionals. */ -typedef GtkWidget *xt_or_gtk_widget; -#undef XSync -#define XSync(d, b) do { gdk_window_process_all_updates (); \ - XSync (d, b); } while (false) -#endif /* USE_GTK */ - /* True iff GTK's version is at least I.J.K. */ #ifndef GTK_CHECK_VERSION # ifdef USE_GTK @@ -69,6 +62,18 @@ typedef GtkWidget *xt_or_gtk_widget; # endif #endif +/* Some definitions to reduce conditionals. */ +typedef GtkWidget *xt_or_gtk_widget; +#undef XSync +/* gdk_window_process_all_updates is deprecated in GDK 3.22. */ +#if GTK_CHECK_VERSION (3, 22, 0) +#define XSync(d, b) do { XSync ((d), (b)); } while (false) +#else +#define XSync(d, b) do { gdk_window_process_all_updates (); \ + XSync (d, b); } while (false) +#endif +#endif /* USE_GTK */ + /* The GtkTooltip API came in 2.12, but gtk-enable-tooltips in 2.14. */ #if GTK_CHECK_VERSION (2, 14, 0) #define USE_GTK_TOOLTIP commit a2c967e28ba53d282764bdcc624e64b6c3b7bb06 Author: Alan Mackenzie Date: Sun Aug 27 10:38:47 2017 +0000 Amend the CC Mode macro cache to cope with changes at the macro start Fixes bug #28233. * lisp/progmodes/cc-engine.el (c-invalidate-macro-cache): Fix an off-by-1 error. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 59dc96af03..d20e575a92 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -248,7 +248,7 @@ ;; parameters. END isn't used. (cond ((null c-macro-cache)) - ((< beg (car c-macro-cache)) + ((<= beg (car c-macro-cache)) (setq c-macro-cache nil c-macro-cache-start-pos nil c-macro-cache-syntactic nil commit 231bfd6818890c0c22181ad253f09c8f2399461d Author: Paul Eggert Date: Sat Aug 26 23:07:01 2017 -0700 Fix over-protection of byte-compiled files Problem reported by Sven Joachim (Bug#28244). Also, fix similar problem for autoload files. * lisp/emacs-lisp/autoload.el (autoload--save-buffer): Set temp file modes to the buffer-file-name file modes (or 666 if not available) as adjusted by umask. * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Set temp file modes to 666 as adjusted by umask. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 4a9bd6d06b..e811ee23fe 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -873,12 +873,18 @@ FILE's modification time." ;; For parallel builds, to stop another process reading a half-written file. (defun autoload--save-buffer () "Save current buffer to its file, atomically." - ;; Copied from byte-compile-file. + ;; Similar to byte-compile-file. (let* ((version-control 'never) (tempfile (make-temp-file buffer-file-name)) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes + (or (file-modes buffer-file-name) #o666))) (kill-emacs-hook (cons (lambda () (ignore-errors (delete-file tempfile))) kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes)) (write-region (point-min) (point-max) tempfile nil 1) (backup-buffer) (rename-file tempfile buffer-file-name t)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d769a155aa..48bbd61871 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1896,10 +1896,15 @@ The value is non-nil if there were no errors, nil if errors." ;; parallel bootstrap), it does not risk getting a ;; half-finished file. (Bug#4196) (tempfile (make-temp-file target-file)) + (default-modes (default-file-modes)) + (temp-modes (logand default-modes #o600)) + (desired-modes (logand default-modes #o666)) (kill-emacs-hook (cons (lambda () (ignore-errors (delete-file tempfile))) kill-emacs-hook))) + (unless (= temp-modes desired-modes) + (set-file-modes tempfile desired-modes)) (write-region (point-min) (point-max) tempfile nil 1) ;; This has the intentional side effect that any ;; hard-links to target-file continue to commit 1be689fbc4df1ca9883f5bdeb5dd3ccc00eae3aa Author: Tom Tromey Date: Sat Aug 26 16:23:34 2017 -0600 Refine conf-toml-mode font-lock Bug#28218 * lisp/textmodes/conf-mode.el (conf-toml-font-lock-keywords): Use conf-toml-recognize-section. Use \s- in variable regexp. (conf-toml-recognize-section): New function. diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 7bcc69572d..b420aaa246 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -254,9 +254,9 @@ This variable is best set in the file local variables, or through (defvar conf-toml-font-lock-keywords '(;; [section] (do this first because it may look like a parameter) - ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) + (conf-toml-recognize-section 0 'font-lock-type-face prepend) ;; var=val or var[index]=val - ("^[ \t]*\\(.+?\\)\\(?:\\[\\(.*?\\)\\]\\)?[ \t]*=" + ("^\\s-*\\(.+?\\)\\(?:\\[\\(.*?\\)\\]\\)?\\s-*=" (1 'font-lock-variable-name-face) (2 'font-lock-constant-face nil t)) ("\\_" 0 'font-lock-keyword-face)) @@ -637,6 +637,32 @@ For details see `conf-mode'. Example: *foreground: black" (conf-mode-initialize "!")) +(defun conf-toml-recognize-section (limit) + "Font-lock helper function for conf-toml-mode. +Handles recognizing TOML section names, like [section], +\[[section]], or [something.\"else\".section]." + (save-excursion + ;; Skip any number of "[" to handle things like [[section]]. + (when (re-search-forward "^\\s-*\\[+" limit t) + (let ((start (point))) + (backward-char) + (let ((end (min limit + (condition-case nil + (progn + (forward-list) + (1- (point))) + (scan-error + (end-of-line) + (point)))))) + ;; If there is a comma in the text, then we assume this is + ;; an array and not a section. (This could be refined to + ;; look only for unquoted commas if necessary.) + (save-excursion + (goto-char start) + (unless (search-forward "," end t) + (set-match-data (list start end)) + t))))))) + ;;;###autoload (define-derived-mode conf-toml-mode conf-mode "Conf[TOML]" "Conf Mode starter for TOML files. commit e8001d4c27e1e33c83b9994aac4d5fc3feada2da Author: Paul Eggert Date: Sat Aug 26 18:36:38 2017 -0700 Do not munge contents of local symbolic links This lets Emacs deal with arbitrary local symlinks without mishandling their contents (Bug#28156). For example, (progn (shell-command "ln -fs '~' 'x'") (rename-file "x" "/tmp/x")) now consistently creates a symbolic link from '/tmp/x' to '~'. Formerly, it did that only if the working directory was on the same filesystem as /tmp; otherwise, it expanded the '~' to the user's home directory. * lisp/dired.el (dired-get-filename): Use files--name-absolute-system-p instead of rolling our own code. * lisp/files.el (files--name-absolute-system-p): New function. (file-truename, file-chase-links): Use it to avoid mishandling symlink contents that begin with ~. (copy-directory, move-file-to-trash): Use concat rather than expand-file-name, to avoid mishandling symlink contents that begin with ~. * src/fileio.c (Fmake_symbolic_link): Do not expand leading "~" in the target unless interactive. Strip leading "/:" if interactive. (emacs_readlinkat): Do not prepend "/:" to the link target if it starts with "/" and contains ":" before NUL. * test/src/fileio-tests.el (try-link): Rename from try-char, and accept a string instead of a char. All uses changed. (fileio-tests--symlink-failure): Also test leading ~, and "/:", to test the new behavior. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9195bc47ef..fa1f9e5316 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1611,8 +1611,12 @@ attempts to open file @var{new} will refer to whatever file is named @var{target} at the time the opening is done, or will get an error if the name @var{target} is nonexistent at that time. This command does not expand the argument @var{target}, so that it allows you to specify -a relative name as the target of the link. On MS-Windows, this -command works only on MS Windows Vista and later. On remote systems, +a relative name as the target of the link. However, this command +does expand leading @samp{~} in @var{target} so that you can easily +specify home directories, and strips leading @samp{/:} so that you can +specify relative names beginning with literal @samp{~} or @samp{/:}. +@xref{Quoted File Names}. On MS-Windows, this command works only on +MS Windows Vista and later. When @var{new} is remote, it works depending on the system type. @node Misc File Ops diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index f701d68370..06466c9bba 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1726,14 +1726,17 @@ default file permissions (see @code{set-default-file-modes} below), if SELinux context are not copied over in either case. @end deffn -@deffn Command make-symbolic-link filename newname &optional ok-if-already-exists +@deffn Command make-symbolic-link target newname &optional ok-if-already-exists @pindex ln @kindex file-already-exists -This command makes a symbolic link to @var{filename}, named +This command makes a symbolic link to @var{target}, named @var{newname}. This is like the shell command @samp{ln -s -@var{filename} @var{newname}}. The @var{filename} argument +@var{target} @var{newname}}. The @var{target} argument is treated only as a string; it need not name an existing file. -If @var{filename} is a relative file name, the resulting symbolic link +If @var{ok-if-already-exists} is an integer, indicating interactive +use, then leading @samp{~} is expanded and leading @samp{/:} is +stripped in the @var{target} string. +If @var{target} is a relative file name, the resulting symbolic link is interpreted relative to the directory containing the symbolic link. @xref{Relative File Names}. diff --git a/etc/NEWS b/etc/NEWS index 02de66b355..d53e0d25f7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1227,6 +1227,30 @@ that does not process CRLF. For example, it defaults to utf-8-unix instead of to utf-8. Before this change, Emacs would sometimes mishandle file names containing these control characters. ++++ +** 'file-attributes', 'file-symlink-p' and 'make-symbolic-link' no +longer quietly mutate the target of a local symbolic link, so that +Emacs can access and copy them reliably regardless of their contents. +The following changes are involved. + +*** 'file-attributes' and 'file-symlink-p' no longer prepend "/:" to +symbolic links whose targets begin with "/" and contain ":". For +example, if a symbolic link "x" has a target "/y:z", (file-symlink-p +"x") now returns "/y:z" rather than "/:/y:z". + +*** 'make-symbolic-link' no longer looks for file name handlers when +creating a local symbolic link. For example, (make-symbolic-link +"/y:z" "x") now creates a symlink to "/y:z" instead of failing. + +*** 'make-symbolic-link' now expands a link target with leading "~" +only when the optional third arg is an integer, as when invoked +interactively. For example, (make-symbolic-link "~y" "x") now creates +a link with target the literal string "~y"; to get the old behavior, +use (make-symbolic-link (expand-file-name "~y") "x"). To avoid this +expansion in interactive use, you can now prefix the link target with +"/:". For example, (make-symbolic-link "/:~y" "x" 1) now creates a +link to literal "~y". + +++ ** Module functions are now implemented slightly differently; in particular, the function 'internal--module-call' has been removed. diff --git a/lisp/dired.el b/lisp/dired.el index 0455f3d137..ff62183f09 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2332,10 +2332,7 @@ Otherwise, an error occurs in these cases." (if (and enable-multibyte-characters (not (multibyte-string-p file))) (setq file (string-to-multibyte file))))) - (and file (file-name-absolute-p file) - ;; A relative file name can start with ~. - ;; Don't treat it as absolute in this context. - (not (eq (aref file 0) ?~)) + (and file (files--name-absolute-system-p file) (setq already-absolute t)) (cond ((null file) diff --git a/lisp/files.el b/lisp/files.el index ca3b055d7a..872fc46e87 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1146,6 +1146,13 @@ accessible." (funcall handler 'file-local-copy file) nil))) +(defun files--name-absolute-system-p (file) + "Return non-nil if FILE is an absolute name to the operating system. +This is like `file-name-absolute-p', except that it returns nil for +names beginning with `~'." + (and (file-name-absolute-p file) + (not (eq (aref file 0) ?~)))) + (defun file-truename (filename &optional counter prev-dirs) "Return the truename of FILENAME. If FILENAME is not absolute, first expands it against `default-directory'. @@ -1247,9 +1254,9 @@ containing it, until no links are left at any level. ;; since target might look like foo/../bar where foo ;; is itself a link. Instead, we handle . and .. above. (setq filename - (if (file-name-absolute-p target) - target - (concat dir target)) + (concat (if (files--name-absolute-system-p target) + "/:" dir) + target) done nil) ;; No, we are done! (setq done t)))))))) @@ -1284,7 +1291,10 @@ it means chase no more than that many links and then stop." (directory-file-name (file-name-directory newname)))) ;; Now find the parent of that dir. (setq newname (file-name-directory newname))) - (setq newname (expand-file-name tem (file-name-directory newname))) + (setq newname (concat (if (files--name-absolute-system-p tem) + "/:" + (file-name-directory newname)) + tem)) (setq count (1+ count)))) newname)) @@ -5504,10 +5514,10 @@ directly into NEWNAME instead." ;; If NEWNAME is an existing directory and COPY-CONTENTS ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. ((not copy-contents) - (setq newname (expand-file-name + (setq newname (concat + (file-name-as-directory newname) (file-name-nondirectory - (directory-file-name directory)) - newname)) + (directory-file-name directory)))) (and (file-exists-p newname) (not (file-directory-p newname)) (error "Cannot overwrite non-directory %s with a directory" @@ -5519,7 +5529,8 @@ directly into NEWNAME instead." ;; We do not want to copy "." and "..". (directory-files directory 'full directory-files-no-dot-files-regexp)) - (let ((target (expand-file-name (file-name-nondirectory file) newname)) + (let ((target (concat (file-name-as-directory newname) + (file-name-nondirectory file))) (filetype (car (file-attributes file)))) (cond ((eq filetype t) ; Directory but not a symlink. @@ -7149,8 +7160,8 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, ;; If `trash-directory' is non-nil, move the file there. (let* ((trash-dir (expand-file-name trash-directory)) (fn (directory-file-name (expand-file-name filename))) - (new-fn (expand-file-name (file-name-nondirectory fn) - trash-dir))) + (new-fn (concat (file-name-as-directory trash-dir) + (file-name-nondirectory fn)))) ;; We can't trash a parent directory of trash-directory. (if (string-prefix-p fn trash-dir) (error "Trash directory `%s' is a subdirectory of `%s'" diff --git a/src/fileio.c b/src/fileio.c index fa694249cb..bbd1a4ef69 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2413,7 +2413,8 @@ DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, Both args must be strings. Signal a `file-already-exists' error if a file LINKNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -An integer third arg means request confirmation if LINKNAME already exists. +An integer third arg means request confirmation if LINKNAME already +exists, and expand leading "~" or strip leading "/:" in TARGET. This happens for interactive use with M-x. */) (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists) { @@ -2421,21 +2422,15 @@ This happens for interactive use with M-x. */) Lisp_Object encoded_target, encoded_linkname; CHECK_STRING (target); - /* If the link target has a ~, we must expand it to get - a truly valid file name. Otherwise, do not expand; - we want to permit links to relative file names. */ - if (SREF (target, 0) == '~') - target = Fexpand_file_name (target, Qnil); - + if (INTEGERP (ok_if_already_exists)) + { + if (SREF (target, 0) == '~') + target = Fexpand_file_name (target, Qnil); + else if (SREF (target, 0) == '/' && SREF (target, 1) == ':') + target = Fsubstring_no_properties (target, make_number (2), Qnil); + } linkname = expand_cp_target (target, linkname); - /* If the file name has special constructs in it, - call the corresponding file handler. */ - handler = Ffind_file_name_handler (target, Qmake_symbolic_link); - if (!NILP (handler)) - return call4 (handler, Qmake_symbolic_link, target, - linkname, ok_if_already_exists); - /* If the new link name has special constructs in it, call the corresponding file handler. */ handler = Ffind_file_name_handler (linkname, Qmake_symbolic_link); @@ -2633,11 +2628,6 @@ emacs_readlinkat (int fd, char const *filename) return Qnil; val = build_unibyte_string (buf); - if (buf[0] == '/' && strchr (buf, ':')) - { - AUTO_STRING (slash_colon, "/:"); - val = concat2 (slash_colon, val); - } if (buf != readlink_buf) xfree (buf); val = DECODE_FILE (val); diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 2ef1b553ab..5103d2f21e 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -19,14 +19,13 @@ (require 'ert) -(defun try-char (char link) - (let ((target (string char))) - (make-symbolic-link target link) - (let* ((read-link (file-symlink-p link)) - (failure (unless (string-equal target read-link) - (list 'string-equal target read-link)))) - (delete-file link) - failure))) +(defun try-link (target link) + (make-symbolic-link target link) + (let* ((read-link (file-symlink-p link)) + (failure (unless (string-equal target read-link) + (list 'string-equal target read-link)))) + (delete-file link) + failure)) (defun fileio-tests--symlink-failure () (let* ((dir (make-temp-file "fileio" t)) @@ -36,9 +35,9 @@ (char 0)) (while (and (not failure) (< char 127)) (setq char (1+ char)) - (unless (= char ?~) - (setq failure (try-char char link)))) - failure) + (setq failure (try-link (string char) link))) + (or failure + (try-link "/:" link))) (delete-directory dir t)))) (ert-deftest fileio-tests--odd-symlink-chars () commit 937d9d7f60460edb1d3f978151599fddcbba2214 Author: Reuben Thomas Date: Sun Aug 27 00:26:28 2017 +0100 Remove invalid regexp for shell builtins for wksh * lisp/progmodes/sh-script.el (sh-builtins): Shell built-ins have to be literal strings, so remove a regexp for wksh. In any case, it’s a defunct proprietary shell. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 95fe3b082b..54c47b719f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -709,9 +709,7 @@ removed when closing the here document." ;; The next entry is only used for defining the others (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") - (wksh sh-append ksh88 - ;; wksh has X toolkit APIs as built-ins! - "Xt[A-Z][A-Za-z]*") + (wksh sh-append ksh88) (zsh sh-append ksh88 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs" commit 0becd64d6320b68911cc84615650a84c021b12e3 Author: Paul Eggert Date: Sat Aug 26 13:44:41 2017 -0700 Improve doc for file-name-absolute-p. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index bb355f1ee3..f701d68370 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2119,7 +2119,7 @@ backslash, or with a drive specification @samp{@var{x}:/}, where @defun file-name-absolute-p filename This function returns @code{t} if file @var{filename} is an absolute -file name, @code{nil} otherwise. +file name or begins with @samp{~}, @code{nil} otherwise. @example @group diff --git a/src/fileio.c b/src/fileio.c index 76ea7da0e8..fa694249cb 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2470,8 +2470,8 @@ This happens for interactive use with M-x. */) DEFUN ("file-name-absolute-p", Ffile_name_absolute_p, Sfile_name_absolute_p, 1, 1, 0, - doc: /* Return t if file FILENAME specifies an absolute file name. -On Unix, this is a name starting with a `/' or a `~'. */) + doc: /* Return t if FILENAME is an absolute file name or starts with `~'. +On Unix, absolute file names start with `/'. */) (Lisp_Object filename) { CHECK_STRING (filename); commit cc7530cae09b0aa4d648d92ca0f82c81439a6b34 Author: Michael Albinus Date: Sat Aug 26 15:09:55 2017 +0200 Fix Tramp part of Bug#28156 * lisp/files.el (file-name-non-special): Use `file-name-quote' instead prefixing "/:", the file could already be quoted. * lisp/net/tramp.el (tramp-error): Handle null arguments. (tramp-handle-make-symbolic-link): * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-add-name-to-file): * lisp/net/tramp-smb.el (tramp-smb-handle-add-name-to-file) (tramp-smb-handle-make-symbolic-link): Adapt implementation to stronger semantics in Emacs. (Bug#28156) * test/lisp/net/tramp-tests.el (tramp-test21-file-links): Extend test. diff --git a/lisp/files.el b/lisp/files.el index 77ebd94836..ca3b055d7a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6955,7 +6955,7 @@ only these files will be asked to be saved." (setq file-arg-indices (cdr file-arg-indices)))) (pcase method (`identity (car arguments)) - (`add (concat "/:" (apply operation arguments))) + (`add (file-name-quote (apply operation arguments))) (`insert-file-contents (let ((visit (nth 1 arguments))) (unwind-protect diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 50b380100b..6251248e28 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1057,62 +1057,61 @@ Operations not mentioned here will be handled by the normal Emacs functions.") ;;; File Name Handler Functions: (defun tramp-sh-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (with-parsed-tramp-file-name linkname l - (let ((ln (tramp-get-remote-ln l)) - (cwd (tramp-run-real-handler - 'file-name-directory (list l-localname)))) - (unless ln - (tramp-error - l 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) - - ;; Do the 'confirm if exists' thing. - (when (file-exists-p linkname) - ;; What to do? - (if (or (null ok-if-already-exists) ; not allowed to exist - (and (numberp ok-if-already-exists) - (not (yes-or-no-p - (format - "File %s already exists; make it a link anyway? " - l-localname))))) - (tramp-error l 'file-already-exists l-localname) - (delete-file linkname))) - - ;; If FILENAME is a Tramp name, use just the localname component. - (when (tramp-tramp-file-p filename) - (setq filename - (tramp-file-name-localname - (tramp-dissect-file-name (expand-file-name filename))))) - - (tramp-flush-file-property l (file-name-directory l-localname)) - (tramp-flush-file-property l l-localname) - - ;; Right, they are on the same host, regardless of user, method, - ;; etc. We now make the link on the remote machine. This will - ;; occur as the user that FILENAME belongs to. - (and (tramp-send-command-and-check - l (format "cd %s" (tramp-shell-quote-argument cwd))) - (tramp-send-command-and-check - l (format - "%s -sf %s %s" - ln - (tramp-shell-quote-argument filename) - ;; The command could exceed PATH_MAX, so we use - ;; relative file names. However, relative file names - ;; could start with "-". `tramp-shell-quote-argument' - ;; does not handle this, we must do it ourselves. - (tramp-shell-quote-argument - (concat "./" (file-name-nondirectory l-localname))))))))) +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink." + (if (not (tramp-tramp-file-p (expand-file-name linkname))) + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)) + + (with-parsed-tramp-file-name linkname nil + (let ((ln (tramp-get-remote-ln v)) + (cwd (tramp-run-real-handler + 'file-name-directory (list localname)))) + (unless ln + (tramp-error + v 'file-error + "Making a symbolic link. ln(1) does not exist on the remote host.")) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + localname))))) + (tramp-error v 'file-already-exists localname) + (delete-file linkname))) + + ;; If TARGET is a Tramp name, use just the localname component. + (when (tramp-file-name-equal-p + v (tramp-dissect-file-name (expand-file-name target))) + (setq target + (tramp-file-name-localname + (tramp-dissect-file-name (expand-file-name target))))) + + (tramp-flush-file-property v (file-name-directory localname)) + (tramp-flush-file-property v localname) + + ;; Right, they are on the same host, regardless of user, method, + ;; etc. We now make the link on the remote machine. This will + ;; occur as the user that TARGET belongs to. + (and (tramp-send-command-and-check + v (format "cd %s" (tramp-shell-quote-argument cwd))) + (tramp-send-command-and-check + v (format + "%s -sf %s %s" ln + (tramp-shell-quote-argument target) + ;; The command could exceed PATH_MAX, so we use + ;; relative file names. However, relative file names + ;; could start with "-". `tramp-shell-quote-argument' + ;; does not handle this, we must do it ourselves. + (tramp-shell-quote-argument + (concat "./" (file-name-nondirectory localname)))))))))) (defun tramp-sh-handle-file-truename (filename) "Like `file-truename' for Tramp files." @@ -1918,14 +1917,18 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (with-parsed-tramp-file-name filename v1 (with-parsed-tramp-file-name newname v2 (let ((ln (when v1 (tramp-get-remote-ln v1)))) - (when (and (numberp ok-if-already-exists) - (file-exists-p newname) - (yes-or-no-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error v2 'file-already-exists newname)) - (when ok-if-already-exists (setq ln (concat ln " -f"))) + + ;; Do the 'confirm if exists' thing. + (when (file-exists-p newname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists newname) + (delete-file newname))) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) (tramp-barf-unless-okay diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 367beb823a..f734b80d53 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -354,16 +354,17 @@ pass to the OPERATION." (tramp-error v2 'file-error "add-name-to-file: %s must not be a directory" filename)) - (when (and (not ok-if-already-exists) - (file-exists-p newname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - newname))) - (tramp-error - v2 'file-error - "add-name-to-file: file %s already exists" newname)) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p newname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists newname) + (delete-file newname))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-property v2 (file-name-directory v2-localname)) @@ -1095,54 +1096,56 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." v 'file-error "Couldn't make directory %s" directory)))))) (defun tramp-smb-handle-make-symbolic-link - (filename linkname &optional ok-if-already-exists) + (target linkname &optional ok-if-already-exists) "Like `make-symbolic-link' for Tramp files. -If LINKNAME is a non-Tramp file, it is used verbatim as the target of -the symlink. If LINKNAME is a Tramp file, only the localname component is -used as the target of the symlink. - -If LINKNAME is a Tramp file and the localname component is relative, then -it is expanded first, before the localname component is taken. Note that -this can give surprising results if the user/host for the source and -target of the symlink differ." - (unless (tramp-equal-remote filename linkname) - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename linkname) nil - (tramp-error - v 'file-error - "make-symbolic-link: %s" - "only implemented for same method, same user, same host"))) - (with-parsed-tramp-file-name filename v1 - (with-parsed-tramp-file-name linkname v2 - (when (file-directory-p filename) - (tramp-error - v2 'file-error - "make-symbolic-link: %s must not be a directory" filename)) - (when (and (not ok-if-already-exists) - (file-exists-p linkname) - (not (numberp ok-if-already-exists)) - (y-or-n-p - (format - "File %s already exists; make it a new name anyway? " - linkname))) - (tramp-error v2 'file-already-exists linkname)) - (unless (tramp-smb-get-cifs-capabilities v1) - (tramp-error v2 'file-error "make-symbolic-link not supported")) - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-property v2 (file-name-directory v2-localname)) - (tramp-flush-file-property v2 v2-localname) - (unless - (tramp-smb-send-command - v1 - (format - "symlink \"%s\" \"%s\"" - (tramp-smb-get-localname v1) - (tramp-smb-get-localname v2))) +If TARGET is a non-Tramp file, it is used verbatim as the target +of the symlink. If TARGET is a Tramp file, only the localname +component is used as the target of the symlink." + (if (not (tramp-tramp-file-p (expand-file-name linkname))) + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)) + + (unless (tramp-equal-remote target linkname) + (with-parsed-tramp-file-name + (if (tramp-tramp-file-p target) target linkname) nil (tramp-error - v2 'file-error - "error with make-symbolic-link, see buffer `%s' for details" - (buffer-name)))))) + v 'file-error + "make-symbolic-link: %s" + "only implemented for same method, same user, same host"))) + (with-parsed-tramp-file-name target v1 + (with-parsed-tramp-file-name linkname v2 + (when (file-directory-p target) + (tramp-error + v2 'file-error + "make-symbolic-link: %s must not be a directory" target)) + ;; Do the 'confirm if exists' thing. + (when (file-exists-p linkname) + ;; What to do? + (if (or (null ok-if-already-exists) ; not allowed to exist + (and (numberp ok-if-already-exists) + (not (yes-or-no-p + (format + "File %s already exists; make it a link anyway? " + v2-localname))))) + (tramp-error v2 'file-already-exists v2-localname) + (delete-file linkname))) + (unless (tramp-smb-get-cifs-capabilities v1) + (tramp-error v2 'file-error "make-symbolic-link not supported")) + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-property v2 (file-name-directory v2-localname)) + (tramp-flush-file-property v2 v2-localname) + (unless + (tramp-smb-send-command + v1 + (format + "symlink \"%s\" \"%s\"" + (tramp-smb-get-localname v1) + (tramp-smb-get-localname v2))) + (tramp-error + v2 'file-error + "error with make-symbolic-link, see buffer `%s' for details" + (buffer-name))))))) (defun tramp-smb-handle-process-file (program &optional infile destination display &rest args) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index ef3e62ccce..bb68b9e964 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1597,6 +1597,12 @@ signal identifier to be raised, remaining arguments passed to `tramp-message'. Finally, signal SIGNAL is raised." (let (tramp-message-show-message) (tramp-backtrace vec-or-proc) + (unless arguments + ;; FMT-STRING could be just a file name, as in + ;; `file-already-exists' errors. It could contain the ?\% + ;; character, as in smb domain spec. + (setq arguments (list fmt-string) + fmt-string "%s")) (when vec-or-proc (tramp-message vec-or-proc 1 "%s" @@ -2009,6 +2015,11 @@ ARGS are the arguments OPERATION has been called with." '(add-name-to-file copy-directory copy-file expand-file-name file-equal-p file-in-directory-p file-name-all-completions file-name-completion + ;; Starting with Emacs 26.1, just the 2nd argument of + ;; `make-symbolic-link' matters. For backward + ;; compatibility, we still accept the first argument as + ;; file name to be checked. Handled properly in + ;; `tramp-handle-*-make-symbolic-link'. file-newer-than-file-p make-symbolic-link rename-file)) (save-match-data (cond @@ -3262,11 +3273,18 @@ User is always nil." t))) (defun tramp-handle-make-symbolic-link - (filename linkname &optional _ok-if-already-exists) - "Like `make-symbolic-link' for Tramp files." - (with-parsed-tramp-file-name - (if (tramp-tramp-file-p filename) filename linkname) nil - (tramp-error v 'file-error "make-symbolic-link not supported"))) + (target linkname &optional ok-if-already-exists) + "Like `make-symbolic-link' for Tramp files. +This is the fallback implementation for backends which do not +support symbolic links." + (if (tramp-tramp-file-p (expand-file-name linkname)) + (tramp-error + (tramp-dissect-file-name (expand-file-name linkname)) 'file-error + "make-symbolic-link not supported") + ;; This is needed prior Emacs 26.1, where TARGET has also be + ;; checked for a file name handler. + (tramp-run-real-handler + 'make-symbolic-link (list target linkname ok-if-already-exists)))) (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 55f4b52ccd..3dbb522a7c 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2587,16 +2587,19 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (not (string-equal (error-message-string err) "make-symbolic-link not supported"))))) (should (file-symlink-p tmp-name2)) - (should-error (make-symbolic-link tmp-name1 tmp-name2)) + (should-error (make-symbolic-link tmp-name1 tmp-name2) + :type 'file-already-exists) (make-symbolic-link tmp-name1 tmp-name2 'ok-if-already-exists) (should (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. - (should-error (make-symbolic-link tmp-name1 tmp-name3))) + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3))) ;; Cleanup. (ignore-errors (delete-file tmp-name1) - (delete-file tmp-name2))) + (delete-file tmp-name2) + (delete-file tmp-name3))) ;; Check `add-name-to-file'. (unwind-protect @@ -2605,7 +2608,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (file-exists-p tmp-name1)) (add-name-to-file tmp-name1 tmp-name2) (should-not (file-symlink-p tmp-name2)) - (should-error (add-name-to-file tmp-name1 tmp-name2)) + (should-error (add-name-to-file tmp-name1 tmp-name2) + :type 'file-already-exists) (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) (should-not (file-symlink-p tmp-name2)) ;; `tmp-name3' is a local file name. @@ -2626,10 +2630,24 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should-not (string-equal tmp-name2 (file-truename tmp-name2))) (should (string-equal (file-truename tmp-name1) (file-truename tmp-name2))) - (should (file-equal-p tmp-name1 tmp-name2))) + (should (file-equal-p tmp-name1 tmp-name2)) + ;; `tmp-name3' is a local file name. + (make-symbolic-link tmp-name1 tmp-name3) + (should (file-symlink-p tmp-name3)) + (should-not (string-equal tmp-name3 (file-truename tmp-name3))) + ;; `file-truename' returns a quoted file name for `tmp-name3'. + ;; We must unquote it. + (should + (string-equal + (file-truename tmp-name1) + (funcall + 'tramp-compat-file-name-unquote (file-truename tmp-name3))))) + + ;; Cleanup. (ignore-errors (delete-file tmp-name1) - (delete-file tmp-name2))) + (delete-file tmp-name2) + (delete-file tmp-name3))) ;; `file-truename' shall preserve trailing link of directories. (unless (file-symlink-p tramp-test-temporary-file-directory) commit dcc3ef3ee7b7cf2730378fca4c959f1fc799fbe2 Author: Eli Zaretskii Date: Sat Aug 26 12:52:07 2017 +0300 Fix bugs merged with bug#25428 * lisp/simple.el (auto-fill-mode, visual-line-mode): Doc fix. (Bug#13926) (Bug#25434) (Bug#25435) diff --git a/lisp/simple.el b/lisp/simple.el index 072723cd64..13cfa3487d 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6828,9 +6828,12 @@ other purposes." (define-minor-mode visual-line-mode "Toggle visual line based editing (Visual Line mode). -With a prefix argument ARG, enable Visual Line mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +Interactively, with a prefix argument, enable +Visual Line mode if the prefix argument is positive, +and disable it otherwise. If called from Lisp, toggle +the mode if ARG is `toggle', disable the mode if ARG is +a non-positive integer, and enable the mode otherwise +\(including if ARG is omitted or nil or a positive integer). When Visual Line mode is enabled, `word-wrap' is turned on in this buffer, and simple editing commands are redefined to act on @@ -7262,9 +7265,12 @@ Some major modes set this.") (define-minor-mode auto-fill-mode "Toggle automatic line breaking (Auto Fill mode). -With a prefix argument ARG, enable Auto Fill mode if ARG is -positive, and disable it otherwise. If called from Lisp, enable -the mode if ARG is omitted or nil. +Interactively, with a prefix argument, enable +Auto Fill mode if the prefix argument is positive, +and disable it otherwise. If called from Lisp, toggle +the mode if ARG is `toggle', disable the mode if ARG is +a non-positive integer, and enable the mode otherwise +\(including if ARG is omitted or nil or a positive integer). When Auto Fill mode is enabled, inserting a space at a column beyond `current-fill-column' automatically breaks the line at a commit 5bb61463a281961198b6fbafa99023e7807584b6 Author: Eli Zaretskii Date: Sat Aug 26 12:40:02 2017 +0300 Improve documentation of Info virtual files and nodes * lisp/info.el (Info-virtual-files, Info-virtual-nodes): Doc fix. (Bug#28237) diff --git a/lisp/info.el b/lisp/info.el index 45a9116e06..b0b4789edd 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -440,22 +440,33 @@ Each element has the form (INFO-FILE INDEX-NODE-NAMES-LIST).") (defvar Info-virtual-files nil "List of definitions of virtual Info files. -Each element of the list has the format (FILENAME (OPERATION . HANDLER) ...) -where FILENAME is a regexp that matches a class of virtual Info file names. -It should be carefully chosen to not cause file name clashes with -existing file names. OPERATION is one of the following operation -symbols `find-file', `find-node', `toc-nodes' that define what HANDLER -function to call instead of calling the default corresponding function -to override it.") +Each element of the list has the form (FILENAME (OPERATION . HANDLER) EXTRA) +where FILENAME is a regexp that matches a class of virtual Info file names, +it should be carefully chosen to not cause file name clashes with +existing file names; +OPERATION is one of the symbols `find-file', `find-node', `toc-nodes'; +and HANDLER is a function to call when OPERATION is invoked on a +virtual Info file. +EXTRA, if present, is one or more cons cells specifying extra +attributes important to some applications which use this data. +For example, desktop saving and desktop restoring use the `slow' +attribute to avoid restoration of nodes that could be expensive +to compute.") (defvar Info-virtual-nodes nil "List of definitions of virtual Info nodes. -Each element of the list has the format (NODENAME (OPERATION . HANDLER) ...) -where NODENAME is a regexp that matches a class of virtual Info node names. -It should be carefully chosen to not cause node name clashes with -existing node names. OPERATION is one of the following operation -symbols `find-node' that define what HANDLER function to call instead -of calling the default corresponding function to override it.") +Each element of the list has the form (NODENAME (OPERATION . HANDLER) EXTRA) +where NODENAME is a regexp that matches a class of virtual Info node names, +it should be carefully chosen to not cause node name clashes with +existing node names; +OPERATION is the symbol `find-node'; +and HANDLER is a function to call when OPERATION is invoked on a +virtual Info node. +EXTRA, if present, is one or more cons cells specifying extra +attributes important to some applications which use this data. +For example, desktop saving and desktop restoring use the `slow' +attribute to avoid restoration of nodes that could be expensive +to compute.") (defvar-local Info-current-node-virtual nil "Non-nil if the current Info node is virtual.") commit fca62645b6dab55fb39dbef2a09d5044dcf8efc1 Author: Eli Zaretskii Date: Sat Aug 26 12:01:24 2017 +0300 * lisp/delsel.el (delete-selection-mode): Doc fix. (Bug#25428) diff --git a/lisp/delsel.el b/lisp/delsel.el index d5f4736fdd..8cb7adeaa3 100644 --- a/lisp/delsel.el +++ b/lisp/delsel.el @@ -70,9 +70,12 @@ Value must be the register (key) to use.") ;;;###autoload (define-minor-mode delete-selection-mode "Toggle Delete Selection mode. -With a prefix argument ARG, enable Delete Selection mode if ARG -is positive, and disable it otherwise. If called from Lisp, -enable the mode if ARG is omitted or nil. +Interactively, with a prefix argument, enable +Delete Selection mode if the prefix argument is positive, +and disable it otherwise. If called from Lisp, toggle +the mode if ARG is `toggle', disable the mode if ARG is +a non-positive integer, and enable the mode otherwise +\(including if ARG is omitted or nil or a positive integer). When Delete Selection mode is enabled, typed text replaces the selection if the selection is active. Otherwise, typed text is just inserted at commit 21a9e5253e5d436cbe0d3f5571521641008a47b0 Author: Grégory Mounié Date: Sat Aug 26 11:36:58 2017 +0300 Support multi-lingual detection of SEE ALSO man sections * lisp/man.el (Man-see-also-regexp): Add support for SEE ALSO section detection in several langages: French, German, Spanish, Portugese, Italian, Polish, Turkish, Japanese, Chinese. (Bug#28142) Copyright-paperwork-exempt: yes diff --git a/lisp/man.el b/lisp/man.el index 13efc21b03..c7d8c4089d 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -295,7 +295,7 @@ Used in `bookmark-set' to get the default bookmark name." (defvar Man-heading-regexp "^\\([[:upper:]][[:upper:]0-9 /-]+\\)$" "Regular expression describing a manpage heading entry.") -(defvar Man-see-also-regexp "SEE ALSO" +(defvar Man-see-also-regexp "\\(SEE ALSO\\|VOIR AUSSI\\|SIEHE AUCH\\|VÉASE TAMBIÉN\\|VEJA TAMBÉM\\|VEDERE ANCHE\\|ZOBACZ TAKŻE\\|İLGİLİ BELGELER\\|参照\\|参见 SEE ALSO\\|參見 SEE ALSO\\)" "Regular expression for SEE ALSO heading (or your equivalent). This regexp should not start with a `^' character.") commit 05f9ffd53c65699e8de6cca4817b1f2dc2f63a79 Author: Paul Eggert Date: Fri Aug 25 21:12:37 2017 -0700 Improve expand-file-name doc * doc/lispref/files.texi (Relative File Names, Directory Names) (File Name Expansion): * doc/lispref/minibuf.texi (Reading File Names): Document expand-file-name behavior with ~ more clearly and accurately. * doc/misc/org.texi (Batch execution): Simplify example script so that it does not need expand-file-name and thus will not mishandle file names with leading ~. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 60369236ff..bb355f1ee3 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2137,7 +2137,8 @@ file name, @code{nil} otherwise. @end example @end defun - Given a possibly relative file name, you can convert it to an + Given a possibly relative file name, you can expand any +leading @samp{~} and convert the result to an absolute name using @code{expand-file-name} (@pxref{File Name Expansion}). This function converts absolute file names to relative names: @@ -2264,6 +2265,10 @@ might be nil (for example, from an element of @code{load-path}), use: (expand-file-name @var{relfile} @var{dirname}) @end example +However, @code{expand-file-name} expands leading @samp{~} in +@var{relfile}, which may not be what you want. @xref{File Name +Expansion}. + To convert a directory name to its abbreviation, use this function: @@ -2302,7 +2307,8 @@ and eliminating redundancies like @file{./} and @file{@var{name}/../}. @defun expand-file-name filename &optional directory This function converts @var{filename} to an absolute file name. If @var{directory} is supplied, it is the default directory to start with -if @var{filename} is relative. (The value of @var{directory} should +if @var{filename} is relative and does not start with @samp{~}. +(The value of @var{directory} should itself be an absolute directory name or directory file name; it may start with @samp{~}.) Otherwise, the current buffer's value of @code{default-directory} is used. For example: @@ -2322,11 +2328,15 @@ start with @samp{~}.) Otherwise, the current buffer's value of @end group @end example -If the part of the combined file name before the first slash is +If the part of @var{filename} before the first slash is @samp{~}, it expands to the value of the @env{HOME} environment variable (usually your home directory). If the part before the first slash is @samp{~@var{user}} and if @var{user} is a valid login name, it expands to @var{user}'s home directory. +If you do not want this expansion for a relative @var{filename} that +might begin with a literal @samp{~}, you can use @code{(concat +(file-name-as-directory directory) filename)} instead of +@code{(expand-file-name filename directory)}. Filenames containing @samp{.} or @samp{..} are simplified to their canonical form: diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 8140255267..89dee84784 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -1439,7 +1439,7 @@ platform-dependent. Here, we simply document the behavior when using the minibuffer. @code{read-file-name} does not automatically expand the returned file -name. You must call @code{expand-file-name} yourself if an absolute +name. You can call @code{expand-file-name} yourself if an absolute file name is required. The optional argument @var{require-match} has the same meaning as in diff --git a/doc/misc/org.texi b/doc/misc/org.texi index e1de308731..2d537946be 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -1040,8 +1040,8 @@ shown below. debug-on-quit nil) ;; add latest org-mode to load path -(add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) -(add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) +(add-to-list 'load-path "/path/to/org-mode/lisp") +(add-to-list 'load-path "/path/to/org-mode/contrib/lisp" t) @end lisp If an error occurs, a backtrace can be very useful (see below on how to @@ -16900,25 +16900,18 @@ The sample script shows batch processing of multiple files using @example #!/bin/sh -# -*- mode: shell-script -*- -# # tangle files with org-mode # -DIR=`pwd` -FILES="" - -# wrap each argument in the code required to call tangle on it -for i in $@@; do - FILES="$FILES \"$i\"" -done - -emacs -Q --batch \ - --eval "(progn - (require 'org)(require 'ob)(require 'ob-tangle) - (mapc (lambda (file) - (find-file (expand-file-name file \"$DIR\")) - (org-babel-tangle) - (kill-buffer)) '($FILES)))" 2>&1 |grep -i tangled +emacs -Q --batch --eval " + (progn + (require 'ob-tangle) + (mapc (lambda (file) + (save-current-buffer + (find-file file) + (org-babel-tangle) + (kill-buffer))) + command-line-args-left)) + " "$@@" @end example @node Miscellaneous commit feecb66b6fe41c977b8e11b5f2d419c9544f42de Author: Jefferson Carpenter Date: Fri Jul 7 17:08:52 2017 -0500 Support all perl variable declarators and prefixes (Bug#27613) * lisp/progmodes/perl-mode.el (perl-imenu-generic-expression) (perl-font-lock-keywords-2): Match declators 'anon', 'argument', 'has', 'local', 'state', 'supersede', 'let', and 'temp'. Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 6197a53ee6..5e199fb0c3 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -135,7 +135,7 @@ '(;; Functions (nil "^[ \t]*sub\\s-+\\([-[:alnum:]+_:]+\\)" 1) ;;Variables - ("Variables" "^\\(?:my\\|our\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) + ("Variables" "^[ \t]*\\(?:anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\s-+\\([$@%][-[:alnum:]+_:]+\\)\\s-*=" 1) ("Packages" "^[ \t]*package\\s-+\\([-[:alnum:]+_:]+\\);" 1) ("Doc sections" "^=head[0-9][ \t]+\\(.*\\)" 1)) "Imenu generic expression for Perl mode. See `imenu-generic-expression'.") @@ -179,8 +179,9 @@ "BEGIN" "END" "return" "exec" "eval") t) "\\>") ;; - ;; Fontify local and my keywords as types. - ("\\<\\(local\\|my\\)\\>" . font-lock-type-face) + ;; Fontify declarators and prefixes as types. + ("\\<\\(anon\\|argument\\|has\\|local\\|my\\|our\\|state\\|supersede\\)\\>" . font-lock-type-face) ; declarators + ("\\<\\(let\\|temp\\)\\>" . font-lock-type-face) ; prefixes ;; ;; Fontify function, variable and file name references. ("&\\(\\sw+\\(::\\sw+\\)*\\)" 1 font-lock-function-name-face) commit a7ed4ec0958662265136820333da1a8fbd3a864e Author: Noam Postavsky Date: Fri Aug 25 22:47:51 2017 -0400 ; * doc/lispref/files.texi (File Attributes): Add missing word. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 36944e4713..60369236ff 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1253,7 +1253,7 @@ On GNU platforms when operating on a local file, this function is atomic: if the filesystem is simultaneously being changed by some other process, this function returns the file's attributes either before or after the change. Otherwise this function is not atomic, -and might return @code{nil} it detects the race condition, or might +and might return @code{nil} if it detects the race condition, or might return a hodgepodge of the previous and current file attributes. Accessor functions are provided to access the elements in this list. commit 2b7e009257a40ef1dcad9845fe61764fea08cdea Author: Paul Eggert Date: Fri Aug 25 12:44:52 2017 -0700 Fix file-attributes race on GNU hosts * doc/lispref/files.texi (File Attributes): Document file-attributes atomicity. * etc/NEWS: Document the fix. * src/dired.c (file_attributes): New args DIRNAME and FILENAME, for diagnostics. All callers changed. On platforms like GNU/Linux that support O_PATH, fix a race condition in file-attributes and similar functions, so that these functions do not return nonsense if a directory entry is replaced while getting its attributes. On non-GNU platforms, do a better (though not perfect) job of detecting the race, and return nil if detected. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 5a52765131..36944e4713 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1249,6 +1249,13 @@ the default, but we plan to change that, so you should specify a non-@code{nil} value for @var{id-format} if you use the returned @acronym{UID} or @acronym{GID}. +On GNU platforms when operating on a local file, this function is +atomic: if the filesystem is simultaneously being changed by some +other process, this function returns the file's attributes either +before or after the change. Otherwise this function is not atomic, +and might return @code{nil} it detects the race condition, or might +return a hodgepodge of the previous and current file attributes. + Accessor functions are provided to access the elements in this list. The accessors are mentioned along with the descriptions of the elements below. diff --git a/etc/NEWS b/etc/NEWS index bf59749a62..02de66b355 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1427,6 +1427,12 @@ job of signaling list cycles instead of looping indefinitely. ** The new functions 'make-nearby-temp-file' and 'temporary-file-directory' can be used for creation of temporary files of remote or mounted directories. ++++ +** On GNU platforms when operating on a local file, 'file-attributes' +no longer suffers from a race when called while another process is +altering the filesystem. On non-GNU platforms 'file-attributes' +attempts to detect the race, and returns nil if it does so. + +++ ** The new function 'file-local-name' can be used to specify arguments of remote processes. diff --git a/src/dired.c b/src/dired.c index 288ba6b103..128493aff2 100644 --- a/src/dired.c +++ b/src/dired.c @@ -51,7 +51,8 @@ extern int is_slow_fs (const char *); #endif static ptrdiff_t scmp (const char *, const char *, ptrdiff_t); -static Lisp_Object file_attributes (int, char const *, Lisp_Object); +static Lisp_Object file_attributes (int, char const *, Lisp_Object, + Lisp_Object, Lisp_Object); /* Return the number of bytes in DP's name. */ static ptrdiff_t @@ -161,7 +162,7 @@ read_dirent (DIR *dir, Lisp_Object dirname) /* Function shared by Fdirectory_files and Fdirectory_files_and_attributes. If not ATTRS, return a list of directory filenames; if ATTRS, return a list of directory filenames and their attributes. - In the latter case, ID_FORMAT is passed to Ffile_attributes. */ + In the latter case, pass ID_FORMAT to file_attributes. */ Lisp_Object directory_files_internal (Lisp_Object directory, Lisp_Object full, @@ -225,7 +226,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, if (attrs) { /* Do this only once to avoid doing it (in w32.c:stat) for each - file in the directory, when we call Ffile_attributes below. */ + file in the directory, when we call file_attributes below. */ record_unwind_protect (directory_files_internal_w32_unwind, Vw32_get_true_file_attributes); w32_save = Vw32_get_true_file_attributes; @@ -304,7 +305,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, if (attrs) { Lisp_Object fileattrs - = file_attributes (fd, dp->d_name, id_format); + = file_attributes (fd, dp->d_name, directory, name, id_format); list = Fcons (Fcons (finalname, fileattrs), list); } else @@ -351,7 +352,7 @@ If NOSORT is non-nil, the list is not sorted--its order is unpredictable. return call5 (handler, Qdirectory_files, directory, full, match, nosort); - return directory_files_internal (directory, full, match, nosort, 0, Qnil); + return directory_files_internal (directory, full, match, nosort, false, Qnil); } DEFUN ("directory-files-and-attributes", Fdirectory_files_and_attributes, @@ -379,7 +380,8 @@ which see. */) return call6 (handler, Qdirectory_files_and_attributes, directory, full, match, nosort, id_format); - return directory_files_internal (directory, full, match, nosort, 1, id_format); + return directory_files_internal (directory, full, match, nosort, + true, id_format); } @@ -923,14 +925,17 @@ so last access time will always be midnight of that day. */) } encoded = ENCODE_FILE (filename); - return file_attributes (AT_FDCWD, SSDATA (encoded), id_format); + return file_attributes (AT_FDCWD, SSDATA (encoded), Qnil, filename, + id_format); } static Lisp_Object -file_attributes (int fd, char const *name, Lisp_Object id_format) +file_attributes (int fd, char const *name, + Lisp_Object dirname, Lisp_Object filename, + Lisp_Object id_format) { + ptrdiff_t count = SPECPDL_INDEX (); struct stat s; - int lstat_result; /* An array to hold the mode string generated by filemodestring, including its terminating space and null byte. */ @@ -938,22 +943,60 @@ file_attributes (int fd, char const *name, Lisp_Object id_format) char *uname = NULL, *gname = NULL; -#ifdef WINDOWSNT - /* We usually don't request accurate owner and group info, because - it can be very expensive on Windows to get that, and most callers - of 'lstat' don't need that. But here we do want that information - to be accurate. */ - w32_stat_get_owner_group = 1; -#endif + int err = EINVAL; - lstat_result = fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW); +#ifdef O_PATH + int namefd = openat (fd, name, O_PATH | O_CLOEXEC | O_NOFOLLOW); + if (namefd < 0) + err = errno; + else + { + record_unwind_protect_int (close_file_unwind, namefd); + if (fstat (namefd, &s) != 0) + err = errno; + else + { + err = 0; + fd = namefd; + name = ""; + } + } +#endif + if (err == EINVAL) + { +#ifdef WINDOWSNT + /* We usually don't request accurate owner and group info, + because it can be expensive on Windows to get that, and most + callers of 'lstat' don't need that. But here we do want that + information to be accurate. */ + w32_stat_get_owner_group = 1; +#endif + if (fstatat (fd, name, &s, AT_SYMLINK_NOFOLLOW) == 0) + err = 0; #ifdef WINDOWSNT - w32_stat_get_owner_group = 0; + w32_stat_get_owner_group = 0; #endif + } - if (lstat_result < 0) - return Qnil; + if (err != 0) + return unbind_to (count, Qnil); + + Lisp_Object file_type; + if (S_ISLNK (s.st_mode)) + { + /* On systems lacking O_PATH support there is a race if the + symlink is replaced between the call to fstatat and the call + to emacs_readlinkat. Detect this race unless the replacement + is also a symlink. */ + file_type = emacs_readlinkat (fd, name); + if (NILP (file_type)) + return unbind_to (count, Qnil); + } + else + file_type = S_ISDIR (s.st_mode) ? Qt : Qnil; + + unbind_to (count, Qnil); if (!(NILP (id_format) || EQ (id_format, Qinteger))) { @@ -964,8 +1007,7 @@ file_attributes (int fd, char const *name, Lisp_Object id_format) filemodestring (&s, modes); return CALLN (Flist, - (S_ISLNK (s.st_mode) ? emacs_readlinkat (fd, name) - : S_ISDIR (s.st_mode) ? Qt : Qnil), + file_type, make_number (s.st_nlink), (uname ? DECODE_SYSTEM (build_unibyte_string (uname)) diff --git a/src/kqueue.c b/src/kqueue.c index a8eb4cb797..30922ef28b 100644 --- a/src/kqueue.c +++ b/src/kqueue.c @@ -130,7 +130,7 @@ kqueue_compare_dir_list (Lisp_Object watch_object) return; } new_directory_files = - directory_files_internal (dir, Qnil, Qnil, Qnil, 1, Qnil); + directory_files_internal (dir, Qnil, Qnil, Qnil, true, Qnil); new_dl = kqueue_directory_listing (new_directory_files); /* Parse through the old list. */ @@ -453,7 +453,7 @@ only when the upper directory of the renamed file is watched. */) if (NILP (Ffile_directory_p (file))) watch_object = list4 (watch_descriptor, file, flags, callback); else { - dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, 1, Qnil); + dir_list = directory_files_internal (file, Qnil, Qnil, Qnil, true, Qnil); watch_object = list5 (watch_descriptor, file, flags, callback, dir_list); } watch_list = Fcons (watch_object, watch_list); diff --git a/src/sysdep.c b/src/sysdep.c index 12e9c83ee9..b66a745317 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2930,7 +2930,7 @@ list_system_processes (void) process. */ procdir = build_string ("/proc"); match = build_string ("[0-9]+"); - proclist = directory_files_internal (procdir, Qnil, match, Qt, 0, Qnil); + proclist = directory_files_internal (procdir, Qnil, match, Qt, false, Qnil); /* `proclist' gives process IDs as strings. Destructively convert each string into a number. */ commit 9a223dab9036ff72b16e7a9878af090c041fd0c6 Author: Paul Eggert Date: Fri Aug 25 09:20:52 2017 -0700 Simplify expand_and_dir_to_file * src/fileio.c (expand_and_dir_to_file): Simplify by omitting 2nd argument, since in practice it always has the default value. All callers changed. Prefer C99 style decls in nearby code. diff --git a/src/callproc.c b/src/callproc.c index 4cec02be7e..b93d361a94 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -120,7 +120,7 @@ encode_current_directory (void) if (NILP (dir)) dir = build_string ("~"); - dir = expand_and_dir_to_file (dir, Qnil); + dir = expand_and_dir_to_file (dir); if (NILP (Ffile_accessible_directory_p (dir))) report_file_error ("Setting current directory", diff --git a/src/fileio.c b/src/fileio.c index ca1bc5065e..76ea7da0e8 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1758,11 +1758,9 @@ those `/' is discarded. */) (directory-file-name (expand-file-name FOO)). */ Lisp_Object -expand_and_dir_to_file (Lisp_Object filename, Lisp_Object defdir) +expand_and_dir_to_file (Lisp_Object filename) { - register Lisp_Object absname; - - absname = Fexpand_file_name (filename, defdir); + Lisp_Object absname = Fexpand_file_name (filename, Qnil); /* Remove final slash, if any (unless this is the root dir). stat behaves differently depending! */ @@ -2676,14 +2674,11 @@ Symbolic links to directories count as directories. See `file-symlink-p' to distinguish symlinks. */) (Lisp_Object filename) { - Lisp_Object absname; - Lisp_Object handler; - - absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); + Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname, Qfile_directory_p); + Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_directory_p); if (!NILP (handler)) return call2 (handler, Qfile_directory_p, absname); @@ -2807,15 +2802,12 @@ Symbolic links to regular files count as regular files. See `file-symlink-p' to distinguish symlinks. */) (Lisp_Object filename) { - register Lisp_Object absname; struct stat st; - Lisp_Object handler; - - absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); + Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname, Qfile_regular_p); + Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_regular_p); if (!NILP (handler)) return call2 (handler, Qfile_regular_p, absname); @@ -2853,21 +2845,13 @@ Return (nil nil nil nil) if the file is nonexistent or inaccessible, or if SELinux is disabled, or if Emacs lacks SELinux support. */) (Lisp_Object filename) { - Lisp_Object absname; Lisp_Object user = Qnil, role = Qnil, type = Qnil, range = Qnil; - - Lisp_Object handler; -#if HAVE_LIBSELINUX - security_context_t con; - int conlength; - context_t context; -#endif - - absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); + Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname, Qfile_selinux_context); + Lisp_Object handler = Ffind_file_name_handler (absname, + Qfile_selinux_context); if (!NILP (handler)) return call2 (handler, Qfile_selinux_context, absname); @@ -2876,10 +2860,11 @@ or if SELinux is disabled, or if Emacs lacks SELinux support. */) #if HAVE_LIBSELINUX if (is_selinux_enabled ()) { - conlength = lgetfilecon (SSDATA (absname), &con); + security_context_t con; + int conlength = lgetfilecon (SSDATA (absname), &con); if (conlength > 0) { - context = context_new (con); + context_t context = context_new (con); if (context_user_get (context)) user = build_string (context_user_get (context)); if (context_role_get (context)) @@ -2990,35 +2975,28 @@ Return nil if file does not exist or is not accessible, or if Emacs was unable to determine the ACL entries. */) (Lisp_Object filename) { -#if USE_ACL - Lisp_Object absname; - Lisp_Object handler; -# ifdef HAVE_ACL_SET_FILE - acl_t acl; - Lisp_Object acl_string; - char *str; -# ifndef HAVE_ACL_TYPE_EXTENDED - acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS; -# endif -# endif + Lisp_Object acl_string = Qnil; - absname = expand_and_dir_to_file (filename, - BVAR (current_buffer, directory)); +#if USE_ACL + Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname, Qfile_acl); + Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_acl); if (!NILP (handler)) return call2 (handler, Qfile_acl, absname); # ifdef HAVE_ACL_SET_FILE absname = ENCODE_FILE (absname); - acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED); +# ifndef HAVE_ACL_TYPE_EXTENDED + acl_type_t ACL_TYPE_EXTENDED = ACL_TYPE_ACCESS; +# endif + acl_t acl = acl_get_file (SSDATA (absname), ACL_TYPE_EXTENDED); if (acl == NULL) return Qnil; - str = acl_to_text (acl, NULL); + char *str = acl_to_text (acl, NULL); if (str == NULL) { acl_free (acl); @@ -3028,12 +3006,10 @@ was unable to determine the ACL entries. */) acl_string = build_string (str); acl_free (str); acl_free (acl); - - return acl_string; # endif #endif - return Qnil; + return acl_string; } DEFUN ("set-file-acl", Fset_file_acl, Sset_file_acl, @@ -3097,15 +3073,12 @@ DEFUN ("file-modes", Ffile_modes, Sfile_modes, 1, 1, 0, Return nil, if file does not exist or is not accessible. */) (Lisp_Object filename) { - Lisp_Object absname; struct stat st; - Lisp_Object handler; - - absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); + Lisp_Object absname = expand_and_dir_to_file (filename); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname, Qfile_modes); + Lisp_Object handler = Ffind_file_name_handler (absname, Qfile_modes); if (!NILP (handler)) return call2 (handler, Qfile_modes, absname); @@ -3232,20 +3205,18 @@ If FILE1 does not exist, the answer is nil; otherwise, if FILE2 does not exist, the answer is t. */) (Lisp_Object file1, Lisp_Object file2) { - Lisp_Object absname1, absname2; struct stat st1, st2; - Lisp_Object handler; CHECK_STRING (file1); CHECK_STRING (file2); - absname1 = Qnil; - absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory)); - absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory)); + Lisp_Object absname1 = expand_and_dir_to_file (file1); + Lisp_Object absname2 = expand_and_dir_to_file (file2); /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (absname1, Qfile_newer_than_file_p); + Lisp_Object handler = Ffind_file_name_handler (absname1, + Qfile_newer_than_file_p); if (NILP (handler)) handler = Ffind_file_name_handler (absname2, Qfile_newer_than_file_p); if (!NILP (handler)) diff --git a/src/lisp.h b/src/lisp.h index 48cf3b3070..81f8d6a24b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3998,7 +3998,7 @@ extern void syms_of_marker (void); /* Defined in fileio.c. */ -extern Lisp_Object expand_and_dir_to_file (Lisp_Object, Lisp_Object); +extern Lisp_Object expand_and_dir_to_file (Lisp_Object); extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int); commit 579890f1c7703cd8ecfe2e56f52cc06fcd1b2442 Author: Eli Zaretskii Date: Fri Aug 25 18:01:19 2017 +0300 ; * src/w32.c (faccessat): Fix last change. (Bug#28207) diff --git a/src/w32.c b/src/w32.c index c989af6a46..131361d7dc 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3910,7 +3910,7 @@ faccessat (int dirfd, const char * path, int mode, int flags) /* When dired.c calls us with F_OK and a trailing slash, it actually wants to know whether PATH is a directory. */ - if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && ((mode & F_OK) == F_OK)) + if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && mode == F_OK) mode |= D_OK; /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its commit 0d2b4093984f0927b4fb07de971bd7e077fee93c Author: Eli Zaretskii Date: Fri Aug 25 17:43:15 2017 +0300 Fix file-name completion on network shares * src/w32.c (faccessat): Don't assume that F_OK is non-zero. (Bug#28207) diff --git a/src/w32.c b/src/w32.c index a4be017d8e..c989af6a46 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3908,7 +3908,9 @@ faccessat (int dirfd, const char * path, int mode, int flags) path = fullname; } - if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && (mode & F_OK) != 0) + /* When dired.c calls us with F_OK and a trailing slash, it actually + wants to know whether PATH is a directory. */ + if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && ((mode & F_OK) == F_OK)) mode |= D_OK; /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its commit 690512d2af16370097cf646764e86caf8a27eade Author: Reuben Thomas Date: Fri Aug 25 13:58:11 2017 +0100 Fix a FIXME with an exegetical comment * lisp/progmodes/sh-script.el (sh-builtins): Explain why we have a regexp for wksh builtins. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 24fba1505f..95fe3b082b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -710,7 +710,7 @@ removed when closing the here document." (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") (wksh sh-append ksh88 - ;; FIXME: This looks too much like a regexp. --Stef + ;; wksh has X toolkit APIs as built-ins! "Xt[A-Z][A-Za-z]*") (zsh sh-append ksh88 commit 38daeca937cdd520ea944c661f978b6dbec9b259 Author: Reuben Thomas Date: Fri Aug 25 13:46:50 2017 +0100 Minor docstring language fix * lisp/progmodes/sh-script.el (sh-show-indent): Remove spurious “the”. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index c16011df0e..24fba1505f 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -3382,7 +3382,7 @@ If INFO is supplied it is used, else it is calculated from current line." (if msg (message "%s" msg) (message nil)))) (defun sh-show-indent (arg) - "Show the how the current line would be indented. + "Show how the current line would be indented. This tells you which variable, if any, controls the indentation of this line. If optional arg ARG is non-null (called interactively with a prefix), commit ca30d22fbada85d49de7c7708207b9e3daa4efb8 Author: Reuben Thomas Date: Fri Aug 25 13:45:32 2017 +0100 Remove old commented code from sh-script.el * lisp/progmodes/sh-script.el (sh-abbrevs): Remove commented function and variable, commented since 2001. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 23e79f6ac5..c16011df0e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -419,44 +419,6 @@ name symbol." (define-abbrev-table 'sh-mode-abbrev-table ()) -;; I turned off this feature because it doesn't permit typing commands -;; in the usual way without help. -;;(defvar sh-abbrevs -;; '((csh sh-abbrevs shell -;; "switch" 'sh-case -;; "getopts" 'sh-while-getopts) - -;; (es sh-abbrevs shell -;; "function" 'sh-function) - -;; (ksh88 sh-abbrevs sh -;; "select" 'sh-select) - -;; (rc sh-abbrevs shell -;; "case" 'sh-case -;; "function" 'sh-function) - -;; (sh sh-abbrevs shell -;; "case" 'sh-case -;; "function" 'sh-function -;; "until" 'sh-until -;; "getopts" 'sh-while-getopts) - -;; ;; The next entry is only used for defining the others -;; (shell "for" sh-for -;; "loop" sh-indexed-loop -;; "if" sh-if -;; "tmpfile" sh-tmp-file -;; "while" sh-while) - -;; (zsh sh-abbrevs ksh88 -;; "repeat" 'sh-repeat)) -;; "Abbrev-table used in Shell-Script mode. See `sh-feature'. -;;;Due to the internal workings of abbrev tables, the shell name symbol is -;;;actually defined as the table for the like of \\[edit-abbrevs].") - - - (defun sh-mode-syntax-table (table &rest list) "Copy TABLE and set syntax for successive CHARs according to strings S." (setq table (copy-syntax-table table)) @@ -2512,39 +2474,6 @@ the value thus obtained, and the result is used instead." -;; I commented this out because nobody calls it -- rms. -;;(defun sh-abbrevs (ancestor &rest list) -;; "If it isn't, define the current shell as abbrev table and fill that. -;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev -;;table or a list of (NAME1 EXPANSION1 ...). In addition it will define abbrevs -;;according to the remaining arguments NAMEi EXPANSIONi ... -;;EXPANSION may be either a string or a skeleton command." -;; (or (if (boundp sh-shell) -;; (symbol-value sh-shell)) -;; (progn -;; (if (listp ancestor) -;; (nconc list ancestor)) -;; (define-abbrev-table sh-shell ()) -;; (if (vectorp ancestor) -;; (mapatoms (lambda (atom) -;; (or (eq atom 0) -;; (define-abbrev (symbol-value sh-shell) -;; (symbol-name atom) -;; (symbol-value atom) -;; (symbol-function atom)))) -;; ancestor)) -;; (while list -;; (define-abbrev (symbol-value sh-shell) -;; (car list) -;; (if (stringp (car (cdr list))) -;; (car (cdr list)) -;; "") -;; (if (symbolp (car (cdr list))) -;; (car (cdr list)))) -;; (setq list (cdr (cdr list))))) -;; (symbol-value sh-shell))) - - (defun sh-append (ancestor &rest list) "Return list composed of first argument (a list) physically appended to rest." (nconc list ancestor)) commit 1bd165811113e07440888839d770fb26ef21a2c9 Author: Stefan Monnier Date: Fri Aug 25 02:10:53 2017 -0400 * lisp/emacs-lisp/package.el: Don't let failure stop us (package-activate-1): Don't throw an error for missing deps. (package-unpack): Don't bother compiling if activation failed. (package-initialize): Report failures but keep activating other packages. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2404ccd14e..889d7943c9 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -708,24 +708,26 @@ correspond to previously loaded files (those returned by (unless pkg-dir (error "Internal error: unable to find directory for `%s'" (package-desc-full-name pkg-desc))) - ;; Activate its dependencies recursively. - ;; FIXME: This doesn't check whether the activated version is the - ;; required version. - (when deps - (dolist (req (package-desc-reqs pkg-desc)) - (unless (package-activate (car req)) - (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable" - name (car req) (package-version-join (cadr req)))))) - (package--load-files-for-activation pkg-desc reload) - ;; Add info node. - (when (file-exists-p (expand-file-name "dir" pkg-dir)) - ;; FIXME: not the friendliest, but simple. - (require 'info) - (info-initialize) - (push pkg-dir Info-directory-list)) - (push name package-activated-list) - ;; Don't return nil. - t)) + (catch 'exit + ;; Activate its dependencies recursively. + ;; FIXME: This doesn't check whether the activated version is the + ;; required version. + (when deps + (dolist (req (package-desc-reqs pkg-desc)) + (unless (package-activate (car req)) + (message "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable" + name (car req) (package-version-join (cadr req))) + (throw 'exit nil)))) + (package--load-files-for-activation pkg-desc reload) + ;; Add info node. + (when (file-exists-p (expand-file-name "dir" pkg-dir)) + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (push pkg-dir Info-directory-list)) + (push name package-activated-list) + ;; Don't return nil. + t))) (declare-function find-library-name "find-func" (library)) @@ -866,14 +868,14 @@ untar into a directory named DIR; otherwise, signal an error." ;; Activation has to be done before compilation, so that if we're ;; upgrading and macros have changed we load the new definitions ;; before compiling. - (package-activate-1 new-desc :reload :deps) - ;; FIXME: Compilation should be done as a separate, optional, step. - ;; E.g. for multi-package installs, we should first install all packages - ;; and then compile them. - (package--compile new-desc) - ;; After compilation, load again any files loaded by - ;; `activate-1', so that we use the byte-compiled definitions. - (package--load-files-for-activation new-desc :reload)) + (when (package-activate-1 new-desc :reload :deps) + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. + (package--compile new-desc) + ;; After compilation, load again any files loaded by + ;; `activate-1', so that we use the byte-compiled definitions. + (package--load-files-for-activation new-desc :reload))) pkg-dir)) (defun package-generate-description-file (pkg-desc pkg-file) @@ -1463,7 +1465,11 @@ taken care of by `package-initialize'." (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt)))) + (condition-case err + (package-activate (car elt)) + ;; Don't let failure of activation of a package arbitrarily stop + ;; activation of further packages. + (error (message "%s" (error-message-string err)))))) (setq package--initialized t) ;; This uses `package--mapc' so it must be called after ;; `package--initialized' is t. commit daf434b40d61e8cc99485988017a4a95ff475922 Author: Paul Eggert Date: Thu Aug 24 16:15:59 2017 -0700 Prefer ‘double’ for FP temps in xterm.c * src/xterm.c (xm_scroll_callback, xaw_jump_callback) (x_set_toolkit_scroll_bar_thumb) (x_set_toolkit_horizontal_scroll_bar_thumb): Prefer ‘double’ to ‘float’ for individual local floating-point temporaries. diff --git a/src/xterm.c b/src/xterm.c index 77daa22ae0..fb220b335a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -5575,8 +5575,9 @@ xm_scroll_callback (Widget widget, XtPointer client_data, XtPointer call_data) if (horizontal) { - portion = bar->whole * ((float)cs->value / XM_SB_MAX); - whole = bar->whole * ((float)(XM_SB_MAX - slider_size) / XM_SB_MAX); + double dXM_SB_MAX = XM_SB_MAX; + portion = bar->whole * (cs->value / dXM_SB_MAX); + whole = bar->whole * ((XM_SB_MAX - slider_size) / dXM_SB_MAX); portion = min (portion, whole); part = scroll_bar_horizontal_handle; } @@ -5713,7 +5714,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) { struct scroll_bar *bar = client_data; float *top_addr = call_data; - float top = *top_addr; + double top = *top_addr; float shown; int whole, portion, height, width; enum scroll_bar_part part; @@ -5729,7 +5730,8 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) if (shown < 1) { - whole = bar->whole - (shown * bar->whole); + double dshown = shown; + whole = bar->whole - (dshown * bar->whole); portion = min (top * bar->whole, whole); } else @@ -5750,7 +5752,7 @@ xaw_jump_callback (Widget widget, XtPointer client_data, XtPointer call_data) whole = 10000000; portion = shown < 1 ? top * whole : 0; - if (shown < 1 && (eabs (top + shown - 1) < 1.0f / height)) + if (shown < 1 && (eabs (top + shown - 1) < 1.0 / height)) /* Some derivatives of Xaw refuse to shrink the thumb when you reach the bottom, so we force the scrolling whenever we see that we're too close to the bottom (in x_set_toolkit_scroll_bar_thumb @@ -6293,7 +6295,8 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); - float top, shown; + double dwhole = whole; + double top, shown; block_input (); @@ -6322,8 +6325,8 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio top = 0, shown = 1; else { - top = (float) position / whole; - shown = (float) portion / whole; + top = position / dwhole; + shown = portion / dwhole; } if (bar->dragging == -1) @@ -6347,8 +6350,8 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio top = 0, shown = 1; else { - top = (float) position / whole; - shown = (float) portion / whole; + top = position / dwhole; + shown = portion / dwhole; } { @@ -6368,19 +6371,20 @@ x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, int positio #if ! defined (HAVE_XAW3D) /* With Xaw, 'top' values too closer to 1.0 may cause the thumb to disappear. Fix that. */ - top = min (top, 0.99f); + top = min (top, 0.99); #endif /* Keep two pixels available for moving the thumb down. */ - shown = max (0, min (1 - top - (2.0f / height), shown)); + shown = max (0, min (1 - top - (2.0 / height), shown)); #if ! defined (HAVE_XAW3D) /* Likewise with too small 'shown'. */ - shown = max (shown, 0.01f); + shown = max (shown, 0.01); #endif /* If the call to XawScrollbarSetThumb below doesn't seem to work, check that 'NARROWPROTO' is defined in src/config.h. If this is not so, most likely you need to fix configure. */ - if (top != old_top || shown != old_shown) + float ftop = top, fshown = shown; + if (ftop != old_top || fshown != old_shown) { if (bar->dragging == -1) XawScrollbarSetThumb (widget, top, shown); @@ -6405,14 +6409,15 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); Widget widget = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); - float top, shown; + double dwhole = whole; + double top, shown; block_input (); #ifdef USE_MOTIF bar->whole = whole; - shown = (float) portion / whole; - top = (float) position / (whole - portion); + shown = portion / dwhole; + top = position / (dwhole - portion); { int size = clip_to_bounds (1, shown * XM_SB_MAX, XM_SB_MAX); int value = clip_to_bounds (0, top * (XM_SB_MAX - size), XM_SB_MAX - size); @@ -6425,8 +6430,8 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, top = 0, shown = 1; else { - top = (float) position / whole; - shown = (float) portion / whole; + top = position / dwhole; + shown = portion / dwhole; } { @@ -6447,13 +6452,13 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, #if ! defined (HAVE_XAW3D) /* With Xaw, 'top' values too closer to 1.0 may cause the thumb to disappear. Fix that. */ - top = min (top, 0.99f); + top = min (top, 0.99); #endif /* Keep two pixels available for moving the thumb down. */ - shown = max (0, min (1 - top - (2.0f / height), shown)); + shown = max (0, min (1 - top - (2.0 / height), shown)); #if ! defined (HAVE_XAW3D) /* Likewise with too small 'shown'. */ - shown = max (shown, 0.01f); + shown = max (shown, 0.01); #endif #endif @@ -6462,7 +6467,8 @@ x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int portion, If this is not so, most likely you need to fix configure. */ XawScrollbarSetThumb (widget, top, shown); #if false - if (top != old_top || shown != old_shown) + float ftop = top, fshown = shown; + if (ftop != old_top || fshown != old_shown) { if (bar->dragging == -1) XawScrollbarSetThumb (widget, top, shown); commit bd9ad2ea1051a73e30e720b90cf413ee93a977f7 Author: Reuben Thomas Date: Tue Aug 22 01:46:27 2017 +0100 Avoid using string-to-multibyte in ispell.el * lisp/textmodes/ispell.el (ispell-get-decoded-string): Use decode-coding-string instead. Note that decode-coding-string returns a string that satisfies multibyte-string-p even if its input is pure ASCII and the third argument is t, so the result of ispell-get-decoded-string is always a multibyte string. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index e67e603e99..87a3b7aaa1 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1485,25 +1485,15 @@ used as key in `ispell-local-dictionary-alist' and `ispell-dictionary-alist'.") "The name of the current personal dictionary, or nil for the default. This is passed to the Ispell process using the `-p' switch.") -(defun ispell-decode-string (str) - "Decodes multibyte character strings." - (decode-coding-string str (ispell-get-coding-system))) - ;; Return a string decoded from Nth element of the current dictionary. (defun ispell-get-decoded-string (n) "Get the decoded string in slot N of the descriptor of the current dict." (let* ((slot (or (assoc ispell-current-dictionary ispell-local-dictionary-alist) (assoc ispell-current-dictionary ispell-dictionary-alist) - (error "No data for dictionary \"%s\", neither in `ispell-local-dictionary-alist' nor in `ispell-dictionary-alist'" - ispell-current-dictionary))) - (str (nth n slot))) - (when (and (> (length str) 0) - (not (multibyte-string-p str))) - (setq str (ispell-decode-string str)) - (or (multibyte-string-p str) - (setq str (string-to-multibyte str)))) - str)) + (error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'" + ispell-current-dictionary)))) + (decode-coding-string (nth n slot) (ispell-get-coding-system) t))) (defun ispell-get-casechars () (ispell-get-decoded-string 1)) commit 22ebde63c9df6a6815359c1e3406baddec1ed55b Author: Tino Calancha Date: Fri Aug 25 00:24:59 2017 +0900 Store the regexp just when there are matches * lisp/hi-lock.el (hi-lock-set-pattern): When font-lock-mode is disabled and there are no matches do not store REGEXP in hi-lock-interactive-patterns. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 34300212f0..36901c302d 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -721,7 +721,9 @@ with completion and history." (overlay-put overlay 'face face)) (goto-char (match-end 0))) (when no-matches - (add-to-list 'hi-lock--unused-faces (face-name face))))))))) + (add-to-list 'hi-lock--unused-faces (face-name face)) + (setq hi-lock-interactive-patterns + (cdr hi-lock-interactive-patterns))))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." commit 303481b4ecd7d422653263389f86c83b4a4c855b Author: Tino Calancha Date: Fri Aug 25 00:00:20 2017 +0900 Keep face available if there are no matches If font-lock-mode is disabled in the current buffer, and there are no matches for REGEXP, then keep FACE available for a next search. * lisp/hi-lock.el (hi-lock-set-pattern): Add FACE into hi-lock--unused-faces if font-lock-mode is disabled and there are no matches. * test/lisp/hi-lock-tests.el (hi-lock-test-set-pattern): Add test. diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 5139e01fa8..34300212f0 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -693,7 +693,8 @@ with completion and history." "Highlight REGEXP with face FACE." ;; Hashcons the regexp, so it can be passed to remove-overlays later. (setq regexp (hi-lock--hashcons regexp)) - (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend)))) + (let ((pattern (list regexp (list 0 (list 'quote face) 'prepend))) + (no-matches t)) ;; Refuse to highlight a text that is already highlighted. (if (assoc regexp hi-lock-interactive-patterns) (add-to-list 'hi-lock--unused-faces (face-name face)) @@ -713,11 +714,14 @@ with completion and history." (save-excursion (goto-char search-start) (while (re-search-forward regexp search-end t) + (when no-matches (setq no-matches nil)) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'hi-lock-overlay t) (overlay-put overlay 'hi-lock-overlay-regexp regexp) (overlay-put overlay 'face face)) - (goto-char (match-end 0))))))))) + (goto-char (match-end 0))) + (when no-matches + (add-to-list 'hi-lock--unused-faces (face-name face))))))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el index 2cb662cfac..9e2401979b 100644 --- a/test/lisp/hi-lock-tests.el +++ b/test/lisp/hi-lock-tests.el @@ -36,5 +36,17 @@ (hi-lock-set-pattern "a" face)))) (should (equal hi-lock--unused-faces (cdr faces)))))) +(ert-deftest hi-lock-test-set-pattern () + (let ((faces hi-lock-face-defaults)) + (with-temp-buffer + (insert "foo bar") + (cl-letf (((symbol-function 'completing-read) + (lambda (prompt coll x y z hist defaults) + (car defaults)))) + (hi-lock-set-pattern "9999" (hi-lock-read-face-name)) ; No match + (hi-lock-set-pattern "foo" (hi-lock-read-face-name))) + ;; Only one match, then we have used just 1 face + (should (equal hi-lock--unused-faces (cdr faces)))))) + (provide 'hi-lock-tests) ;;; hi-lock-tests.el ends here commit 0332a0ef2bbe6954f080cb6c9d3f0cc2517a1ab1 Author: Michael Albinus Date: Thu Aug 24 15:53:56 2017 +0200 Minor improvements for tramp-interrupt-process, documentation * doc/lispref/processes.texi (Signals to Processes): * etc/NEWS: Document interrupt-process-functions. * lisp/net/tramp.el (tramp-interrupt-process): Test also for `process-live-p'. * src/process.c (Vinterrupt_process_functions): Fix docstring. * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process): Extend test. diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 292d55d50c..45e04a5ab8 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1351,6 +1351,22 @@ integer); that allows you to send signals to processes that are not children of Emacs. @xref{System Processes}. @end deffn +Sometimes, it is necessary to send a signal to a non-local +asynchronous process. This is possible by writing an own +@code{interrupt-process} implementation. This function must be added +then to @code{interrupt-process-functions}. + +@defvar interrupt-process-functions +This variable is a list of functions to be called for +@code{interrupt-process}. The arguments of the functions are the same +as for @code{interrupt-process}. These functions are called in the +order of the list, until one of them returns non-@code{nil}. The +default function, which shall always be the last in this list, is +@code{internal-default-interrupt-process}. + +This is the mechanism, how Tramp implements @code{interrupt-process}. +@end defvar + @node Output from Processes @section Receiving Output from Processes @cindex process output diff --git a/etc/NEWS b/etc/NEWS index a9e2f5ae3f..bf59749a62 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -334,6 +334,13 @@ These variables are for users who would like to avoid the small probability of data corruption due to techniques Emacs uses to recover in these situations. ++++ +** 'interrupt-process' consults now the list +'interrupt-process-functions', which function has to be called in +order to deliver the SIGINT signal. This allows Tramp to send the +SIGINT signal to remote asynchronous processes. The hitherto existing +implementation has been moved to 'internal-default-interrupt-process'. + +++ ** File local and directory local variables are now initialized each time the major mode is set, not just when the file is first visited. @@ -987,6 +994,9 @@ manual documents how to configure ssh and PuTTY accordingly. 'tramp-remote-process-environment' enables reading of shell initialization files. +--- +*** Tramp is able now to send SIGINT to remote asynchronous processes. + --- *** Variable 'tramp-completion-mode' is obsoleted. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 2aa9a6b985..ef3e62ccce 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4393,7 +4393,7 @@ Only works for Bourne-like shells." (t process))) pid) ;; If it's a Tramp process, send the INT signal remotely. - (when (and (processp proc) + (when (and (processp proc) (process-live-p proc) (setq pid (process-get proc 'remote-pid))) (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) ;; This is for tramp-sh.el. Other backends do not support this (yet). diff --git a/src/process.c b/src/process.c index e7ee99ab3d..730caea677 100644 --- a/src/process.c +++ b/src/process.c @@ -8192,8 +8192,8 @@ The variable takes effect when `start-process' is called. */); Vprocess_adaptive_read_buffering = Qt; DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions, - doc: /* List of functions to be called for `interrupt-function'. -The arguments of the functions are the same as for `interrupt-function'. + doc: /* List of functions to be called for `interrupt-process'. +The arguments of the functions are the same as for `interrupt-process'. These functions are called in the order of the list, until one of them returns non-`nil'. */); Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 85ed646722..55f4b52ccd 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2966,9 +2966,17 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (with-temp-buffer (setq proc (start-file-process "test" (current-buffer) "sleep" "10")) (should (processp proc)) + (should (process-live-p proc)) (should (equal (process-status proc) 'run)) - (interrupt-process proc) - (should (equal (process-status proc) 'signal))) + (should (interrupt-process proc)) + ;; Let the process accept the interrupt. + (accept-process-output proc 1 nil 0) + (should-not (process-live-p proc)) + (should (equal (process-status proc) 'signal)) + ;; An interrupted process cannot be interrupted, again. + ;; Does not work reliable. + ;; (should-error (interrupt-process proc))) + ) ;; Cleanup. (ignore-errors (delete-process proc))))) commit fa5e63e40412f6152dbe079a766845112d598479 Author: Reuben Thomas Date: Wed Aug 23 23:47:19 2017 +0100 Fix a comment whitespace typo. src/fileio.c: A double space was added after "..", used in a code example. Make it a single space. diff --git a/src/fileio.c b/src/fileio.c index f954ac12b5..ca1bc5065e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -755,7 +755,7 @@ For technical reasons, this function can return correct but non-intuitive results for the root directory; for instance, \(expand-file-name ".." "/") returns "/..". For this reason, use \(directory-file-name (file-name-directory dirname)) to traverse a -filesystem tree, not (expand-file-name ".." dirname). */) +filesystem tree, not (expand-file-name ".." dirname). */) (Lisp_Object name, Lisp_Object default_directory) { /* These point to SDATA and need to be careful with string-relocation commit f8466812e2841ef37763a7c751ad753b669dff17 Author: Reuben Thomas Date: Wed Aug 23 11:54:34 2017 +0100 Remove old commented code and obsolete comments * lisp/files.el (locate-dominating-files): Remove old commented implementation from 9 years ago. Since the current version appears (at least to me) not just more efficient but clearer than the version removed, also delete a comment in the new version referring to the old version. Remove old commented heuristic code, and explanatory comments. diff --git a/lisp/files.el b/lisp/files.el index be51c200e8..77ebd94836 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -937,38 +937,8 @@ The default regexp prevents fruitless and time-consuming attempts to find special files in directories in which filenames are interpreted as hostnames, or mount points potentially requiring authentication as a different user.") -;; (defun locate-dominating-files (file regexp) -;; "Look up the directory hierarchy from FILE for a file matching REGEXP. -;; Stop at the first parent where a matching file is found and return the list -;; of files that that match in this directory." -;; (catch 'found -;; ;; `user' is not initialized yet because `file' may not exist, so we may -;; ;; have to walk up part of the hierarchy before we find the "initial UID". -;; (let ((user nil) -;; ;; Abbreviate, so as to stop when we cross ~/. -;; (dir (abbreviate-file-name (file-name-as-directory file))) -;; files) -;; (while (and dir -;; ;; As a heuristic, we stop looking up the hierarchy of -;; ;; directories as soon as we find a directory belonging to -;; ;; another user. This should save us from looking in -;; ;; things like /net and /afs. This assumes that all the -;; ;; files inside a project belong to the same user. -;; (let ((prev-user user)) -;; (setq user (nth 2 (file-attributes dir))) -;; (or (null prev-user) (equal user prev-user)))) -;; (if (setq files (condition-case nil -;; (directory-files dir 'full regexp 'nosort) -;; (error nil))) -;; (throw 'found files) -;; (if (equal dir -;; (setq dir (file-name-directory -;; (directory-file-name dir)))) -;; (setq dir nil)))) -;; nil))) - (defun locate-dominating-file (file name) - "Starting from FILE, look up directory hierarchy for directory containing NAME. + "Starting at FILE, look up directory hierarchy for directory containing NAME. FILE can be a file or a directory. If it's a file, its directory will serve as the starting point for searching the hierarchy of directories. Stop at the first parent directory containing a file NAME, @@ -977,31 +947,13 @@ Instead of a string, NAME can also be a predicate taking one argument \(a directory) and returning a non-nil value if that directory is the one for which we're looking. The predicate will be called with every file/directory the function needs to examine, starting with FILE." - ;; We used to use the above locate-dominating-files code, but the - ;; directory-files call is very costly, so we're much better off doing - ;; multiple calls using the code in here. - ;; ;; Represent /home/luser/foo as ~/foo so that we don't try to look for ;; `name' in /home or in /. (setq file (abbreviate-file-name (expand-file-name file))) (let ((root nil) - ;; `user' is not initialized outside the loop because - ;; `file' may not exist, so we may have to walk up part of the - ;; hierarchy before we find the "initial UID". Note: currently unused - ;; (user nil) try) (while (not (or root (null file) - ;; FIXME: Disabled this heuristic because it is sometimes - ;; inappropriate. - ;; As a heuristic, we stop looking up the hierarchy of - ;; directories as soon as we find a directory belonging - ;; to another user. This should save us from looking in - ;; things like /net and /afs. This assumes that all the - ;; files inside a project belong to the same user. - ;; (let ((prev-user user)) - ;; (setq user (nth 2 (file-attributes file))) - ;; (and prev-user (not (equal user prev-user)))) (string-match locate-dominating-stop-dir-regexp file))) (setq try (if (stringp name) (file-exists-p (expand-file-name name file)) commit c71162e0f186a8e50a48629410e17e873ef55938 Author: Reuben Thomas Date: Wed Aug 23 11:34:21 2017 +0100 Remove old duplicate commented code * lisp/files.el (file-relative-name): Remove old commented version, replaced 14 years ago in commit 753ad9889. diff --git a/lisp/files.el b/lisp/files.el index bc347c1d7d..be51c200e8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4733,46 +4733,6 @@ Uses `backup-directory-alist' in the same way as "Return number of names file FILENAME has." (car (cdr (file-attributes filename)))) -;; (defun file-relative-name (filename &optional directory) -;; "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). -;; This function returns a relative file name which is equivalent to FILENAME -;; when used with that default directory as the default. -;; If this is impossible (which can happen on MSDOS and Windows -;; when the file name and directory use different drive names) -;; then it returns FILENAME." -;; (save-match-data -;; (let ((fname (expand-file-name filename))) -;; (setq directory (file-name-as-directory -;; (expand-file-name (or directory default-directory)))) -;; ;; On Microsoft OSes, if FILENAME and DIRECTORY have different -;; ;; drive names, they can't be relative, so return the absolute name. -;; (if (and (or (eq system-type 'ms-dos) -;; (eq system-type 'cygwin) -;; (eq system-type 'windows-nt)) -;; (not (string-equal (substring fname 0 2) -;; (substring directory 0 2)))) -;; filename -;; (let ((ancestor ".") -;; (fname-dir (file-name-as-directory fname))) -;; (while (and (not (string-match (concat "^" (regexp-quote directory)) fname-dir)) -;; (not (string-match (concat "^" (regexp-quote directory)) fname))) -;; (setq directory (file-name-directory (substring directory 0 -1)) -;; ancestor (if (equal ancestor ".") -;; ".." -;; (concat "../" ancestor)))) -;; ;; Now ancestor is empty, or .., or ../.., etc. -;; (if (string-match (concat "^" (regexp-quote directory)) fname) -;; ;; We matched within FNAME's directory part. -;; ;; Add the rest of FNAME onto ANCESTOR. -;; (let ((rest (substring fname (match-end 0)))) -;; (if (and (equal ancestor ".") -;; (not (equal rest ""))) -;; ;; But don't bother with ANCESTOR if it would give us `./'. -;; rest -;; (concat (file-name-as-directory ancestor) rest))) -;; ;; We matched FNAME's directory equivalent. -;; ancestor)))))) - (defun file-relative-name (filename &optional directory) "Convert FILENAME to be relative to DIRECTORY (default: `default-directory'). This function returns a relative file name which is equivalent to FILENAME commit ad3cd227aa915ac1e671c27aa642da49bac5c463 Author: Tom Tromey Date: Wed Aug 23 16:06:48 2017 -0600 Add conf-toml-mode * etc/NEWS: Mention conf-toml-mode. * lisp/files.el (auto-mode-alist): Add entry for .toml. * lisp/textmodes/conf-mode.el (conf-toml-mode-syntax-table) (conf-toml-font-lock-keywords): New defvars. (conf-toml-mode): New mode. diff --git a/etc/NEWS b/etc/NEWS index 09390333ae..a9e2f5ae3f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1115,6 +1115,9 @@ processes on exit. mode for *.html files. This mode handles indentation, fontification, and commenting for embedded JavaScript and CSS. +** New mode 'conf-toml-mode' is a sub-mode of conf-mode, specialized + for editing TOML files. + ** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. ** New major mode 'less-css-mode' (a minor variant of 'css-mode') for diff --git a/lisp/files.el b/lisp/files.el index 0311cc6d21..bc347c1d7d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2653,6 +2653,7 @@ ARC\\|ZIP\\|LZH\\|LHA\\|ZOO\\|[JEW]AR\\|XPI\\|RAR\\|CBR\\|7Z\\)\\'" . archive-mo ("\\.ppd\\'" . conf-ppd-mode) ("java.+\\.conf\\'" . conf-javaprop-mode) ("\\.properties\\(?:\\.[a-zA-Z0-9._-]+\\)?\\'" . conf-javaprop-mode) + ("\\.toml\\'" . conf-toml-mode) ("\\`/etc/\\(?:DIR_COLORS\\|ethers\\|.?fstab\\|.*hosts\\|lesskey\\|login\\.?de\\(?:fs\\|vperm\\)\\|magic\\|mtab\\|pam\\.d/.*\\|permissions\\(?:\\.d/.+\\)?\\|protocols\\|rpc\\|services\\)\\'" . conf-space-mode) ("\\`/etc/\\(?:acpid?/.+\\|aliases\\(?:\\.d/.+\\)?\\|default/.+\\|group-?\\|hosts\\..+\\|inittab\\|ksysguarddrc\\|opera6rc\\|passwd-?\\|shadow-?\\|sysconfig/.+\\)\\'" . conf-mode) ;; ChangeLog.old etc. Other change-log-mode entries are above; diff --git a/lisp/textmodes/conf-mode.el b/lisp/textmodes/conf-mode.el index 054d8dbb8b..7bcc69572d 100644 --- a/lisp/textmodes/conf-mode.el +++ b/lisp/textmodes/conf-mode.el @@ -175,6 +175,16 @@ not align (only setting space according to `conf-assignment-space')." table) "Syntax table in use in Xdefaults style `conf-mode' buffers.") +(defvar conf-toml-mode-syntax-table + (let ((table (make-syntax-table conf-mode-syntax-table))) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?' "\"" table) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?# "<" table) + ;; override + (modify-syntax-entry ?\; "." table) + table) + "Syntax table in use in TOML style `conf-mode' buffers.") (defvar conf-font-lock-keywords '(;; [section] (do this first because it may look like a parameter) @@ -242,6 +252,16 @@ This variable is best set in the file local variables, or through ("^[ \t]*\\([^:\n]+\\)[ \t\n]*{[^{}]*?$" 1 'font-lock-type-face prepend)) "Keywords to highlight in Conf Colon mode.") +(defvar conf-toml-font-lock-keywords + '(;; [section] (do this first because it may look like a parameter) + ("^[ \t]*\\[\\(.+\\)\\]" 1 'font-lock-type-face) + ;; var=val or var[index]=val + ("^[ \t]*\\(.+?\\)\\(?:\\[\\(.*?\\)\\]\\)?[ \t]*=" + (1 'font-lock-variable-name-face) + (2 'font-lock-constant-face nil t)) + ("\\_" 0 'font-lock-keyword-face)) + "Keywords to highlight in Conf TOML mode.") + (defvar conf-assignment-sign ?= "Sign used for assignments (char or string).") @@ -617,6 +637,20 @@ For details see `conf-mode'. Example: *foreground: black" (conf-mode-initialize "!")) +;;;###autoload +(define-derived-mode conf-toml-mode conf-mode "Conf[TOML]" + "Conf Mode starter for TOML files. +Comments start with `#' and \"assignments\" are with `='. +For details see `conf-mode'. Example: + +# Conf mode font-locks this right with \\[conf-toml-mode] + +\[entry] +value = \"some string\"" + (conf-mode-initialize "#" 'conf-toml-font-lock-keywords) + (setq-local conf-assignment-column 0) + (setq-local conf-assignment-sign ?=)) + (provide 'conf-mode) ;;; conf-mode.el ends here commit 9538ba6a0f7b906fed3bb7d10b9b98244469047b Author: Alan Third Date: Wed Aug 23 21:13:22 2017 +0100 Use lisp type in log message (bug#28176) * src/nsimage.m (ns_load_image): Use make_number on index. diff --git a/src/nsimage.m b/src/nsimage.m index 3c81dea67a..ea2f1ec54a 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -108,7 +108,8 @@ Updated by Christian Limpach (chris@nice.ch) if (![eImg setFrame: index]) { - add_to_log ("Unable to set index %d for image %s", index, img->spec); + add_to_log ("Unable to set index %d for image %s", + make_number (index), img->spec); return 0; } commit 95130f192b7c00a118ce745efb94cd3d0aaabab0 Author: Alan Third Date: Wed Aug 23 19:53:23 2017 +0100 Fix PNGs on macOS (bug#28176) * src/nsimage.m (ns_load_image): Remove index check. (EmacsImage::getAnimatedBitmapImageRep): New function. (EmacsImage::getMetadata): Use getAnimatedBitmapImageRep. (EmacsImage::setFrame): Use getAnimatedBitmapImageRep and check index is valid. diff --git a/src/nsimage.m b/src/nsimage.m index 94b24a3912..3c81dea67a 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -106,7 +106,7 @@ Updated by Christian Limpach (chris@nice.ch) return 0; } - if (index < 0 || ![eImg setFrame: index]) + if (![eImg setFrame: index]) { add_to_log ("Unable to set index %d for image %s", index, img->spec); return 0; @@ -450,49 +450,63 @@ - (NSColor *)stippleMask return stippleMask; } -/* If the image has multiple frames, get a count of them and the - animation delay, if available. */ -- (Lisp_Object)getMetadata +/* Find the first NSBitmapImageRep which has multiple frames. */ +- (NSBitmapImageRep *)getAnimatedBitmapImageRep { - Lisp_Object metadata = Qnil; - for (NSImageRep * r in [self representations]) { if ([r isKindOfClass:[NSBitmapImageRep class]]) { NSBitmapImageRep * bm = (NSBitmapImageRep *)r; - int frames = [[bm valueForProperty: NSImageFrameCount] intValue]; - float delay = [[bm valueForProperty: NSImageCurrentFrameDuration] - floatValue]; - - if (frames > 1) - metadata = Fcons (Qcount, Fcons (make_number (frames), metadata)); - if (delay > 0) - metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata)); - break; + if ([[bm valueForProperty:NSImageFrameCount] intValue] > 0) + return bm; } } + return nil; +} + +/* If the image has multiple frames, get a count of them and the + animation delay, if available. */ +- (Lisp_Object)getMetadata +{ + Lisp_Object metadata = Qnil; + + NSBitmapImageRep * bm = [self getAnimatedBitmapImageRep]; + + if (bm != nil) + { + int frames = [[bm valueForProperty:NSImageFrameCount] intValue]; + float delay = [[bm valueForProperty:NSImageCurrentFrameDuration] + floatValue]; + + if (frames > 1) + metadata = Fcons (Qcount, Fcons (make_number (frames), metadata)); + if (delay > 0) + metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata)); + } return metadata; } /* Attempt to set the animation frame to be displayed. */ - (BOOL)setFrame: (unsigned int) index { - for (NSImageRep * r in [self representations]) + NSBitmapImageRep * bm = [self getAnimatedBitmapImageRep]; + + if (bm != nil) { - if ([r isKindOfClass:[NSBitmapImageRep class]]) - { - NSBitmapImageRep * bm = (NSBitmapImageRep *)r; - if ([[bm valueForProperty: NSImageFrameCount] intValue] <= index) - continue; + int frames = [[bm valueForProperty:NSImageFrameCount] intValue]; - [bm setProperty: NSImageCurrentFrame - withValue: [NSNumber numberWithUnsignedInt: index]]; - return YES; - } + /* If index is invalid, give up. */ + if (index < 0 || index > frames) + return NO; + + [bm setProperty: NSImageCurrentFrame + withValue: [NSNumber numberWithUnsignedInt:index]]; } - return NO; + /* Setting the frame has succeeded, or the image doesn't have + multiple frames. */ + return YES; } @end commit 7baa50eca28ff21497b058fa22656bbb4a447d87 Author: Alan Third Date: Sun Aug 20 21:14:47 2017 +0100 Add ability to change macOS WM theme (bug#27973) * src/frame.c (make_frame, frame_parms, syms_of_frame) [NS_IMPL_COCOA]: Add ns-appearance and ns-transparent-titlebar options. * src/frame.h (ns_appearance_type) [NS_IMPL_COCOA]: Add enum to represent NSAppearance options. (struct frame) [NS_IMPL_COCOA]: Add ns_appearance and ns_transparent_titlebar frame parameters. * src/nsfns.m (ns_frame_parm_handlers) [NS_IMPL_COCOA]: Add ns_set_appearance and ns_set_transparent_titlebar handlers. (Sx_create_frame): Handle ns-appearance and ns-transparent-titlebar frame parameters. (Qdark): Add new symbol for use with ns-appearance. * src/nsterm.h (ns_set_appearance, ns_set_transparent_titlebar) [NS_IMPL_COCOA]: Add prototypes. * src/nsterm.m (ns_set_appearance, ns_set_transparent_titlebar) [NS_IMPL_COCOA]: New functions. (initFrameFromEmacs) [NS_IMPL_COCOA]: Handle ns-appearance and ns-transparent-titlebar frame parameters. * doc/lispref/frames.texi (Window Management Parameters): Document ns-apperance and ns-transparent-titlebar. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index b430f7c6fa..6431bbdedb 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -2125,6 +2125,20 @@ Specifying this lets you create an Emacs window inside some other application's window. (It is not certain this will be implemented; try it and see if it works.) @end ignore + +@vindex ns-appearance, a frame parameter +@item ns-appearance +Only available on macOS, if set to @code{dark} draw this frame's +window-system window using the ``vibrant dark'' theme, otherwise use +the system default. The ``vibrant dark'' theme can be used to set the +toolbar and scrollbars to a dark appearance when using an Emacs theme +with a dark background. + +@vindex ns-transparent-titlebar, a frame parameter +@item ns-transparent-titlebar +Only available on macOS, if non-@code{nil}, set the titlebar and +toolbar to be transparent. This effectively sets the background color +of both to match the Emacs background color. @end table diff --git a/src/frame.c b/src/frame.c index 1e5e4bbdb4..5099f75be4 100644 --- a/src/frame.c +++ b/src/frame.c @@ -834,6 +834,10 @@ make_frame (bool mini_p) #if ! defined (USE_GTK) && ! defined (HAVE_NS) f->last_tool_bar_item = -1; #endif +#ifdef NS_IMPL_COCOA + f->ns_appearance = ns_appearance_aqua; + f->ns_transparent_titlebar = false; +#endif #endif root_window = make_window (); @@ -3520,6 +3524,10 @@ static const struct frame_parm_table frame_parms[] = {"z-group", SYMBOL_INDEX (Qz_group)}, {"override-redirect", SYMBOL_INDEX (Qoverride_redirect)}, {"no-special-glyphs", SYMBOL_INDEX (Qno_special_glyphs)}, +#ifdef NS_IMPL_COCOA + {"ns-appearance", SYMBOL_INDEX (Qns_appearance)}, + {"ns-transparent-titlebar", SYMBOL_INDEX (Qns_transparent_titlebar)}, +#endif }; #ifdef HAVE_WINDOW_SYSTEM @@ -5646,6 +5654,10 @@ syms_of_frame (void) #ifdef HAVE_NS DEFSYM (Qns_parse_geometry, "ns-parse-geometry"); #endif +#ifdef NS_IMPL_COCOA + DEFSYM (Qns_appearance, "ns-appearance"); + DEFSYM (Qns_transparent_titlebar, "ns-transparent-titlebar"); +#endif DEFSYM (Qalpha, "alpha"); DEFSYM (Qauto_lower, "auto-lower"); diff --git a/src/frame.h b/src/frame.h index 154dc9a3bb..4b7e448b54 100644 --- a/src/frame.h +++ b/src/frame.h @@ -65,6 +65,14 @@ enum internal_border_part INTERNAL_BORDER_BOTTOM_EDGE, INTERNAL_BORDER_BOTTOM_LEFT_CORNER, }; + +#ifdef NS_IMPL_COCOA +enum ns_appearance_type + { + ns_appearance_aqua, + ns_appearance_vibrant_dark + }; +#endif #endif /* HAVE_WINDOW_SYSTEM */ /* The structure representing a frame. */ @@ -563,6 +571,12 @@ struct frame /* All display backends seem to need these two pixel values. */ unsigned long background_pixel; unsigned long foreground_pixel; + +#ifdef NS_IMPL_COCOA + /* NSAppearance theme used on this frame. */ + enum ns_appearance_type ns_appearance; + bool_bf ns_transparent_titlebar; +#endif }; /* Most code should use these functions to set Lisp fields in struct frame. */ @@ -953,6 +967,10 @@ default_pixels_per_inch_y (void) #define FRAME_Z_GROUP_ABOVE_SUSPENDED(f) \ ((f)->z_group == z_group_above_suspended) #define FRAME_Z_GROUP_BELOW(f) ((f)->z_group == z_group_below) +#ifdef NS_IMPL_COCOA +#define FRAME_NS_APPEARANCE(f) ((f)->ns_appearance) +#define FRAME_NS_TRANSPARENT_TITLEBAR(f) ((f)->ns_transparent_titlebar) +#endif #else /* not HAVE_WINDOW_SYSTEM */ #define FRAME_UNDECORATED(f) ((void) (f), 0) #define FRAME_OVERRIDE_REDIRECT(f) ((void) (f), 0) diff --git a/src/nsfns.m b/src/nsfns.m index e19e4e2641..b00441eb79 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -985,6 +985,10 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side x_set_z_group, /* x_set_z_group */ 0, /* x_set_override_redirect */ x_set_no_special_glyphs, +#ifdef NS_IMPL_COCOA + ns_set_appearance, + ns_set_transparent_titlebar, +#endif }; @@ -1277,6 +1281,18 @@ Turn the input menu (an NSMenu) into a lisp list for tracking on lisp side FRAME_UNDECORATED (f) = !NILP (tem) && !EQ (tem, Qunbound); store_frame_param (f, Qundecorated, FRAME_UNDECORATED (f) ? Qt : Qnil); +#ifdef NS_IMPL_COCOA + tem = x_get_arg (dpyinfo, parms, Qns_appearance, NULL, NULL, RES_TYPE_SYMBOL); + FRAME_NS_APPEARANCE (f) = EQ (tem, Qdark) + ? ns_appearance_vibrant_dark : ns_appearance_aqua; + store_frame_param (f, Qns_appearance, tem); + + tem = x_get_arg (dpyinfo, parms, Qns_transparent_titlebar, + NULL, NULL, RES_TYPE_BOOLEAN); + FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (tem) && !EQ (tem, Qunbound); + store_frame_param (f, Qns_transparent_titlebar, tem); +#endif + parent_frame = x_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, RES_TYPE_SYMBOL); /* Accept parent-frame iff parent-id was not specified. */ @@ -3248,6 +3264,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename DEFSYM (Qfontsize, "fontsize"); DEFSYM (Qframe_title_format, "frame-title-format"); DEFSYM (Qicon_title_format, "icon-title-format"); + DEFSYM (Qdark, "dark"); DEFVAR_LISP ("ns-icon-type-alist", Vns_icon_type_alist, doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. diff --git a/src/nsterm.h b/src/nsterm.h index 0ac8043e26..65b7a0347a 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -1210,6 +1210,13 @@ extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); extern void x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value); +#ifdef NS_IMPL_COCOA +extern void ns_set_appearance (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value); +extern void ns_set_transparent_titlebar (struct frame *f, + Lisp_Object new_value, + Lisp_Object old_value); +#endif extern int ns_select (int nfds, fd_set *readfds, fd_set *writefds, fd_set *exceptfds, struct timespec *timeout, sigset_t *sigmask); diff --git a/src/nsterm.m b/src/nsterm.m index 95092b29c8..22f8efd6b9 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -2036,6 +2036,58 @@ so some key presses (TAB) are swallowed by the system. */ error ("Invalid z-group specification"); } +#ifdef NS_IMPL_COCOA +void +ns_set_appearance (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) +{ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; + + NSTRACE ("ns_set_appearance"); + +#ifndef NSAppKitVersionNumber10_9 +#define NSAppKitVersionNumber10_9 1265 +#endif + + if (NSAppKitVersionNumber < NSAppKitVersionNumber10_9) + return; + + if (EQ (new_value, Qdark)) + { + window.appearance = [NSAppearance + appearanceNamed: NSAppearanceNameVibrantDark]; + FRAME_NS_APPEARANCE (f) = ns_appearance_vibrant_dark; + } + else + { + window.appearance = [NSAppearance + appearanceNamed: NSAppearanceNameAqua]; + FRAME_NS_APPEARANCE (f) = ns_appearance_aqua; + } +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */ +} + +void +ns_set_transparent_titlebar (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 + EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; + + NSTRACE ("ns_set_transparent_titlebar"); + + if ([window respondsToSelector: @selector(titlebarAppearsTransparent)] + && !EQ (new_value, old_value)) + { + window.titlebarAppearsTransparent = !NILP (new_value); + FRAME_NS_TRANSPARENT_TITLEBAR (f) = !NILP (new_value); + } +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 */ +} +#endif /* NS_IMPL_COCOA */ + static void ns_fullscreen_hook (struct frame *f) { @@ -7083,6 +7135,22 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f if (! FRAME_UNDECORATED (f)) [self createToolbar: f]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 +#ifndef NSAppKitVersionNumber10_9 +#define NSAppKitVersionNumber10_9 1265 +#endif + + if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_9 + && FRAME_NS_APPEARANCE (f) != ns_appearance_aqua) + win.appearance = [NSAppearance + appearanceNamed: NSAppearanceNameVibrantDark]; +#endif + +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 101000 + if ([win respondsToSelector: @selector(titlebarAppearsTransparent)]) + win.titlebarAppearsTransparent = FRAME_NS_TRANSPARENT_TITLEBAR (f); +#endif + tem = f->icon_name; if (!NILP (tem)) [win setMiniwindowTitle: commit 4309d1574ae86244751600171b605b2b2eca4697 Author: Alan Mackenzie Date: Tue Aug 22 17:04:34 2017 +0000 When looking for the end of a declarator, prevent macros fouling up the search The practical implication of this bug was a random jit-lock chunk remaining entirely unfontified. * lisp/progmodes/cc-mode (c-fl-decl-end): If point starts inside a macro, restrict two forward searches to the end of that macro. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 0bf89b9a36..48a6619bd1 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1549,10 +1549,13 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (c-backward-syntactic-ws) (when (setq pos1 (c-on-identifier)) (goto-char pos1) - (when (and (c-forward-declarator) - (eq (c-forward-token-2) 0)) - (c-backward-syntactic-ws) - (point))))) + (let ((lim (save-excursion + (and (c-beginning-of-macro) + (progn (c-end-of-macro) (point)))))) + (when (and (c-forward-declarator lim) + (eq (c-forward-token-2 1 nil lim) 0)) + (c-backward-syntactic-ws) + (point)))))) (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock commit ee5a146e331c0bc73c46d608450399e5b90e6321 Author: Eli Zaretskii Date: Tue Aug 22 19:52:47 2017 +0300 ; * src/w32.c: Fix a typo in a comment. diff --git a/src/w32.c b/src/w32.c index 1b1f8d8480..a4be017d8e 100644 --- a/src/w32.c +++ b/src/w32.c @@ -1498,7 +1498,7 @@ w32_valid_pointer_p (void *p, int size) . Turning on w32-unicode-filename on Windows 9X (if it at all works) requires UNICOWS.DLL, which is thus a requirement even in - non-GUI sessions, something the we previously avoided. */ + non-GUI sessions, something that we previously avoided. */ commit 336707efb3d173c396ac522490ef2b1b6664eebf Author: Michael Albinus Date: Tue Aug 22 16:22:33 2017 +0200 Test `file-expand-wildcards' for Tramp * lisp/net/tramp-compat.el (tramp-advice-file-expand-wildcards): Remove, not needed anymore. * test/lisp/net/tramp-tests.el (top): Require seq.el. (tramp-test16-directory-files): Simplify. (tramp-test16-file-expand-wildcards): New test. (tramp-test28-interrupt-process): Skip for older Emacsen. diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index b2df4d6324..9a50d62448 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -50,33 +50,6 @@ `(when (functionp ,function) (with-no-warnings (funcall ,function ,@arguments)))) -;; We currently use "[" and "]" in the filename format for IPv6 hosts -;; of GNU Emacs. This means that Emacs wants to expand wildcards if -;; `find-file-wildcards' is non-nil, and then barfs because no -;; expansion could be found. We detect this situation and do -;; something really awful: we have `file-expand-wildcards' return the -;; original filename if it can't expand anything. Let's just hope -;; that this doesn't break anything else. It is not needed anymore -;; since GNU Emacs 23.2. -(unless (featurep 'files 'remote-wildcards) - (defadvice file-expand-wildcards - (around tramp-advice-file-expand-wildcards activate) - (let ((name (ad-get-arg 0))) - ;; If it's a Tramp file, look if wildcards need to be expanded - ;; at all. - (if (and - (tramp-tramp-file-p name) - (not (string-match "[[*?]" (file-remote-p name 'localname)))) - (setq ad-return-value (list name)) - ;; Otherwise, just run the original function. - ad-do-it))) - (add-hook - 'tramp-unload-hook - (lambda () - (ad-remove-advice - 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) - (ad-activate 'file-expand-wildcards)))) - (defsubst tramp-compat-temporary-file-directory () "Return name of directory for temporary files. It is the default value of `temporary-file-directory'." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 129bc1d65d..85ed646722 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -39,6 +39,7 @@ (require 'dired) (require 'ert) +(require 'seq) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -2145,8 +2146,7 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (skip-unless (tramp--test-enabled)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let* ((tmp-name1 - (expand-file-name (tramp--test-make-temp-name nil quoted))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) (tmp-name2 (expand-file-name "bla" tmp-name1)) (tmp-name3 (expand-file-name "foo" tmp-name1))) (unwind-protect @@ -2172,6 +2172,58 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) +;; This is not a file name handler test. But Tramp needed to apply an +;; advice for older Emacs versions, so we check that this has been fixed. +(ert-deftest tramp-test16-file-expand-wildcards () + "Check `file-expand-wildcards'." + (skip-unless (tramp--test-enabled)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 (tramp--test-make-temp-name nil quoted)) + (tmp-name2 (expand-file-name "foo" tmp-name1)) + (tmp-name3 (expand-file-name "bar" tmp-name1)) + (tmp-name4 (expand-file-name "baz" tmp-name1)) + (default-directory tmp-name1)) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name2) + (write-region "bar" nil tmp-name3) + (write-region "baz" nil tmp-name4) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name2)) + (should (file-exists-p tmp-name3)) + (should (file-exists-p tmp-name4)) + + ;; We cannot use `sort', it works destructive. + (should (equal (file-expand-wildcards "*") + (seq-sort 'string< '("foo" "bar" "baz")))) + (should (equal (file-expand-wildcards "ba?") + (seq-sort 'string< '("bar" "baz")))) + (should (equal (file-expand-wildcards "ba[rz]") + (seq-sort 'string< '("bar" "baz")))) + + (should (equal (file-expand-wildcards "*" 'full) + (seq-sort + 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) + (should (equal (file-expand-wildcards "ba?" 'full) + (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) + (should (equal (file-expand-wildcards "ba[rz]" 'full) + (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) + + (should (equal (file-expand-wildcards (concat tmp-name1 "/" "*")) + (seq-sort + 'string< `(,tmp-name2 ,tmp-name3 ,tmp-name4)))) + (should (equal (file-expand-wildcards (concat tmp-name1 "/" "ba?")) + (seq-sort 'string< `(,tmp-name3 ,tmp-name4)))) + (should (equal (file-expand-wildcards + (concat tmp-name1 "/" "ba[rz]")) + (seq-sort 'string< `(,tmp-name3 ,tmp-name4))))) + + ;; Cleanup. + (ignore-errors + (delete-directory tmp-name1)))))) + (ert-deftest tramp-test17-insert-directory () "Check `insert-directory'." (skip-unless (tramp--test-enabled)) @@ -2905,6 +2957,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + ;; Since Emacs 26.1. + (skip-unless (boundp 'interrupt-process-functions)) (let ((default-directory tramp-test-temporary-file-directory) kill-buffer-query-functions proc) commit ee9392a699a5b674388e650c61405cbe3b94e852 Author: Alexander Gramiak Date: Fri Aug 11 17:53:27 2017 -0600 Add tests for cl-macs.el (Bug#27559) * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-test-loop): Remove duplicate. (cl-loop-destructuring-with): Move to cl-macs-tests.el. * test/lisp/emacs-lisp/cl-macs-tests.el: New file. diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 9e68dceb8f..7763d062a0 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -1,4 +1,4 @@ -;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*- +;;; cl-lib-tests.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*- ;; Copyright (C) 2013-2017 Free Software Foundation, Inc. @@ -195,9 +195,6 @@ (should (eql (cl-mismatch "Aa" "aA") 0)) (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) -(ert-deftest cl-lib-test-loop () - (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) - (ert-deftest cl-lib-keyword-names-versus-values () (should (equal (funcall (cl-function (lambda (&key a b) (list a b))) @@ -480,9 +477,6 @@ (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) (should (= -123 (cl-parse-integer " -123 ")))) -(ert-deftest cl-loop-destructuring-with () - (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) - (ert-deftest cl-flet-test () (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) @@ -556,4 +550,4 @@ (should cl-old-struct-compat-mode) (cl-old-struct-compat-mode (if saved 1 -1)))) -;;; cl-lib.el ends here +;;; cl-lib-tests.el ends here diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el new file mode 100644 index 0000000000..16cb4fb40c --- /dev/null +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -0,0 +1,500 @@ +;;; cl-macs-tests.el --- tests for emacs-lisp/cl-macs.el -*- lexical-binding:t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program 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. +;; +;; This program 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 this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;;; Code: + +(require 'cl-lib) +(require 'cl-macs) +(require 'ert) + + +;;;; cl-loop tests -- many adapted from Steele's CLtL2 + +;;; ANSI 6.1.1.7 Destructuring +(ert-deftest cl-macs-loop-and-assignment () + ;; Bug#6583 + :expected-result :failed + (should (equal (cl-loop for numlist in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + for a = (cl-first numlist) + and b = (cl-second numlist) + and c = (cl-third numlist) + collect (list c b a)) + '((4.0 2 1) (8.3 6 5) (10.4 9 8))))) + +(ert-deftest cl-macs-loop-destructure () + (should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4)) + collect (list c b a)) + '((4.0 2 1) (8.3 6 5) (10.4 9 8))))) + +(ert-deftest cl-macs-loop-destructure-nil () + (should (equal (cl-loop for (a nil b) = '(1 2 3) + do (cl-return (list a b))) + '(1 3)))) + +(ert-deftest cl-macs-loop-destructure-cons () + (should (equal (cl-loop for ((a . b) (c . d)) in + '(((1.2 . 2.4) (3 . 4)) ((3.4 . 4.6) (5 . 6))) + collect (list a b c d)) + '((1.2 2.4 3 4) (3.4 4.6 5 6))))) + +(ert-deftest cl-loop-destructuring-with () + (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) + +;;; 6.1.2.1.1 The for-as-arithmetic subclause +(ert-deftest cl-macs-loop-for-as-arith () + "Test various for-as-arithmetic subclauses." + :expected-result :failed + (should (equal (cl-loop for i to 10 by 3 collect i) + '(0 3 6 9))) + (should (equal (cl-loop for i upto 3 collect i) + '(0 1 2 3))) + (should (equal (cl-loop for i below 3 collect i) + '(0 1 2))) + (should (equal (cl-loop for i below 10 by 2 collect i) + '(0 2 4 6 8))) + (should (equal (cl-loop for i downfrom 10 above 4 by 2 collect i) + '(10 8 6))) + (should (equal (cl-loop for i from 10 downto 1 by 3 collect i) + '(10 7 4 1))) + (should (equal (cl-loop for i above 0 by 2 downfrom 10 collect i) + '(10 8 6 4 2))) + (should (equal (cl-loop for i downto 10 from 15 collect i) + '(15 14 13 12 11 10)))) + +(ert-deftest cl-macs-loop-for-as-arith-order-side-effects () + "Test side effects generated by different arithmetic phrase order." + :expected-result :failed + (should + (equal (let ((x 1)) (cl-loop for i from x to 10 by (cl-incf x) collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i from x by (cl-incf x) to 10 collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i to 10 from x by (cl-incf x) collect i)) + '(1 3 5 7 9))) + (should + (equal (let ((x 1)) (cl-loop for i to 10 by (cl-incf x) from x collect i)) + '(2 4 6 8 10))) + (should + (equal (let ((x 1)) (cl-loop for i by (cl-incf x) from x to 10 collect i)) + '(2 4 6 8 10))) + (should + (equal (let ((x 1)) (cl-loop for i by (cl-incf x) to 10 from x collect i)) + '(2 4 6 8 10)))) + +(ert-deftest cl-macs-loop-for-as-arith-invalid () + "Test for invalid phrase combinations." + :expected-result :failed + ;; Mixing arithmetic-up and arithmetic-down* subclauses + (should-error (cl-loop for i downfrom 10 below 20 collect i)) + (should-error (cl-loop for i upfrom 20 above 10 collect i)) + (should-error (cl-loop for i upto 10 by 2 downfrom 5)) + ;; Repeated phrases + (should-error (cl-loop for i from 10 to 20 above 10)) + (should-error (cl-loop for i from 10 to 20 upfrom 0)) + (should-error (cl-loop for i by 2 to 10 by 5)) + ;; negative step + (should-error (cl-loop for i by -1)) + ;; no step given for a downward loop + (should-error (cl-loop for i downto -5 collect i))) + + +;;; 6.1.2.1.2 The for-as-in-list subclause +(ert-deftest cl-macs-loop-for-as-in-list () + (should (equal (cl-loop for x in '(1 2 3 4 5 6) collect (* x x)) + '(1 4 9 16 25 36))) + (should (equal (cl-loop for x in '(1 2 3 4 5 6) by #'cddr collect (* x x)) + '(1 9 25)))) + +;;; 6.1.2.1.3 The for-as-on-list subclause +(ert-deftest cl-macs-loop-for-as-on-list () + (should (equal (cl-loop for x on '(1 2 3 4) collect x) + '((1 2 3 4) (2 3 4) (3 4) (4)))) + (should (equal (cl-loop as (item) on '(1 2 3 4) by #'cddr collect item) + '(1 3)))) + +;;; 6.1.2.1.4 The for-as-equals-then subclause +(ert-deftest cl-macs-loop-for-as-equals-then () + (should (equal (cl-loop for item = 1 then (+ item 10) + repeat 5 + collect item) + '(1 11 21 31 41))) + (should (equal (cl-loop for x below 5 for y = nil then x collect (list x y)) + '((0 nil) (1 1) (2 2) (3 3) (4 4)))) + (should (equal (cl-loop for x below 5 and y = nil then x collect (list x y)) + '((0 nil) (1 0) (2 1) (3 2) (4 3)))) + (should (equal (cl-loop for x below 3 for y = (+ 10 x) nconc (list x y)) + '(0 10 1 11 2 12))) + (should (equal (cl-loop with start = 5 + for x = start then (cl-incf start) + repeat 5 + collect x) + '(5 6 7 8 9)))) + +;;; 6.1.2.1.5 The for-as-across subclause +(ert-deftest cl-macs-loop-for-as-across () + (should (string= (cl-loop for x across "aeiou" + concat (char-to-string x)) + "aeiou")) + (should (equal (cl-loop for v across (vector 1 2 3) vconcat (vector v (+ 10 v))) + [1 11 2 12 3 13]))) + +;;; 6.1.2.1.6 The for-as-hash subclause +(ert-deftest cl-macs-loop-for-as-hash () + ;; example in Emacs manual 4.7.3 + (should (equal (let ((hash (make-hash-table))) + (setf (gethash 1 hash) 10) + (setf (gethash "test" hash) "string") + (setf (gethash 'test hash) 'value) + (cl-loop for k being the hash-keys of hash + using (hash-values v) + collect (list k v))) + '((1 10) ("test" "string") (test value))))) + +;;; 6.1.2.2 Local Variable Initializations +(ert-deftest cl-macs-loop-with () + (should (equal (cl-loop with a = 1 + with b = (+ a 2) + with c = (+ b 3) + return (list a b c)) + '(1 3 6))) + (should (equal (let ((a 5) + (b 10)) + (cl-loop with a = 1 + and b = (+ a 2) + and c = (+ b 3) + return (list a b c))) + '(1 7 13))) + (should (and (equal (cl-loop for i below 3 with loop-with + do (push (* i i) loop-with) + finally (cl-return loop-with)) + '(4 1 0)) + (not (boundp 'loop-with))))) + +;;; 6.1.3 Value Accumulation Clauses +(ert-deftest cl-macs-loop-accum () + (should (equal (cl-loop for name in '(fred sue alice joe june) + for kids in '((bob ken) () () (kris sunshine) ()) + collect name + append kids) + '(fred bob ken sue alice joe kris sunshine june)))) + +(ert-deftest cl-macs-loop-collect () + (should (equal (cl-loop for i in '(bird 3 4 turtle (1 . 4) horse cat) + when (symbolp i) collect i) + '(bird turtle horse cat))) + (should (equal (cl-loop for i from 1 to 10 + if (cl-oddp i) collect i) + '(1 3 5 7 9))) + (should (equal (cl-loop for i in '(a b c d e f g) by #'cddr + collect i into my-list + finally return (nbutlast my-list)) + '(a c e)))) + +(ert-deftest cl-macs-loop-append/nconc () + (should (equal (cl-loop for x in '((a) (b) ((c))) + append x) + '(a b (c)))) + (should (equal (cl-loop for i upfrom 0 + as x in '(a b (c)) + nconc (if (cl-evenp i) (list x) nil)) + '(a (c))))) + +(ert-deftest cl-macs-loop-count () + (should (eql (cl-loop for i in '(a b nil c nil d e) + count i) + 5))) + +(ert-deftest cl-macs-loop-max/min () + (should (eql (cl-loop for i in '(2 1 5 3 4) + maximize i) + 5)) + (should (eql (cl-loop for i in '(2 1 5 3 4) + minimize i) + 1)) + (should (equal (cl-loop with series = '(4.3 1.2 5.7) + for v in series + minimize (round v) into min-result + maximize (round v) into max-result + collect (list min-result max-result)) + '((4 4) (1 4) (1 6))))) + +(ert-deftest cl-macs-loop-sum () + (should (eql (cl-loop for i in '(1 2 3 4 5) + sum i) + 15)) + (should (eql (cl-loop with series = '(1.2 4.3 5.7) + for v in series + sum (* 2.0 v)) + 22.4))) + +;;; 6.1.4 Termination Test Clauses +(ert-deftest cl-macs-loop-repeat () + (should (equal (cl-loop with n = 4 + repeat (1+ n) + collect n) + '(4 4 4 4 4))) + (should (equal (cl-loop for i upto 5 + repeat 3 + collect i) + '(0 1 2)))) + +(ert-deftest cl-macs-loop-always () + (should (cl-loop for i from 0 to 10 + always (< i 11))) + (should-not (cl-loop for i from 0 to 10 + always (< i 9) + finally (cl-return "you won't see this")))) + +(ert-deftest cl-macs-loop-never () + (should (cl-loop for i from 0 to 10 + never (> i 11))) + (should-not (cl-loop never t + finally (cl-return "you won't see this")))) + +(ert-deftest cl-macs-loop-thereis () + (should (eql (cl-loop for i from 0 + thereis (when (> i 10) i)) + 11)) + (should (string= (cl-loop thereis "Here is my value" + finally (cl-return "you won't see this")) + "Here is my value")) + (should (cl-loop for i to 10 + thereis (> i 11) + finally (cl-return i)))) + +(ert-deftest cl-macs-loop-anon-collection-conditional () + "Always/never/thereis should error when used with an anonymous +collection clause." + :expected-result :failed + (should-error (cl-loop always nil collect t)) + (should-error (cl-loop never t nconc t)) + (should-error (cl-loop thereis t append t))) + +(ert-deftest cl-macs-loop-while () + (should (equal (let ((stack '(a b c d e f))) + (cl-loop while stack + for item = (length stack) then (pop stack) + collect item)) + '(6 a b c d e f)))) + +(ert-deftest cl-macs-loop-until () + (should (equal (cl-loop for i to 100 + collect 10 + until (= i 3) + collect i) + '(10 0 10 1 10 2 10)))) + +;;; 6.1.5 Unconditional Execution Clauses +(ert-deftest cl-macs-loop-do () + (should (equal (cl-loop with list + for i from 1 to 3 + do + (push 10 list) + (push i list) + finally (cl-return list)) + '(3 10 2 10 1 10))) + (should (equal (cl-loop with res = 0 + for i from 1 to 10 + doing (cl-incf res i) + finally (cl-return res)) + 55)) + (should (equal (cl-loop for i from 10 + do (when (= i 15) + (cl-return i)) + finally (cl-return 0)) + 15))) + +;;; 6.1.6 Conditional Execution Clauses +(ert-deftest cl-macs-loop-when () + (should (equal (cl-loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + collect it) + '(4 5 6))) + (should (eql (cl-loop for i in '(1 2 3 4 5 6) + when (and (> i 3) i) + return it) + 4)) + + (should (equal (cl-loop for elt in '(1 a 2 "a" (3 4) 5 6) + when (numberp elt) + when (cl-evenp elt) collect elt into even + else collect elt into odd + else + when (symbolp elt) collect elt into syms + else collect elt into other + finally return (list even odd syms other)) + '((2 6) (1 5) (a) ("a" (3 4)))))) + +(ert-deftest cl-macs-loop-if () + (should (equal (cl-loop for i to 5 + if (cl-evenp i) + collect i + and when (and (= i 2) 'two) + collect it + and if (< i 3) + collect "low") + '(0 2 two "low" 4))) + (should (equal (cl-loop for i to 5 + if (cl-evenp i) + collect i + and when (and (= i 2) 'two) + collect it + end + and if (< i 3) + collect "low") + '(0 "low" 2 two "low" 4))) + (should (equal (cl-loop with funny-numbers = '(6 13 -1) + for x below 10 + if (cl-evenp x) + collect x into evens + else + collect x into odds + and if (memq x funny-numbers) return (cdr it) + finally return (vector odds evens)) + [(1 3 5 7 9) (0 2 4 6 8)]))) + +(ert-deftest cl-macs-loop-unless () + (should (equal (cl-loop for i to 5 + unless (= i 3) + collect i + else + collect 'three) + '(0 1 2 three 4 5)))) + + +;;; 6.1.7.1 Control Transfer Clauses +(ert-deftest cl-macs-loop-named () + (should (eql (cl-loop named finished + for i to 10 + when (> (* i i) 30) + do (cl-return-from finished i)) + 6))) + +;;; 6.1.7.2 Initial and Final Execution +(ert-deftest cl-macs-loop-initially () + (should (equal (let ((var (list 1 2 3 4 5))) + (cl-loop for i in var + collect i + initially + (setf (car var) 10) + (setf (cadr var) 20))) + '(10 20 3 4 5)))) + +(ert-deftest cl-macs-loop-finally () + (should (eql (cl-loop for i from 10 + finally + (cl-incf i 10) + (cl-return i) + while (< i 20)) + 30))) + +;;; Emacs extensions to loop +(ert-deftest cl-macs-loop-in-ref () + (should (equal (cl-loop with my-list = (list 1 2 3 4 5) + for x in-ref my-list + do (cl-incf x) + finally return my-list) + '(2 3 4 5 6)))) + +(ert-deftest cl-macs-loop-across-ref () + (should (equal (cl-loop with my-vec = ["one" "two" "three"] + for x across-ref my-vec + do (setf (aref x 0) (upcase (aref x 0))) + finally return my-vec) + ["One" "Two" "Three"]))) + +(ert-deftest cl-macs-loop-being-elements () + (should (equal (let ((var "StRiNG")) + (cl-loop for x being the elements of var + collect (downcase x))) + (string-to-list "string")))) + +(ert-deftest cl-macs-loop-being-elements-of-ref () + (should (equal (let ((var (list 1 2 3 4 5))) + (cl-loop for x being the elements of-ref var + do (cl-incf x) + finally return var)) + '(2 3 4 5 6)))) + +(ert-deftest cl-macs-loop-being-symbols () + (should (eq (cl-loop for sym being the symbols + when (eq sym 'cl-loop) + return 'cl-loop) + 'cl-loop))) + +(ert-deftest cl-macs-loop-being-keymap () + (should (equal (let ((map (make-sparse-keymap)) + (parent (make-sparse-keymap)) + res) + (define-key map "f" #'forward-char) + (define-key map "b" #'backward-char) + (define-key parent "n" #'next-line) + (define-key parent "p" #'previous-line) + (set-keymap-parent map parent) + (cl-loop for b being the key-bindings of map + using (key-codes c) + do (push (list c b) res)) + (cl-loop for s being the key-seqs of map + using (key-bindings b) + do (push (list (cl-copy-seq s) b) res)) + res) + '(([?n] next-line) ([?p] previous-line) + ([?f] forward-char) ([?b] backward-char) + (?n next-line) (?p previous-line) + (?f forward-char) (?b backward-char))))) + +(ert-deftest cl-macs-loop-being-overlays () + (should (equal (let ((ov (make-overlay (point) (point)))) + (overlay-put ov 'prop "test") + (cl-loop for o being the overlays + when (eq o ov) + return (overlay-get o 'prop))) + "test"))) + +(ert-deftest cl-macs-loop-being-frames () + (should (eq (cl-loop with selected = (selected-frame) + for frame being the frames + when (eq frame selected) + return frame) + (selected-frame)))) + +(ert-deftest cl-macs-loop-being-windows () + (should (eq (cl-loop with selected = (selected-window) + for window being the windows + when (eq window selected) + return window) + (selected-window)))) + +(ert-deftest cl-macs-loop-being-buffers () + (should (eq (cl-loop with current = (current-buffer) + for buffer being the buffers + when (eq buffer current) + return buffer) + (current-buffer)))) + +(ert-deftest cl-macs-loop-vconcat () + (should (equal (cl-loop for x in (list 1 2 3 4 5) + vconcat (vector (1+ x))) + [2 3 4 5 6]))) + +;;; cl-macs-tests.el ends here commit 9d7973530f912c6001445ba9b83b7893b466aee8 Author: Noam Postavsky Date: Sat Jul 1 22:39:16 2017 -0400 Optimize skkdic conversion (Bug#28043) The primary speedup comes from the optimizing lookup-nested-alist and set-nested-alist for the case where the key is a string. This brings the time down to less than half the original. * lisp/international/mule-util.el (lookup-nested-alist) (set-nested-alist): Use `assq' instead of `assoc' when KEYSEQ is a string. * lisp/international/ja-dic-cnv.el (skkdic-collect-okuri-nasi) (skkdic-convert-okuri-nasi): Use progress-reporter functions instead of calculating ratio of work done inline. (skkdic-reduced-candidates): Call `char-category-set' on the first character of the string directly, instead of using a regexp for the character category. (skkdic--japanese-category-set): New constant. (skkdic-collect-okuri-nasi): Just set `skkdic-okuri-nasi-entries-count' at once at the end rather than updating it throughout the loop. (skkdic-convert-postfix skkdic-convert-prefix) skkdic-get-candidate-list, skkdic-collect-okuri-nasi) (skkdic-extract-conversion-data): Use `match-string-no-properties' instead of `match-string'. diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index e80b1b2881..63eede093d 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el @@ -125,10 +125,10 @@ ;; Search postfix entries. (while (re-search-forward "^[#<>?]\\(\\(\\cH\\|$B!<(B\\)+\\) " nil t) - (let ((kana (match-string 1)) + (let ((kana (match-string-no-properties 1)) str candidates) (while (looking-at "/[#0-9 ]*\\([^/\n]*\\)/") - (setq str (match-string 1)) + (setq str (match-string-no-properties 1)) (if (not (member str candidates)) (setq candidates (cons str candidates))) (goto-char (match-end 1))) @@ -158,10 +158,10 @@ "(skkdic-set-prefix\n")) (save-excursion (while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\)[<>?] " nil t) - (let ((kana (match-string 1)) + (let ((kana (match-string-no-properties 1)) str candidates) (while (looking-at "/\\([^/\n]+\\)/") - (setq str (match-string 1)) + (setq str (match-string-no-properties 1)) (if (not (member str candidates)) (setq candidates (cons str candidates))) (goto-char (match-end 1))) @@ -180,8 +180,8 @@ (let (candidates) (goto-char from) (while (re-search-forward "/[^/ \n]+" to t) - (setq candidates (cons (buffer-substring (1+ (match-beginning 0)) - (match-end 0)) + (setq candidates (cons (buffer-substring-no-properties + (1+ (match-beginning 0)) (match-end 0)) candidates))) candidates)) @@ -251,12 +251,16 @@ ;; Return list of candidates which excludes some from CANDIDATES. ;; Excluded candidates can be derived from another entry. +(defconst skkdic--japanese-category-set (make-category-set "j")) + (defun skkdic-reduced-candidates (skkbuf kana candidates) (let (elt l) (while candidates (setq elt (car candidates)) (if (or (= (length elt) 1) - (and (string-match "^\\cj" elt) + (and (bool-vector-subsetp + skkdic--japanese-category-set + (char-category-set (aref elt 0))) (not (skkdic-breakup-string skkbuf kana elt 0 (length elt) 'first)))) (setq l (cons elt l))) @@ -267,24 +271,18 @@ (defvar skkdic-okuri-nasi-entries-count 0) (defun skkdic-collect-okuri-nasi () - (message "Collecting OKURI-NASI entries ...") (save-excursion - (let ((prev-ratio 0) - ratio) + (let ((progress (make-progress-reporter "Collecting OKURI-NASI entries" + (point) (point-max) + nil 10))) (while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\) \\(/\\cj.*\\)/$" nil t) - (let ((kana (match-string 1)) + (let ((kana (match-string-no-properties 1)) (candidates (skkdic-get-candidate-list (match-beginning 3) (match-end 3)))) (setq skkdic-okuri-nasi-entries - (cons (cons kana candidates) skkdic-okuri-nasi-entries) - skkdic-okuri-nasi-entries-count - (1+ skkdic-okuri-nasi-entries-count)) - (setq ratio (floor (* (point) 100.0) (point-max))) - (if (/= (/ prev-ratio 10) (/ ratio 10)) - (progn - (message "collected %2d%% ..." ratio) - (setq prev-ratio ratio))) + (cons (cons kana candidates) skkdic-okuri-nasi-entries)) + (progress-reporter-update progress (point)) (while candidates (let ((entry (lookup-nested-alist (car candidates) skkdic-word-list nil nil t))) @@ -292,26 +290,24 @@ (setcar entry (cons kana (car entry))) (set-nested-alist (car candidates) (list kana) skkdic-word-list))) - (setq candidates (cdr candidates)))))))) + (setq candidates (cdr candidates))))) + (setq skkdic-okuri-nasi-entries-count (length skkdic-okuri-nasi-entries)) + (progress-reporter-done progress)))) (defun skkdic-convert-okuri-nasi (skkbuf buf) - (message "Processing OKURI-NASI entries ...") (with-current-buffer buf (insert ";; Setting okuri-nasi entries.\n" "(skkdic-set-okuri-nasi\n") (let ((l (nreverse skkdic-okuri-nasi-entries)) - (count 0) - (prev-ratio 0) - ratio) + (progress (make-progress-reporter "Processing OKURI-NASI entries" + 0 skkdic-okuri-nasi-entries-count + nil 10)) + (count 0)) (while l (let ((kana (car (car l))) (candidates (cdr (car l)))) - (setq ratio (floor (* count 100.0) skkdic-okuri-nasi-entries-count) - count (1+ count)) - (if (/= (/ prev-ratio 10) (/ ratio 10)) - (progn - (message "processed %2d%% ..." ratio) - (setq prev-ratio ratio))) + (setq count (1+ count)) + (progress-reporter-update progress count) (if (setq candidates (skkdic-reduced-candidates skkbuf kana candidates)) (progn @@ -320,7 +316,8 @@ (insert " " (car candidates)) (setq candidates (cdr candidates))) (insert "\"\n")))) - (setq l (cdr l)))) + (setq l (cdr l))) + (progress-reporter-done progress)) (insert ")\n\n"))) (defun skkdic-convert (filename &optional dirname) @@ -467,7 +464,7 @@ To get complete usage, invoke: (i (match-end 0)) candidates) (while (string-match "[^ ]+" entry i) - (setq candidates (cons (match-string 0 entry) candidates)) + (setq candidates (cons (match-string-no-properties 0 entry) candidates)) (setq i (match-end 0))) (cons (skkdic-get-kana-compact-codes kana) candidates))) diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index e34b01c306..257f8854c3 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -143,20 +143,43 @@ longer than KEYSEQ. See the documentation of `nested-alist-p' for more detail." (or (nested-alist-p alist) (error "Invalid argument %s" alist)) - (let ((islist (listp keyseq)) - (len (or len (length keyseq))) - (i 0) - key-elt slot) - (while (< i len) - (if (null (nested-alist-p alist)) - (error "Keyseq %s is too long for this nested alist" keyseq)) - (setq key-elt (if islist (nth i keyseq) (aref keyseq i))) - (setq slot (assoc key-elt (cdr alist))) - (unless slot - (setq slot (cons key-elt (list t))) - (setcdr alist (cons slot (cdr alist)))) - (setq alist (cdr slot)) - (setq i (1+ i))) + (let ((len (or len (length keyseq))) + (i 0)) + (cond + ((stringp keyseq) ; We can use `assq' for characters. + (while (< i len) + (if (null (nested-alist-p alist)) + (error "Keyseq %s is too long for this nested alist" keyseq)) + (let* ((key-elt (aref keyseq i)) + (slot (assq key-elt (cdr alist)))) + (unless slot + (setq slot (list key-elt t)) + (push slot (cdr alist))) + (setq alist (cdr slot))) + (setq i (1+ i)))) + ((arrayp keyseq) + (while (< i len) + (if (null (nested-alist-p alist)) + (error "Keyseq %s is too long for this nested alist" keyseq)) + (let* ((key-elt (aref keyseq i)) + (slot (assoc key-elt (cdr alist)))) + (unless slot + (setq slot (list key-elt t)) + (push slot (cdr alist))) + (setq alist (cdr slot))) + (setq i (1+ i)))) + ((listp keyseq) + (while (< i len) + (if (null (nested-alist-p alist)) + (error "Keyseq %s is too long for this nested alist" keyseq)) + (let* ((key-elt (pop keyseq)) + (slot (assoc key-elt (cdr alist)))) + (unless slot + (setq slot (list key-elt t)) + (push slot (cdr alist))) + (setq alist (cdr slot))) + (setq i (1+ i)))) + (t (signal 'wrong-type-argument (list keyseq)))) (setcar alist entry) (if branches (setcdr (last alist) branches)))) @@ -179,15 +202,23 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil (setq len (length keyseq))) (let ((i (or start 0))) (if (catch 'lookup-nested-alist-tag - (if (listp keyseq) - (while (< i len) - (if (setq alist (cdr (assoc (nth i keyseq) (cdr alist)))) - (setq i (1+ i)) - (throw 'lookup-nested-alist-tag t)))) - (while (< i len) - (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist)))) - (setq i (1+ i)) - (throw 'lookup-nested-alist-tag t)))) + (cond ((stringp keyseq) ; We can use `assq' for characters. + (while (< i len) + (if (setq alist (cdr (assq (aref keyseq i) (cdr alist)))) + (setq i (1+ i)) + (throw 'lookup-nested-alist-tag t)))) + ((arrayp keyseq) + (while (< i len) + (if (setq alist (cdr (assoc (aref keyseq i) (cdr alist)))) + (setq i (1+ i)) + (throw 'lookup-nested-alist-tag t)))) + ((listp keyseq) + (setq keyseq (nthcdr i keyseq)) + (while (< i len) + (if (setq alist (cdr (assoc (pop keyseq) (cdr alist)))) + (setq i (1+ i)) + (throw 'lookup-nested-alist-tag t)))) + (t (signal 'wrong-type-argument (list keyseq))))) ;; KEYSEQ is too long. (if nil-for-too-long nil i) alist))) commit ba0bb332dd841274208f71e0739e0c5e5d231d7a Author: Reuben Thomas Date: Tue Aug 22 01:39:10 2017 +0100 Treat tests in lib-src like tests in src * test/Makefile.in (test_template): Depend on a .c source file for a test under lib-src, as for src. (Thanks, Glenn Morris for pointing me in the right direction.) diff --git a/test/Makefile.in b/test/Makefile.in index ba823ec7e3..34d74d41cb 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -178,12 +178,12 @@ TESTS := $(LOGFILES:.log=) define test_template ## A test FOO-tests depends on the source file with the similar ## name, unless FOO itself contains the string '-tests/'. - ## The similar name is FOO.c if FOO begins with 'src/', FOO.el + ## The similar name is FOO.c if FOO begins with '{lib-,}src/', FOO.el ## otherwise. Although this heuristic does not identify all the ## dependencies, it is better than nothing. ifeq (,$(patsubst %-tests,,$(1))$(findstring -tests/,$(1))) $(1).log: $(patsubst %-tests,$(srcdir)/../%,$(1))$(if \ - $(patsubst src/%,,$(1)),.el,.c) + $(patsubst src/%,,$(patsubst lib-src/%,,$(1))),.el,.c) endif ## Short aliases that always re-run the tests, with no logging. commit 891bc9822bdd9893ddf2d4fd65fd53a5da001beb Author: Paul Eggert Date: Mon Aug 21 15:34:07 2017 -0700 Port /bin/sh scripts to Solaris 10 Its /bin/sh builtin ‘test’ command does not support -e. * autogen.sh, build-aux/git-hooks/pre-commit: * build-aux/gitlog-to-emacslog, make-dist: Use test -r, not test -e. diff --git a/autogen.sh b/autogen.sh index d454e41ea7..0d00d56762 100755 --- a/autogen.sh +++ b/autogen.sh @@ -115,7 +115,7 @@ for arg; do do_check=false;; all) do_autoconf=true - test -e .git && do_git=true;; + test -r .git && do_git=true;; autoconf) do_autoconf=true;; git) @@ -128,7 +128,7 @@ done case $do_autoconf,$do_git in false,false) do_autoconf=true - test -e .git && do_git=true;; + test -r .git && do_git=true;; esac # Generate Autoconf-related files, if requested. @@ -294,7 +294,7 @@ git_config () # Get location of Git's common configuration directory. For older Git # versions this is just '.git'. Newer Git versions support worktrees. -{ test -e .git && +{ test -r .git && git_common_dir=`git rev-parse --no-flags --git-common-dir 2>/dev/null` && test -n "$git_common_dir" } || git_common_dir=.git @@ -377,7 +377,7 @@ fi if test ! -f configure; then echo "You can now run '$0 autoconf'." -elif test -e .git && test $git_was_ok = false && test $do_git = false; then +elif test -r .git && test $git_was_ok = false && test $do_git = false; then echo "You can now run '$0 git'." elif test ! -f config.status || test -n "`find configure src/config.in -newer config.status`"; then diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 548bf933f0..0fa5837f60 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -28,7 +28,7 @@ exec >&2 # When doing a two-way merge, ignore problems that came from the other # side of the merge. head=HEAD -if test -e "$GIT_DIR"/MERGE_HEAD; then +if test -r "$GIT_DIR"/MERGE_HEAD; then merge_heads=`cat "$GIT_DIR"/MERGE_HEAD` || exit for merge_head in $merge_heads; do case $head in diff --git a/build-aux/gitlog-to-emacslog b/build-aux/gitlog-to-emacslog index 482b8dbe5d..bced7e4986 100755 --- a/build-aux/gitlog-to-emacslog +++ b/build-aux/gitlog-to-emacslog @@ -68,7 +68,7 @@ if [ -f "$output" ]; then fi # If this is not a Git repository, just generate an empty ChangeLog. -test -e .git || { +test -r .git || { >"$output" exit } @@ -81,7 +81,7 @@ test -e .git || { --ignore-line='^; ' --format='%B' \ "$gen_origin..$new_origin" >"ChangeLog.tmp" || exit -if test -e "ChangeLog.tmp"; then +if test -r "ChangeLog.tmp"; then # Fix up bug references. # This would be better as eg a --transform option to gitlog-to-changelog, diff --git a/make-dist b/make-dist index eb81a144eb..b4667843ce 100755 --- a/make-dist +++ b/make-dist @@ -240,7 +240,7 @@ if [ $check = yes ]; then bogosities= while read elc; do el=`echo $elc | sed 's/c$//'` - [ -e $el ] || continue + [ -r $el ] || continue [ $elc -nt $el ] || bogosities="$bogosities $elc" done < /tmp/elc @@ -278,7 +278,7 @@ if [ $check = yes ]; then info=`sed -n 's/^@setfilename //p' $texi | sed 's|.*info/||'` [ x"${info}" != x"" ] || continue info=info/$info - [ -e $info ] || continue + [ -r $info ] || continue [ $info -nt $texi ] || bogosities="$bogosities $info" done < /tmp/el @@ -292,7 +292,7 @@ if [ $check = yes ]; then ## This exits with non-zero status if any .info files need ## rebuilding. - if [ -e Makefile ]; then + if [ -r Makefile ]; then echo "Checking to see if info files are up-to-date..." make --question info || error=yes fi @@ -300,7 +300,7 @@ if [ $check = yes ]; then ## Is this a release? case $version in [1-9][0-9].[0-9]) - if [ -e ChangeLog ]; then + if [ -r ChangeLog ]; then if ! grep -q "Version $version released" ChangeLog; then echo "No release notice in ChangeLog" error=yes @@ -359,10 +359,10 @@ echo "Creating top directory: '${tempdir}'" mkdir ${tempdir} if [ "$changelog" = yes ]; then - if test -e .git; then + if test -r .git; then ## When making a release or pretest the ChangeLog should already ## have been created and edited as needed. Don't ignore it. - if test -e ChangeLog; then + if test -r ChangeLog; then echo "Using existing top-level ChangeLog" else echo "Making top-level ChangeLog" commit 80fccd4290ae134bd1b3d377f134bb9143b68b43 Author: Eli Zaretskii Date: Mon Aug 21 20:21:28 2017 +0300 Avoid losing the buffer restriction in flyspell-mode * src/intervals.c (get_local_map): Don't allow C-g to quit as long as we have the buffer widened, to make sure the restriction is preserved. (Bug#28161) diff --git a/src/intervals.c b/src/intervals.c index 0089ecb8dd..e65c22977e 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -2153,6 +2153,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type) { Lisp_Object prop, lispy_position, lispy_buffer; ptrdiff_t old_begv, old_zv, old_begv_byte, old_zv_byte; + ptrdiff_t count = SPECPDL_INDEX (); position = clip_to_bounds (BUF_BEGV (buffer), position, BUF_ZV (buffer)); @@ -2163,6 +2164,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type) old_begv_byte = BUF_BEGV_BYTE (buffer); old_zv_byte = BUF_ZV_BYTE (buffer); + specbind (Qinhibit_quit, Qt); SET_BUF_BEGV_BOTH (buffer, BUF_BEG (buffer), BUF_BEG_BYTE (buffer)); SET_BUF_ZV_BOTH (buffer, BUF_Z (buffer), BUF_Z_BYTE (buffer)); @@ -2180,6 +2182,7 @@ get_local_map (ptrdiff_t position, struct buffer *buffer, Lisp_Object type) SET_BUF_BEGV_BOTH (buffer, old_begv, old_begv_byte); SET_BUF_ZV_BOTH (buffer, old_zv, old_zv_byte); + unbind_to (count, Qnil); /* Use the local map only if it is valid. */ prop = get_keymap (prop, 0, 0); commit 694e2d8f2354b68f60513915cb8a9c9d1a11ce81 Author: Sven Joachim Date: Mon Aug 21 19:28:55 2017 +0300 Fix the 'versionclean' target in src/Makefile * src/Makefile.in (versionclean): Don't accidentally remove emacs-module.h. (Bug#28169) diff --git a/src/Makefile.in b/src/Makefile.in index 57969d5fc5..dde3f1d3fb 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -659,7 +659,7 @@ distclean: bootstrap-clean maintainer-clean: distclean rm -f TAGS versionclean: - -rm -f emacs$(EXEEXT) emacs-*.*.*$(EXEEXT) ../etc/DOC* + -rm -f emacs$(EXEEXT) emacs-*.*.*[0-9]$(EXEEXT) ../etc/DOC* extraclean: distclean -rm -f *~ \#* commit 01844e40dc43baf1fdc088ef6400343e908ea449 Author: Michael Albinus Date: Mon Aug 21 17:30:33 2017 +0200 Implement `interrupt-process-functions' * lisp/net/tramp.el (tramp-interrupt-process): Rename from `tramp-advice-interrupt-process'. Adapt according to changed API. (top): Add it to `interrupt-process-functions'. * src/process.c (Finternal_default_interrupt_process): New defun. (Finterrupt_process): Change implementation, based on Vinterrupt_process_functions. (Vinterrupt_process_functions): New defvar. * test/lisp/net/tramp-tests.el (tramp-test40-unload): Do not test removal of advice. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 3469d45ff2..2aa9a6b985 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4381,33 +4381,36 @@ Only works for Bourne-like shells." ;;; Signal handling. This works for remote processes, which have set ;;; the process property `remote-pid'. -(defun tramp-advice-interrupt-process (orig-fun &rest args) +(defun tramp-interrupt-process (&optional process _current-group) "Interrupt remote process PROC." - (let* ((arg0 (car args)) - (proc (cond - ((processp arg0) arg0) - ((bufferp arg0) (get-buffer-process arg0)) - ((stringp arg0) (or (get-process arg0) - (get-buffer-process arg0))) - ((null arg0) (get-buffer-process (current-buffer))) - (t arg0))) - pid) + ;; CURRENT-GROUP is not implemented yet. + (let ((proc (cond + ((processp process) process) + ((bufferp process) (get-buffer-process process)) + ((stringp process) (or (get-process process) + (get-buffer-process process))) + ((null process) (get-buffer-process (current-buffer))) + (t process))) + pid) ;; If it's a Tramp process, send the INT signal remotely. - (if (and (processp proc) - (setq pid (process-get proc 'remote-pid))) - (progn - (tramp-message proc 5 "%s %s" proc pid) - (tramp-send-command - (tramp-get-connection-property proc "vector" nil) - (format "kill -2 %d" pid))) - ;; Otherwise, just run the original function. - (apply orig-fun args)))) - -(advice-add 'interrupt-process :around 'tramp-advice-interrupt-process) -(add-hook - 'tramp-unload-hook - (lambda () - (advice-remove 'interrupt-process 'tramp-advice-interrupt-process))) + (when (and (processp proc) + (setq pid (process-get proc 'remote-pid))) + (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) + ;; This is for tramp-sh.el. Other backends do not support this (yet). + (tramp-compat-funcall + 'tramp-send-command + (tramp-get-connection-property proc "vector" nil) + (format "kill -2 %d" pid)) + ;; Report success. + proc))) + +;; `interrupt-process-functions' exists since Emacs 26.1. +(when (boundp 'interrupt-process-functions) + (add-hook 'interrupt-process-functions 'tramp-interrupt-process) + (add-hook + 'tramp-unload-hook + (lambda () + (remove-hook 'interrupt-process-functions 'tramp-interrupt-process)))) ;;; Integration of eshell.el: diff --git a/src/process.c b/src/process.c index 1900951533..e7ee99ab3d 100644 --- a/src/process.c +++ b/src/process.c @@ -6677,6 +6677,18 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, unblock_child_signal (&oldset); } +DEFUN ("internal-default-interrupt-process", + Finternal_default_interrupt_process, + Sinternal_default_interrupt_process, 0, 2, 0, + doc: /* Default function to interrupt process PROCESS. +It shall be the last element in list `interrupt-process-functions'. +See function `interrupt-process' for more details on usage. */) + (Lisp_Object process, Lisp_Object current_group) +{ + process_send_signal (process, SIGINT, current_group, 0); + return process; +} + DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, doc: /* Interrupt process PROCESS. PROCESS may be a process, a buffer, or the name of a process or buffer. @@ -6688,11 +6700,14 @@ If the process is a shell, this means interrupt current subjob rather than the shell. If CURRENT-GROUP is `lambda', and if the shell owns the terminal, -don't send the signal. */) +don't send the signal. + +This function calls the functions of `interrupt-process-functions' in +the order of the list, until one of them returns non-`nil'. */) (Lisp_Object process, Lisp_Object current_group) { - process_send_signal (process, SIGINT, current_group, 0); - return process; + return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions, + process, current_group); } DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, @@ -8176,6 +8191,17 @@ non-nil value means that the delay is not reset on write. The variable takes effect when `start-process' is called. */); Vprocess_adaptive_read_buffering = Qt; + DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions, + doc: /* List of functions to be called for `interrupt-function'. +The arguments of the functions are the same as for `interrupt-function'. +These functions are called in the order of the list, until one of them +returns non-`nil'. */); + Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process); + + DEFSYM (Qinternal_default_interrupt_process, + "internal-default-interrupt-process"); + DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); + defsubr (&Sprocessp); defsubr (&Sget_process); defsubr (&Sdelete_process); @@ -8218,6 +8244,7 @@ The variable takes effect when `start-process' is called. */); defsubr (&Saccept_process_output); defsubr (&Sprocess_send_region); defsubr (&Sprocess_send_string); + defsubr (&Sinternal_default_interrupt_process); defsubr (&Sinterrupt_process); defsubr (&Skill_process); defsubr (&Squit_process); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index dba553a2c5..129bc1d65d 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4072,10 +4072,7 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match "unload-hook$" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))) - ;; The advice on `interrupt-process' shall be removed. - (should-not - (advice-member-p 'tramp-advice-interrupt-process 'interrupt-process)))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) ;; TODO: commit 76fbe2f4541b11af8bcb0b5e57bb155b796b8d8e Author: Eli Zaretskii Date: Mon Aug 21 17:46:42 2017 +0300 Avoid floating-point exceptions while drawing underwave * src/w32term.c (x_get_scale_factor): * src/xterm.c (x_get_scale_factor): Don't let the scale factors become less than 1. Reported by Yuri D'Elia in http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00459.html. diff --git a/src/w32term.c b/src/w32term.c index 6d2fa33585..2785ae2b52 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -318,8 +318,10 @@ x_get_scale_factor(struct w32_display_info *dpyinfo, int *scale_x, int *scale_y) if (dpyinfo) { - *scale_x = floor (dpyinfo->resx / base_res); - *scale_y = floor (dpyinfo->resy / base_res); + if (dpyinfo->resx > base_res) + *scale_x = floor (dpyinfo->resx / base_res); + if (dpyinfo->resy > base_res) + *scale_y = floor (dpyinfo->resy / base_res); } } diff --git a/src/xterm.c b/src/xterm.c index 2efa70b1dc..77daa22ae0 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3483,8 +3483,10 @@ x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) if (dpyinfo) { - *scale_x = floor (dpyinfo->resx / base_res); - *scale_y = floor (dpyinfo->resy / base_res); + if (dpyinfo->resx > base_res) + *scale_x = floor (dpyinfo->resx / base_res); + if (dpyinfo->resy > base_res) + *scale_y = floor (dpyinfo->resy / base_res); } } commit 9840499564c90c43b1d269154593ebe57a7cb9b0 Author: Sam Steingold Date: Mon Aug 21 09:50:09 2017 -0400 mark flymake-mode as safe local variable when the value is nil diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el index 3fb1ecaa7f..69f0c77a71 100644 --- a/lisp/progmodes/flymake-ui.el +++ b/lisp/progmodes/flymake-ui.el @@ -517,6 +517,9 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-is-running nil)))) +;; disabling flymake-mode is safe, enabling - not necessarily so +(put 'flymake-mode 'safe-local-variable 'null) + ;;;###autoload (defun flymake-mode-on () "Turn flymake mode on." commit de3a3ed034467ff2529c8262600e8a249969fd14 Author: Sam Steingold Date: Mon Aug 21 09:48:14 2017 -0400 allow nil init in flymake-allowed-file-name-masks to disable flymake (flymake-allowed-file-name-masks): Update doc and :type. (flymake-get-file-name-mode-and-masks): Handle nil init. diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 30555559e6..af16e522c3 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -85,16 +85,18 @@ ) "Files syntax checking is allowed for. This is an alist with elements of the form: - REGEXP INIT [CLEANUP [NAME]] + REGEXP [INIT [CLEANUP [NAME]]] REGEXP is a regular expression that matches a file name. -INIT is the init function to use. +INIT is the init function to use, missing means disable `flymake-mode'. CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. NAME is the file name function to use, default `flymake-get-real-file-name'." :group 'flymake :type '(alist :key-type (regexp :tag "File regexp") :value-type (list :tag "Handler functions" - (function :tag "Init function") + (choice :tag "Init function" + (const :tag "disable" nil) + function) (choice :tag "Cleanup function" (const :tag "flymake-simple-cleanup" nil) function) @@ -114,9 +116,10 @@ NAME is the file name function to use, default `flymake-get-real-file-name'." (let ((fnm flymake-allowed-file-name-masks) (mode-and-masks nil)) (while (and (not mode-and-masks) fnm) - (if (string-match (car (car fnm)) file-name) - (setq mode-and-masks (cdr (car fnm)))) - (setq fnm (cdr fnm))) + (let ((item (pop fnm))) + (when (string-match (car item) file-name) + (setq mode-and-masks item)))) ; (cdr item) may be nil + (setq mode-and-masks (cdr mode-and-masks)) (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) mode-and-masks)) commit 807b67faa403a2c2f65666c28f74ea1989451ad1 Author: Mark Oteiza Date: Sun Aug 20 22:31:25 2017 -0400 ; Fix typo in lispref * doc/lispref/variables.texi (Using Lexical Binding): Append an s. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 50739e6b5f..52d1f3bbf5 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1186,7 +1186,7 @@ variable. The byte-compiler will also issue a warning if you use a special variable as a function argument. (To silence byte-compiler warnings about unused variables, just use -a variable name that start with an underscore. The byte-compiler +a variable name that starts with an underscore. The byte-compiler interprets this as an indication that this is a variable known not to be used.) commit 082c72d257722d0c3288ee4b9386f5203c071dd6 Author: Dmitry Gutov Date: Mon Aug 21 00:41:59 2017 +0300 Remove the workaround for bug#20719 * lisp/cedet/semantic/symref/grep.el (semantic-symref-grep-use-template): Remove the workaround for bug#20719, it's been fixed for a while now. diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index f8b2929070..341a083775 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -119,10 +119,6 @@ PATTERN is the pattern used by Grep." pattern filepattern rootdir))) - ;; http://debbugs.gnu.org/20719 - (when (string-match "find \\(\\.\\)" cmd) - (setq cmd (replace-match rootdir t t cmd 1))) - ;;(message "New command: %s" cmd) cmd)) (defcustom semantic-symref-grep-shell shell-file-name commit 9da8d600b8453925d92b31ba98548480ad1e5c73 Author: Dmitry Gutov Date: Mon Aug 21 00:39:22 2017 +0300 Fix byte-compilation warnings in semantic/symref/grep * lisp/cedet/semantic/symref/grep.el (greppattern): Remove. (grepflags): Rename to semantic-symref-grep-flags. (semantic-symref-grep-expand-keywords): Update accordingly. (semantic-symref-grep-use-template): Remove the last two arguments to make sure they don't shadow the (not renamed) global variables. (semantic-symref-perform-search) (semantic-symref-parse-tool-output-one-line): Use slot names instead of keywords, like the byte-compiler wants us to. diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index f7c72bfb0b..f8b2929070 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -84,17 +84,14 @@ Optional argument MODE specifies the `major-mode' to test." ,@(mapcan (lambda (s) `("-o" "-name" ,s)) pat) ")")))))) -(defvar grepflags) -(defvar greppattern) +(defvar semantic-symref-grep-flags) (defvar semantic-symref-grep-expand-keywords (condition-case nil (let* ((kw (copy-alist grep-expand-keywords)) - (C (assoc "" kw)) - (R (assoc "" kw))) - (setcdr C 'grepflags) - (setcdr R 'greppattern) - kw) + (C (assoc "" kw))) + (setcdr C 'semantic-symref-grep-flags) + kw) (error nil)) "Grep expand keywords used when expanding templates for symref.") @@ -102,15 +99,15 @@ Optional argument MODE specifies the `major-mode' to test." "Use the grep template expand feature to create a grep command. ROOTDIR is the root location to run the `find' from. FILEPATTERN is a string representing find flags for searching file patterns. -GREPFLAGS are flags passed to grep, such as -n or -l. -GREPPATTERN is the pattern used by grep." +FLAGS are flags passed to Grep, such as -n or -l. +PATTERN is the pattern used by Grep." ;; We have grep-compute-defaults. Let's use it. (grep-compute-defaults) - (let* ((grepflags flags) - (greppattern pattern) + (let* ((semantic-symref-grep-flags flags) (grep-expand-keywords semantic-symref-grep-expand-keywords) (cmd (grep-expand-template (if (memq system-type '(windows-nt ms-dos)) + ;; FIXME: Is this still needed? ;; grep-find uses '--color=always' on MS-Windows ;; because it wants the colorized output, to show ;; it to the user. By contrast, here we don't show @@ -119,7 +116,7 @@ GREPPATTERN is the pattern used by grep." (replace-regexp-in-string "--color=always" "" grep-find-template t t) grep-find-template) - greppattern + pattern filepattern rootdir))) ;; http://debbugs.gnu.org/20719 @@ -137,7 +134,7 @@ This shell should support pipe redirect syntax." (cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep)) "Perform a search with Grep." ;; Grep doesn't support some types of searches. - (let ((st (oref tool :searchtype))) + (let ((st (oref tool searchtype))) (when (not (memq st '(symbol regexp))) (error "Symref impl GREP does not support searchtype of %s" st)) ) @@ -147,20 +144,19 @@ This shell should support pipe redirect syntax." (filepatterns (semantic-symref-derive-find-filepatterns)) (filepattern (mapconcat #'shell-quote-argument filepatterns " ")) ;; Grep based flags. - (grepflags (cond ((eq (oref tool :resulttype) 'file) + (grepflags (cond ((eq (oref tool resulttype) 'file) "-l ") - ((eq (oref tool :searchtype) 'regexp) + ((eq (oref tool searchtype) 'regexp) "-nE ") (t "-n "))) - (greppat (shell-quote-argument - (cond ((eq (oref tool :searchtype) 'regexp) - (oref tool searchfor)) - (t - ;; Can't use the word boundaries: Grep - ;; doesn't always agrees with the language - ;; syntax on those. - (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)" - (oref tool searchfor)))))) + (greppat (cond ((eq (oref tool searchtype) 'regexp) + (oref tool searchfor)) + (t + ;; Can't use the word boundaries: Grep + ;; doesn't always agrees with the language + ;; syntax on those. + (format "\\(^\\|\\W\\)%s\\(\\W\\|$\\)" + (oref tool searchfor))))) ;; Misc (b (get-buffer-create "*Semantic SymRef*")) (ans nil) @@ -194,11 +190,11 @@ This shell should support pipe redirect syntax." Moves cursor to end of the match." (pcase-let ((`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))) - (cond ((eq (oref tool :resulttype) 'file) + (cond ((eq (oref tool resulttype) 'file) ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) (match-string 1))) - ((eq (oref tool :resulttype) 'line-and-text) + ((eq (oref tool resulttype) 'line-and-text) (when (re-search-forward grep-re nil t) (list (string-to-number (match-string line-group)) (match-string file-group) commit 7ef0b5f611c2d56ac2edb8de287190f04c4b8f32 Author: Dmitry Gutov Date: Mon Aug 21 00:26:45 2017 +0300 Simplify eldoc-message * lisp/emacs-lisp/eldoc.el (eldoc-message): Simplify. Don't use ARGS because no callers pass them. Discussed in bug#27230. diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index bca40ab87d..8c16546198 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -276,19 +276,12 @@ Otherwise work like `message'." (force-mode-line-update))) (apply 'message format-string args))) -(defun eldoc-message (&optional format-string &rest args) - "Display FORMAT-STRING formatted with ARGS as an ElDoc message. +(defun eldoc-message (&optional string) + "Display STRING as an ElDoc message if it's non-nil. -Store the message (if any) in `eldoc-last-message', and return it." +Also store it in `eldoc-last-message' and return that value." (let ((omessage eldoc-last-message)) - (setq eldoc-last-message - (cond ((eq format-string eldoc-last-message) eldoc-last-message) - ((null format-string) nil) - ;; If only one arg, no formatting to do, so put it in - ;; eldoc-last-message so eq test above might succeed on - ;; subsequent calls. - ((null args) format-string) - (t (apply #'format-message format-string args)))) + (setq eldoc-last-message string) ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages ;; are recorded in a log. Do not put eldoc messages in that log since ;; they are Legion. commit 9714545675af046d730352eb03dc00e93b6f7d3c Author: Noam Postavsky Date: Tue Aug 15 17:49:10 2017 -0400 Work around w32-python-2.x bug to fix prompt detection (Bug#21376) * lisp/progmodes/python.el (python-shell-prompt-detect): Don't put carriage returns into the temporary file when running in unbuffered mode, the w32 build of python 2.7 chokes on them. diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 6f169123b9..e73b2a8488 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -2245,7 +2245,11 @@ detection and just returns nil." ;; `condition-case' and displaying the error message to ;; the user in the no-prompts warning. (ignore-errors - (let ((code-file (python-shell--save-temp-file code))) + (let ((code-file + ;; Python 2.x on Windows does not handle + ;; carriage returns in unbuffered mode. + (let ((inhibit-eol-conversion (getenv "PYTHONUNBUFFERED"))) + (python-shell--save-temp-file code)))) ;; Use `process-file' as it is remote-host friendly. (process-file interpreter commit cdfe1cbca73925800c7be8e7e8073ef86374e654 Author: Noam Postavsky Date: Wed Aug 16 07:06:38 2017 -0400 ; Remove python-shell-calculate-command-1 test * test/lisp/progmodes/python-tests.el (python-shell-calculate-pythonpath-1): Remove, it merely reprises the body of `python-shell-calculate-command' and it has been broken on w32 since the fix for Bug#25025 was applied. diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index f76ecbbd3d..4b022fc815 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -2522,20 +2522,6 @@ if x: (should (string= (python-shell-internal-get-process-name) (format "%s[%s]" python-shell-internal-buffer-name (buffer-name)))))) -(ert-deftest python-shell-calculate-command-1 () - "Check the command to execute is calculated correctly. -Using `python-shell-interpreter' and -`python-shell-interpreter-args'." - (skip-unless (executable-find python-tests-shell-interpreter)) - (let ((python-shell-interpreter (executable-find - python-tests-shell-interpreter)) - (python-shell-interpreter-args "-B")) - (should (string= - (format "%s %s" - (shell-quote-argument python-shell-interpreter) - python-shell-interpreter-args) - (python-shell-calculate-command))))) - (ert-deftest python-shell-calculate-pythonpath-1 () "Test PYTHONPATH calculation." (let ((process-environment '("PYTHONPATH=/path0")) commit bc157406a6dbef993f82e55707990ac462850956 Author: Noam Postavsky Date: Sun Aug 20 16:40:35 2017 -0400 ; * lisp/textmodes/ispell.el: `subr-x' is only needed at compile time. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 1c9b3db274..e67e603e99 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -107,7 +107,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) -(require 'subr-x) +(eval-when-compile (require 'subr-x)) (defvar mail-yank-prefix) commit a5ff1fc0696d5e8f9cea1cf00caa2b980e1761af Author: Reuben Thomas Date: Sun Aug 20 21:32:40 2017 +0100 Add missing require * lisp/textmodes/ispell.el: Require subr-x. (Thanks, Eli Zaretskii.) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 7ae2c0cfa8..1c9b3db274 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -107,6 +107,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) +(require 'subr-x) (defvar mail-yank-prefix) commit 296472f5c5db2b5c046af67f74dff2640e7127c2 Author: Michael Albinus Date: Sun Aug 20 21:18:05 2017 +0200 Implement `interrupt-process' for remote processes (Bug#28066) * lisp/net/tramp-sh.el (tramp-sh-handle-start-file-process): Support sending signals remotely. (tramp-open-connection-setup-interactive-shell): Trace "remote-tty" connection property. * lisp/net/tramp.el (tramp-advice-interrupt-process): New defun. (top): Add advice to `interrupt-process'. (Bug#28066) * test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process): New test. (tramp-test29-shell-command) (tramp-test30-environment-variables) (tramp-test30-environment-variables-and-port-numbers) (tramp-test31-explicit-shell-file-name) (tramp-test32-vc-registered) (tramp-test33-make-auto-save-file-name) (tramp-test34-make-nearby-temp-file) (tramp-test35-special-characters) (tramp-test35-special-characters-with-stat) (tramp-test35-special-characters-with-perl) (tramp-test35-special-characters-with-ls, tramp-test36-utf8) (tramp-test36-utf8-with-stat, tramp-test36-utf8-with-perl) (tramp-test36-utf8-with-ls) (tramp-test37-asynchronous-requests) (tramp-test38-recursive-load, tramp-test39-remote-load-path) (tramp-test40-unload): Rename. (tramp-test40-unload): Test also removal of advice. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 6b365c10e2..50b380100b 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -2875,7 +2875,8 @@ the result will be a local, non-Tramp, file name." ;; We do not want to raise an error when ;; `start-file-process' has been started several times in ;; `eshell' and friends. - (tramp-current-connection nil)) + (tramp-current-connection nil) + p) (while (get-process name1) ;; NAME must be unique as process name. @@ -2905,33 +2906,37 @@ the result will be a local, non-Tramp, file name." ;; to cleanup the prompt afterwards. (catch 'suppress (tramp-maybe-open-connection v) + (setq p (tramp-get-connection-process v)) + ;; Set the pid of the remote shell. This is + ;; needed when sending signals remotely. + (let ((pid (tramp-send-command-and-read v "echo $$"))) + (process-put p 'remote-pid pid) + (tramp-set-connection-property p "remote-pid" pid)) (widen) - (delete-region mark (point)) + (delete-region mark (point-max)) (narrow-to-region (point-max) (point-max)) ;; Now do it. (if command ;; Send the command. (tramp-send-command v command nil t) ; nooutput ;; Check, whether a pty is associated. - (unless (process-get - (tramp-get-connection-process v) 'remote-tty) + (unless (process-get p 'remote-tty) (tramp-error v 'file-error "pty association is not supported for `%s'" name)))) - (let ((p (tramp-get-connection-process v))) - ;; Set query flag and process marker for this - ;; process. We ignore errors, because the process - ;; could have finished already. - (ignore-errors - (set-process-query-on-exit-flag p t) - (set-marker (process-mark p) (point))) - ;; Return process. - p)))) + ;; Set query flag and process marker for this + ;; process. We ignore errors, because the process + ;; could have finished already. + (ignore-errors + (set-process-query-on-exit-flag p t) + (set-marker (process-mark p) (point))) + ;; Return process. + p))) ;; Save exit. (if (string-match tramp-temp-buffer-name (buffer-name)) (ignore-errors - (set-process-buffer (tramp-get-connection-process v) nil) + (set-process-buffer p nil) (kill-buffer (current-buffer))) (set-buffer-modified-p bmp)) (tramp-set-connection-property v "process-name" nil) @@ -4111,7 +4116,8 @@ process to set up. VEC specifies the connection." ;; Set `remote-tty' process property. (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror))) (unless (zerop (length tty)) - (process-put proc 'remote-tty tty))) + (process-put proc 'remote-tty tty) + (tramp-set-connection-property proc "remote-tty" tty))) ;; Dump stty settings in the traces. (when (>= tramp-verbose 9) @@ -5687,9 +5693,6 @@ function cell is returned to be applied on a buffer." ;; * Reconnect directly to a compliant shell without first going ;; through the user's default shell. (Pete Forman) ;; -;; * How can I interrupt the remote process with a signal -;; (interrupt-process seems not to work)? (Markus Triska) -;; ;; * Avoid the local shell entirely for starting remote processes. If ;; so, I think even a signal, when delivered directly to the local ;; SSH instance, would correctly be propagated to the remote process diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8d7fbc068b..3469d45ff2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -4378,6 +4378,37 @@ Only works for Bourne-like shells." t t result))) result)))) +;;; Signal handling. This works for remote processes, which have set +;;; the process property `remote-pid'. + +(defun tramp-advice-interrupt-process (orig-fun &rest args) + "Interrupt remote process PROC." + (let* ((arg0 (car args)) + (proc (cond + ((processp arg0) arg0) + ((bufferp arg0) (get-buffer-process arg0)) + ((stringp arg0) (or (get-process arg0) + (get-buffer-process arg0))) + ((null arg0) (get-buffer-process (current-buffer))) + (t arg0))) + pid) + ;; If it's a Tramp process, send the INT signal remotely. + (if (and (processp proc) + (setq pid (process-get proc 'remote-pid))) + (progn + (tramp-message proc 5 "%s %s" proc pid) + (tramp-send-command + (tramp-get-connection-property proc "vector" nil) + (format "kill -2 %d" pid))) + ;; Otherwise, just run the original function. + (apply orig-fun args)))) + +(advice-add 'interrupt-process :around 'tramp-advice-interrupt-process) +(add-hook + 'tramp-unload-hook + (lambda () + (advice-remove 'interrupt-process 'tramp-advice-interrupt-process))) + ;;; Integration of eshell.el: ;; eshell.el keeps the path in `eshell-path-env'. We must change it diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 9dc276b2a9..dba553a2c5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2900,7 +2900,26 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-process proc)))))) -(ert-deftest tramp-test28-shell-command () +(ert-deftest tramp-test28-interrupt-process () + "Check `interrupt-process'." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + + (let ((default-directory tramp-test-temporary-file-directory) + kill-buffer-query-functions proc) + (unwind-protect + (with-temp-buffer + (setq proc (start-file-process "test" (current-buffer) "sleep" "10")) + (should (processp proc)) + (should (equal (process-status proc) 'run)) + (interrupt-process proc) + (should (equal (process-status proc) 'signal))) + + ;; Cleanup. + (ignore-errors (delete-process proc))))) + +(ert-deftest tramp-test29-shell-command () "Check `shell-command'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3004,7 +3023,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-substring-no-properties (point-min) (point-max)))) ;; This test is inspired by Bug#23952. -(ert-deftest tramp-test29-environment-variables () +(ert-deftest tramp-test30-environment-variables () "Check that remote processes set / unset environment variables properly." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3082,7 +3101,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (funcall this-shell-command-to-string "set"))))))))) ;; This test is inspired by Bug#27009. -(ert-deftest tramp-test29-environment-variables-and-port-numbers () +(ert-deftest tramp-test30-environment-variables-and-port-numbers () "Check that two connections with separate ports are different." (skip-unless (tramp--test-enabled)) ;; We test it only for the mock-up connection; otherwise there might @@ -3121,7 +3140,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (tramp-cleanup-connection (tramp-dissect-file-name dir))))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test30-explicit-shell-file-name () +(ert-deftest tramp-test31-explicit-shell-file-name () "Check that connection-local `explicit-shell-file-name' is set." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3165,7 +3184,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (put 'explicit-shell-file-name 'permanent-local nil) (kill-buffer "*shell*")))) -(ert-deftest tramp-test31-vc-registered () +(ert-deftest tramp-test32-vc-registered () "Check `vc-registered'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) @@ -3238,7 +3257,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) -(ert-deftest tramp-test32-make-auto-save-file-name () +(ert-deftest tramp-test33-make-auto-save-file-name () "Check `make-auto-save-file-name'." (skip-unless (tramp--test-enabled)) @@ -3333,7 +3352,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ignore-errors (delete-directory tmp-name2 'recursive)))))) ;; The functions were introduced in Emacs 26.1. -(ert-deftest tramp-test33-make-nearby-temp-file () +(ert-deftest tramp-test34-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) ;; Since Emacs 26.1. @@ -3600,7 +3619,7 @@ This requires restrictions of file name syntax." (ignore-errors (delete-directory tmp-name2 'recursive)))))) (defun tramp--test-special-characters () - "Perform the test in `tramp-test34-special-characters*'." + "Perform the test in `tramp-test35-special-characters*'." ;; Newlines, slashes and backslashes in file names are not ;; supported. So we don't test. And we don't test the tab ;; character on Windows or Cygwin, because the backslash is @@ -3643,7 +3662,7 @@ This requires restrictions of file name syntax." "{foo}bar{baz}")) ;; These tests are inspired by Bug#17238. -(ert-deftest tramp-test34-special-characters () +(ert-deftest tramp-test35-special-characters () "Check special characters in file names." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-rsync-p))) @@ -3651,7 +3670,7 @@ This requires restrictions of file name syntax." (tramp--test-special-characters)) -(ert-deftest tramp-test34-special-characters-with-stat () +(ert-deftest tramp-test35-special-characters-with-stat () "Check special characters in file names. Use the `stat' command." :tags '(:expensive-test) @@ -3669,7 +3688,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test34-special-characters-with-perl () +(ert-deftest tramp-test35-special-characters-with-perl () "Check special characters in file names. Use the `perl' command." :tags '(:expensive-test) @@ -3690,7 +3709,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-special-characters))) -(ert-deftest tramp-test34-special-characters-with-ls () +(ert-deftest tramp-test35-special-characters-with-ls () "Check special characters in file names. Use the `ls' command." :tags '(:expensive-test) @@ -3713,7 +3732,7 @@ Use the `ls' command." (tramp--test-special-characters))) (defun tramp--test-utf8 () - "Perform the test in `tramp-test35-utf8*'." + "Perform the test in `tramp-test36-utf8*'." (let* ((utf8 (if (and (eq system-type 'darwin) (memq 'utf-8-hfs (coding-system-list))) 'utf-8-hfs 'utf-8)) @@ -3728,7 +3747,7 @@ Use the `ls' command." "银河系漫游指南系列" "Автостопом по гала́ктике"))) -(ert-deftest tramp-test35-utf8 () +(ert-deftest tramp-test36-utf8 () "Check UTF8 encoding in file names and file contents." (skip-unless (tramp--test-enabled)) (skip-unless (not (tramp--test-docker-p))) @@ -3738,7 +3757,7 @@ Use the `ls' command." (tramp--test-utf8)) -(ert-deftest tramp-test35-utf8-with-stat () +(ert-deftest tramp-test36-utf8-with-stat () "Check UTF8 encoding in file names and file contents. Use the `stat' command." :tags '(:expensive-test) @@ -3758,7 +3777,7 @@ Use the `stat' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test35-utf8-with-perl () +(ert-deftest tramp-test36-utf8-with-perl () "Check UTF8 encoding in file names and file contents. Use the `perl' command." :tags '(:expensive-test) @@ -3781,7 +3800,7 @@ Use the `perl' command." tramp-connection-properties))) (tramp--test-utf8))) -(ert-deftest tramp-test35-utf8-with-ls () +(ert-deftest tramp-test36-utf8-with-ls () "Check UTF8 encoding in file names and file contents. Use the `ls' command." :tags '(:expensive-test) @@ -3809,7 +3828,7 @@ Use the `ls' command." (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) ;; This test is inspired by Bug#16928. -(ert-deftest tramp-test36-asynchronous-requests () +(ert-deftest tramp-test37-asynchronous-requests () "Check parallel asynchronous requests. Such requests could arrive from timers, process filters and process sentinels. They shall not disturb each other." @@ -3966,7 +3985,7 @@ process sentinels. They shall not disturb each other." (ignore-errors (cancel-timer timer)) (ignore-errors (delete-directory tmp-name 'recursive))))))) -(ert-deftest tramp-test37-recursive-load () +(ert-deftest tramp-test38-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -3989,7 +4008,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test38-remote-load-path () +(ert-deftest tramp-test39-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -4012,7 +4031,7 @@ process sentinels. They shall not disturb each other." (mapconcat 'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test39-unload () +(ert-deftest tramp-test40-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -4053,7 +4072,10 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match "unload-hook$" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) - (ert-fail (format "Hook `%s' still contains Tramp function" x))))))) + (ert-fail (format "Hook `%s' still contains Tramp function" x))))) + ;; The advice on `interrupt-process' shall be removed. + (should-not + (advice-member-p 'tramp-advice-interrupt-process 'interrupt-process)))) ;; TODO: @@ -4070,7 +4092,7 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. +;; * Fix Bug#16928 in `tramp-test37-asynchronous-requests'. (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." commit cf74c27ba1401aba216267b5a9900e659d1b2a25 Author: Reuben Thomas Date: Sun Aug 20 13:56:38 2017 +0100 Document Enchant support * doc/emacs/fixit.texi: Mention Enchant. * doc/misc/efaq.texi: Likewise. * etc/NEWS: Add an item on Enchant support. diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index f833f572df..f2dba83252 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -227,7 +227,7 @@ case-convert it and go on typing. @xref{Case}. This section describes the commands to check the spelling of a single word or of a portion of a buffer. These commands only work if -the spelling checker program Aspell, Ispell or Hunspell is installed. +the spelling checker program Hunspell, Aspell, Ispell or Enchant is installed. These programs are not part of Emacs, but one of them is usually installed in GNU/Linux and other free operating systems. @ifnottex @@ -249,9 +249,9 @@ Check and correct spelling in the region. Check and correct spelling in a draft mail message, excluding cited material. @item M-x ispell-change-dictionary @key{RET} @var{dict} @key{RET} -Restart the Aspell/Ispell/Hunspell process, using @var{dict} as the dictionary. +Restart the spell-checker process, using @var{dict} as the dictionary. @item M-x ispell-kill-ispell -Kill the Aspell/Ispell/Hunspell subprocess. +Kill the spell-checker subprocess. @item M-@key{TAB} @itemx @key{ESC} @key{TAB} @itemx C-M-i @@ -319,8 +319,8 @@ Accept the incorrect word---treat it as correct, but only in this editing session and for this buffer. @item i -Insert this word in your private dictionary file so that Aspell or Ispell -or Hunspell will consider it correct from now on, even in future sessions. +Insert this word in your private dictionary file so that it will be +considered correct from now on, even in future sessions. @item m Like @kbd{i}, but you can also specify dictionary completion @@ -364,7 +364,7 @@ character; type that digit or character to choose it. @cindex @code{ispell} program @findex ispell-kill-ispell - Once started, the Aspell or Ispell or Hunspell subprocess continues + Once started, the spell-checker subprocess continues to run, waiting for something to do, so that subsequent spell checking commands complete more quickly. If you want to get rid of the process, use @kbd{M-x ispell-kill-ispell}. This is not usually @@ -375,7 +375,7 @@ spelling correction. @vindex ispell-local-dictionary @vindex ispell-personal-dictionary @findex ispell-change-dictionary - Ispell, Aspell and Hunspell look up spelling in two dictionaries: + Spell-checkers look up spelling in two dictionaries: the standard dictionary and your personal dictionary. The standard dictionary is specified by the variable @code{ispell-local-dictionary} or, if that is @code{nil}, by the variable @code{ispell-dictionary}. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index e9cfe7afce..c32998411a 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3464,22 +3464,26 @@ best way to find results. @section Spell-checkers @cindex Spell-checker @cindex Checking spelling -@cindex Ispell -@cindex Aspell @cindex Hunspell +@cindex Aspell +@cindex Ispell +@cindex Enchant Various spell-checkers are compatible with Emacs, including: @table @b +@item Hunspell +@uref{http://hunspell.sourceforge.net/} + @item GNU Aspell @uref{http://aspell.net/} @item Ispell @uref{http://fmg-www.cs.ucla.edu/geoff/ispell.html} -@item Hunspell -@uref{http://hunspell.sourceforge.net/} +@item Enchant +@uref{https://abiword.github.io/enchant/} @end table diff --git a/etc/NEWS b/etc/NEWS index 7774d75abb..09390333ae 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1084,6 +1084,17 @@ file. ** New DNS mode command 'dns-mode-ipv6-to-nibbles' to convert IPv6 addresses to a format suitable for reverse lookup zone files. +** Ispell + ++++ +*** Enchant (version 2.1.0 or later required) is now supported as a +spell-checker. Enchant is a meta-spell-checker that uses providers +such as Hunspell to do the actual checking. With it, users can use +spell-checkers not directly supported by Emacs, such as Voikko, Hspell +and AppleSpell, more easily share personal word-lists with other +programs, and configure different spelling-checkers for different +languages. + ** Flymake +++ commit fc2ccb2ae82aee1fe932351c19643f3fb7b9deaa Author: Reuben Thomas Date: Tue Aug 8 15:56:03 2017 +0100 Remove old comments and a redundant FIXME * lisp/textmodes/ispell.el (ispell-process-line): Remove some old commented code, a redundant FIXME, and outdated usage instructions. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index e6ca32f20d..7ae2c0cfa8 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1,10 +1,8 @@ -;;; ispell.el --- interface to International Ispell Versions 3.1 and 3.2 -*- lexical-binding:t -*- +;;; ispell.el --- interface to spell checkers -*- lexical-binding:t -*- ;; Copyright (C) 1994-1995, 1997-2017 Free Software Foundation, Inc. ;; Author: Ken Stevens -;; Status : Release with 3.1.12+ and 3.2.0+ ispell. -;; Keywords: unix wp ;; This file is part of GNU Emacs. @@ -21,23 +19,11 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;; Note: version numbers and time stamp are not updated -;; when this file is edited for release with GNU Emacs. - ;;; Commentary: ;; INSTRUCTIONS -;; This code contains a section of user-settable variables that you -;; should inspect prior to installation. Look past the end of the history -;; list. Set them up for your locale and the preferences of the majority -;; of the users. Otherwise the users may need to set a number of variables -;; themselves. -;; You particularly may want to change the default dictionary for your -;; country and language. -;; Most dictionary changes should be made in this file so all users can -;; enjoy them. Local or modified dictionaries are supported in your .emacs -;; file. Use the variable `ispell-local-dictionary-alist' to specify +;; Use the variable `ispell-local-dictionary-alist' to specify ;; your own dictionaries. ;; Depending on the mail system you use, you may want to include these: @@ -112,7 +98,7 @@ ;; Need a way to select between different character mappings without separate ;; dictionary entries. ;; Multi-byte characters if not defined by current dictionary may result in the -;; evil "misalignment error" in some versions of MULE Emacs. +;; evil "misalignment error" in some versions of Emacs. ;; On some versions of Emacs, growing the minibuffer fails. ;; see `ispell-help-in-bufferp'. ;; Recursive edits (?C-r or ?R) inside a keyboard text replacement check (?r) @@ -3524,17 +3510,9 @@ Returns the sum SHIFT due to changes in word replacements." (setq ispell-filter recheck-region recheck-region nil replace replace-word))))) + (setq shift (+ shift (- (length replace) word-len))))) - (setq shift (+ shift (- (length replace) word-len))) - - ;; Move line-start across word... - ;; new shift function does this now... - ;;(set-marker line-start (+ line-start - ;; (- (length replace) - ;; (length (car poss))))) - )) (if (not ispell-quit) - ;; FIXME: remove redundancy with identical code above. (let (message-log-max) (message "Continuing spelling check using %s with %s dictionary..." commit 60d417545a2852d36427799691792e4ddff8f86c Author: Reuben Thomas Date: Sun Dec 4 22:39:27 2016 +0000 Add Enchant support to ispell.el (Bug#17742) * lisp/textmodes/ispell.el (ispell-program-name): Add “enchant”. (ispell-really-enchant): Add variable. (ispell-check-version): If using Enchant, check it’s new enough (at least 1.6.1). (Like the ispell check, this is absolute: cannot work without.) (ispell-enchant-dictionary-alist): Add variable. (ispell-find-enchant-dictionaries): Add function, based on ispell-find-aspell-dictionaries. (ispell-set-spellchecker-params): Allow dictionary auto-detection for Enchant, and call ispell-find-enchant-dictionaries to find them. Use old ispell name to locale mapping code for Enchant too. (ispell-send-replacement): Make it work with Enchant. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 773023a34a..e6ca32f20d 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -208,6 +208,10 @@ Must be greater than 1." :type 'integer :group 'ispell) +;; XXX Add enchant to this list once enchant >= 2.1.0 is widespread. +;; Before that, adding it is useless, as if it is found, it will just +;; cause an error; and one of the other spelling engines below is +;; almost certainly installed in any case, for enchant to use. (defcustom ispell-program-name (or (executable-find "aspell") (executable-find "ispell") @@ -605,6 +609,8 @@ english.aff). Aspell and Hunspell don't have this limitation.") "Non-nil if we can use Aspell extensions.") (defvar ispell-really-hunspell nil "Non-nil if we can use Hunspell extensions.") +(defvar ispell-really-enchant nil + "Non-nil if we can use Enchant extensions.") (defvar ispell-encoding8-command nil "Command line option prefix to select encoding if supported, nil otherwise. If setting the encoding is supported by spellchecker and is selectable from @@ -739,17 +745,26 @@ Otherwise returns the library directory name, if that is defined." (and (search-forward-regexp "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t) + (match-string 1))) + (setq ispell-really-enchant + (and (search-forward-regexp + "(but really Enchant \\([0-9]+\\.[0-9\\.-]+\\)?)" + nil t) (match-string 1))))) (let* ((aspell8-minver "0.60") (ispell-minver "3.1.12") (hunspell8-minver "1.1.6") + (enchant-minver "2.1.0") (minver (cond ((not (version<= ispell-minver ispell-program-version)) ispell-minver) ((and ispell-really-aspell (not (version<= aspell8-minver ispell-really-aspell))) - aspell8-minver)))) + aspell8-minver) + ((and ispell-really-enchant + (not (version<= enchant-minver ispell-really-enchant))) + enchant-minver)))) (if minver (error "%s release %s or greater is required" @@ -1183,6 +1198,49 @@ dictionary from that list was found." (list dict)) ispell-hunspell-dictionary-alist :test #'equal)))) +;; Make ispell.el work better with enchant. + +(defvar ispell-enchant-dictionary-alist nil + "An alist of parsed Enchant dicts and associated parameters. +Internal use.") + +(defun ispell--call-enchant-lsmod (&rest args) + "Call enchant-lsmod with ARGS and return the output as string." + (with-output-to-string + (with-current-buffer + standard-output + (apply 'ispell-call-process + (concat ispell-program-name "-lsmod") nil t nil args)))) + +(defun ispell--get-extra-word-characters (&optional lang) + "Get the extra word characters for LANG as a character class. +If LANG is omitted, get the extra word characters for the default language." + (concat "[" (string-trim-right (apply 'ispell--call-enchant-lsmod + (append '("-word-chars") (if lang `(,lang))))) "]")) + +(defun ispell-find-enchant-dictionaries () + "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'." + (let* ((dictionaries + (split-string + (ispell--call-enchant-lsmod "-list-dicts" (buffer-string)) " ([^)]+)\n")) + (found + (mapcar #'(lambda (lang) + `(,lang "[[:alpha:]]" "[^[:alpha:]]" + ,(ispell--get-extra-word-characters) t nil nil utf-8)) + dictionaries))) + ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist + ;; which have no element in FOUND at all. + (dolist (dict ispell-dictionary-base-alist) + (unless (assoc (car dict) found) + (setq found (nconc found (list dict))))) + (setq ispell-enchant-dictionary-alist found) + ;; Add a default entry + (let ((default-dict + `(nil "[[:alpha:]]" "[^[:alpha:]]" + ,(ispell--get-extra-word-characters) + t nil nil utf-8))) + (push default-dict ispell-enchant-dictionary-alist)))) + ;; Set params according to the selected spellchecker (defvar ispell-last-program-name nil @@ -1208,7 +1266,7 @@ aspell is used along with Emacs).") (setq ispell-library-directory (ispell-check-version)) t) (error nil)) - ispell-encoding8-command) + (or ispell-encoding8-command ispell-really-enchant)) ;; auto-detection will only be used if spellchecker is not ;; ispell and supports a way to set communication to UTF-8. (if ispell-really-aspell @@ -1216,11 +1274,14 @@ aspell is used along with Emacs).") (ispell-find-aspell-dictionaries)) (if ispell-really-hunspell (or ispell-hunspell-dictionary-alist - (ispell-find-hunspell-dictionaries))))) + (ispell-find-hunspell-dictionaries)) + (if ispell-really-enchant + (or ispell-enchant-dictionary-alist + (ispell-find-enchant-dictionaries)))))) ;; Substitute ispell-dictionary-alist with the list of ;; dictionaries corresponding to the given spellchecker. - ;; If a recent aspell or hunspell, use the list of really + ;; With programs that support it, use the list of really ;; installed dictionaries and add to it elements of the original ;; list that are not present there. Allow distro info. (let ((found-dicts-alist @@ -1229,17 +1290,19 @@ aspell is used along with Emacs).") ispell-aspell-dictionary-alist (if ispell-really-hunspell ispell-hunspell-dictionary-alist)) - nil)) + (if ispell-really-enchant + ispell-enchant-dictionary-alist + nil))) (ispell-dictionary-base-alist ispell-dictionary-base-alist) ispell-base-dicts-override-alist ; Override only base-dicts-alist all-dicts-alist) ;; While ispell and aspell (through aliases) use the traditional - ;; dict naming originally expected by ispell.el, hunspell - ;; uses locale based names with no alias. We need to map + ;; dict naming originally expected by ispell.el, hunspell & Enchant + ;; use locale-based names with no alias. We need to map ;; standard names to locale based names to make default dict - ;; definitions available for hunspell. - (if ispell-really-hunspell + ;; definitions available to these programs. + (if (or ispell-really-hunspell ispell-really-enchant) (let (tmp-dicts-alist) (dolist (adict ispell-dictionary-base-alist) (let* ((dict-name (nth 0 adict)) @@ -1264,7 +1327,7 @@ aspell is used along with Emacs).") (setq ispell-args (nconc ispell-args (list "-d" dict-equiv))) (message - "ispell-set-spellchecker-params: Missing Hunspell equiv for \"%s\". Skipping." + "ispell-set-spellchecker-params: Missing equivalent for \"%s\". Skipping." dict-name) (setq skip-dict t))) @@ -1306,7 +1369,7 @@ aspell is used along with Emacs).") (nth 4 adict) ; many-otherchars-p (nth 5 adict) ; ispell-args (nth 6 adict) ; extended-character-mode - (if ispell-encoding8-command + (if (or ispell-encoding8-command ispell-really-enchant) 'utf-8 (nth 7 adict))) adict) @@ -1742,9 +1805,10 @@ and pass it the output of the last Ispell invocation." (erase-buffer))))))) (defun ispell-send-replacement (misspelled replacement) - "Notify Aspell that MISSPELLED should be spelled REPLACEMENT. -This allows improving the suggestion list based on actual misspellings." - (and ispell-really-aspell + "Notify spell checker that MISSPELLED should be spelled REPLACEMENT. +This allows improving the suggestion list based on actual misspellings. +Only works for Aspell and Enchant." + (and (or ispell-really-aspell ispell-really-enchant) (ispell-send-string (concat "$$ra " misspelled "," replacement "\n")))) commit dbd3a17cb068148bd49e288eb0b44ca7eb4a4e3c Author: Noam Postavsky Date: Thu Aug 10 20:43:13 2017 -0400 * lisp/term.el (term-mode): Use `window-text-height' (Bug#5615). diff --git a/lisp/term.el b/lisp/term.el index 5eb7b3e8ed..12a37cafbe 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1007,7 +1007,7 @@ Entry to this mode runs the hooks on `term-mode-hook'." (setq indent-tabs-mode nil) (setq buffer-display-table term-display-table) (set (make-local-variable 'term-home-marker) (copy-marker 0)) - (set (make-local-variable 'term-height) (1- (window-height))) + (set (make-local-variable 'term-height) (window-text-height)) (set (make-local-variable 'term-width) (window-max-chars-per-line)) (set (make-local-variable 'term-last-input-start) (make-marker)) (set (make-local-variable 'term-last-input-end) (make-marker)) commit 2326a3ab13d49f40115e9093bcf71d7d68c11772 Author: Noam Postavsky Date: Sat Aug 19 07:36:05 2017 -0400 Stop printing '4' in .elc files after 'define-symbol-prop' calls * lisp/emacs-lisp/bytecomp.el (byte-compile-define-symbol-prop): Return nil in case we have compiled the form, to prevent a redundant constant from getting added to the compiled output. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 9e14c91c95..d769a155aa 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4740,7 +4740,8 @@ binding slots have been popped." . (,prop ,val ,@(alist-get fun overriding-plist-environment))) overriding-plist-environment) (byte-compile-push-constant val) - (byte-compile-out 'byte-call 3))) + (byte-compile-out 'byte-call 3) + nil)) (_ (byte-compile-keep-pending form)))) commit 1b8d0fe44a38c91f5bb7a819749ea1c1aa8a5a5f Author: Paul Eggert Date: Sat Aug 19 17:57:00 2017 -0700 Change recent symlink tests to just test ASCII * test/src/fileio-tests.el (fileio-tests--symlink-failure): Be less ambitious about testing non-ASCII chars and encoding errors, as there are too many portability issues. diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index 75aca7d0ab..2ef1b553ab 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -32,11 +32,9 @@ (let* ((dir (make-temp-file "fileio" t)) (link (expand-file-name "link" dir))) (unwind-protect - (let ((failure - (let ((default-file-name-coding-system 'utf-8-unix)) - (try-char (unibyte-char-to-multibyte 128) link))) + (let (failure (char 0)) - (while (and (not failure) (< char 300)) + (while (and (not failure) (< char 127)) (setq char (1+ char)) (unless (= char ?~) (setq failure (try-char char link)))) commit 83f0d60e498c9cab59e098af6d9c403631ad645c Author: Paul Eggert Date: Sat Aug 19 17:15:52 2017 -0700 Don’t adjust CRLF in file names * doc/misc/gnus.texi (Non-ASCII Group Names): * etc/NEWS: * test/lisp/net/tramp-tests.el (tramp--test-utf8): Use utf-8-unix, not utf-8, for default-file-name-coding-system, so that CRLF in file names is left alone. * lisp/international/mule-cmds.el (set-default-coding-systems): Do not alter CRLF in file name coding systems. (prefer-coding-system): Ignore differences in CRLF processing when checking whether we used the user-specified file name coding system. * test/src/fileio-tests.el: New file. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index e00e173bc1..cd94156df3 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -4340,10 +4340,10 @@ does not necessarily need to be the same value that is determined by @code{gnus-group-name-charset-group-alist}. If @code{default-file-name-coding-system} or this variable is -initialized by default to @code{iso-latin-1} for example, although you +initialized by default to @code{iso-latin-1-unix} for example, although you want to subscribe to the groups spelled in Chinese, that is the most typical case where you have to customize -@code{nnmail-pathname-coding-system}. The @code{utf-8} coding system is +@code{nnmail-pathname-coding-system}. The @code{utf-8-unix} coding system is a good candidate for it. Otherwise, you may change the locale in your system so that @code{default-file-name-coding-system} or this variable may be initialized to an appropriate value. diff --git a/etc/NEWS b/etc/NEWS index 259b4ce86a..7774d75abb 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1197,6 +1197,12 @@ this variable. accepts Lisp symbols which begin with the following quotation characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. ++++ +** 'default-file-name-coding-system' now defaults to a coding system +that does not process CRLF. For example, it defaults to utf-8-unix +instead of to utf-8. Before this change, Emacs would sometimes +mishandle file names containing these control characters. + +++ ** Module functions are now implemented slightly differently; in particular, the function 'internal--module-call' has been removed. diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index ee31dea69e..338ca6a6e3 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -354,11 +354,12 @@ This also sets the following values: (if (eq system-type 'darwin) ;; The file-name coding system on Darwin systems is always utf-8. - (setq default-file-name-coding-system 'utf-8) + (setq default-file-name-coding-system 'utf-8-unix) (if (and (default-value 'enable-multibyte-characters) (or (not coding-system) (coding-system-get coding-system 'ascii-compatible-p))) - (setq default-file-name-coding-system coding-system))) + (setq default-file-name-coding-system + (coding-system-change-eol-conversion coding-system 'unix)))) (setq default-terminal-coding-system coding-system) ;; Prevent default-terminal-coding-system from converting ^M to ^J. (setq default-keyboard-coding-system @@ -414,7 +415,7 @@ To prefer, for instance, utf-8, say the following: (coding-system-change-eol-conversion base eol-type))) (set-default-coding-systems base) (if (called-interactively-p 'interactive) - (or (eq base default-file-name-coding-system) + (or (eq base (coding-system-type default-file-name-coding-system)) (message "The default value of `file-name-coding-system' was not changed because the specified coding system is not suitable for file names."))))) (defvar sort-coding-systems-predicate nil @@ -1797,9 +1798,9 @@ The default status is as follows: (set-default-coding-systems nil) (setq default-sendmail-coding-system 'iso-latin-1) - ;; On Darwin systems, this should be utf-8, but when this file is loaded - ;; utf-8 is not yet defined, so we set it in set-locale-environment instead. - (setq default-file-name-coding-system 'iso-latin-1) + ;; On Darwin systems, this should be utf-8-unix, but when this file is loaded + ;; that is not yet defined, so we set it in set-locale-environment instead. + (setq default-file-name-coding-system 'iso-latin-1-unix) ;; Preserve eol-type from existing default-process-coding-systems. ;; On non-unix-like systems in particular, these may have been set ;; carefully by the user, or by the startup code, to deal with the @@ -2722,7 +2723,7 @@ See also `locale-charset-language-names', `locale-language-names', (when (eq system-type 'darwin) ;; On Darwin, file names are always encoded in utf-8, no matter ;; the locale. - (setq default-file-name-coding-system 'utf-8) + (setq default-file-name-coding-system 'utf-8-unix) ;; macOS's Terminal.app by default uses utf-8 regardless of ;; the locale. (when (and (null window-system) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 9d2598ac03..9dc276b2a9 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3719,7 +3719,8 @@ Use the `ls' command." 'utf-8-hfs 'utf-8)) (coding-system-for-read utf8) (coding-system-for-write utf8) - (file-name-coding-system utf8)) + (file-name-coding-system + (coding-system-change-eol-conversion utf8 'unix))) (tramp--test-check-files (unless (tramp--test-hpux-p) "Γυρίστε το Γαλαξία με Ώτο Στοπ") (unless (tramp--test-hpux-p) diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el new file mode 100644 index 0000000000..75aca7d0ab --- /dev/null +++ b/test/src/fileio-tests.el @@ -0,0 +1,49 @@ +;;; unit tests for src/fileio.c -*- lexical-binding: t; -*- + +;; Copyright 2017 Free Software Foundation, Inc. + +;; 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 . + +(require 'ert) + +(defun try-char (char link) + (let ((target (string char))) + (make-symbolic-link target link) + (let* ((read-link (file-symlink-p link)) + (failure (unless (string-equal target read-link) + (list 'string-equal target read-link)))) + (delete-file link) + failure))) + +(defun fileio-tests--symlink-failure () + (let* ((dir (make-temp-file "fileio" t)) + (link (expand-file-name "link" dir))) + (unwind-protect + (let ((failure + (let ((default-file-name-coding-system 'utf-8-unix)) + (try-char (unibyte-char-to-multibyte 128) link))) + (char 0)) + (while (and (not failure) (< char 300)) + (setq char (1+ char)) + (unless (= char ?~) + (setq failure (try-char char link)))) + failure) + (delete-directory dir t)))) + +(ert-deftest fileio-tests--odd-symlink-chars () + "Check that any non-NULL ASCII character can appear in a symlink. +Also check that an encoding error can appear in a symlink." + (should (equal nil (fileio-tests--symlink-failure)))) commit 1c382c096b8b7d1fa995e6131b887d9128085c68 Author: Eli Zaretskii Date: Sat Aug 19 16:36:31 2017 +0300 Make list-processes support display-line-numbers * lisp/simple.el (process-menu-mode): Move the call to tabulated-list-init-header from here... (list-processes--refresh): ...to here. (Bug#27895) diff --git a/lisp/simple.el b/lisp/simple.el index 58f8372192..072723cd64 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3928,8 +3928,7 @@ support pty association, if PROGRAM is nil." ("Command" 0 t)]) (make-local-variable 'process-menu-query-only) (setq tabulated-list-sort-key (cons "Process" nil)) - (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t) - (tabulated-list-init-header)) + (add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)) (defun process-menu-delete-process () "Kill process at point in a `list-processes' buffer." @@ -3990,7 +3989,8 @@ Also, delete any process that is exited or signaled." ""))))) (mapconcat 'identity (process-command p) " ")))) (push (list p (vector name pid status buf-label tty cmd)) - tabulated-list-entries)))))) + tabulated-list-entries))))) + (tabulated-list-init-header)) (defun process-menu-visit-buffer (button) (display-buffer (button-get button 'process-buffer))) commit 2c7721373836633557975cc583677dfd8997e764 Author: Eli Zaretskii Date: Sat Aug 19 14:05:51 2017 +0300 Improve support of display-line-numbers in package.el * lisp/emacs-lisp/package.el (package-menu--refresh): Redisplay the header. (Bug#27895) * lisp/emacs-lisp/tabulated-list.el (tabulated-list-line-number-width): Fix the case when display-line-numbers is nil. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 4245294457..2404ccd14e 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2751,6 +2751,7 @@ KEYWORDS should be nil or a list of keywords." (push pkg info-list)))))) ;; Print the result. + (tabulated-list-init-header) (setq tabulated-list-entries (mapcar #'package-menu--print-info-simple info-list)))) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index f900354b3f..6844c25b1a 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -191,11 +191,13 @@ Populated by `tabulated-list-init-header'.") ;; line-number-display-width returns the value for the selected ;; window, which might not be the window in which the current buffer ;; is displayed. - (let ((cbuf-window (get-buffer-window (current-buffer)))) - (if (window-live-p cbuf-window) - (with-selected-window cbuf-window - (+ (line-number-display-width) 2)) - (if display-line-numbers 4 0)))) + (if (not display-line-numbers) + 0 + (let ((cbuf-window (get-buffer-window (current-buffer)))) + (if (window-live-p cbuf-window) + (with-selected-window cbuf-window + (+ (line-number-display-width) 2)) + 4)))) (defun tabulated-list-init-header () "Set up header line for the Tabulated List buffer." commit 5070717802d9be51085d187a10a5f4930b9a1471 Author: Eli Zaretskii Date: Sat Aug 19 13:52:02 2017 +0300 ; Fix last change * lisp/emacs-lisp/tabulated-list.el (tabulated-list-line-number-width): Fix last change. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index a0a74ce7f9..f900354b3f 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -195,7 +195,7 @@ Populated by `tabulated-list-init-header'.") (if (window-live-p cbuf-window) (with-selected-window cbuf-window (+ (line-number-display-width) 2)) - 4))) + (if display-line-numbers 4 0)))) (defun tabulated-list-init-header () "Set up header line for the Tabulated List buffer." @@ -422,11 +422,12 @@ of column descriptors." (let ((beg (point)) (x (max tabulated-list-padding 0)) (ncols (length tabulated-list-format)) + (lnum-width (tabulated-list-line-number-width)) (inhibit-read-only t)) (if display-line-numbers - (setq x (+ x (tabulated-list-line-number-width)))) + (setq x (+ x lnum-width))) (if (> tabulated-list-padding 0) - (insert (make-string x ?\s))) + (insert (make-string (- x lnum-width) ?\s))) (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). (or (bound-and-true-p tabulated-list--near-rows) (list (or (tabulated-list-get-entry (point-at-bol 0)) commit 1e2fbb5e6345591cfe618fea90ac1ff8f82f3d33 Author: Eli Zaretskii Date: Sat Aug 19 13:37:31 2017 +0300 Improve support of display-line-numbers in tabulated-list-mode * lisp/emacs-lisp/tabulated-list.el (tabulated-list-line-number-width): New function. (tabulated-list-init-header, tabulated-list-print-entry): Use it. (Bug#27895) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 955b664b8c..a0a74ce7f9 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -186,6 +186,17 @@ If ADVANCE is non-nil, move forward by one line afterwards." Populated by `tabulated-list-init-header'.") (defvar tabulated-list--header-overlay nil) +(defun tabulated-list-line-number-width () + "Return the width taken by display-line-numbers in the current buffer." + ;; line-number-display-width returns the value for the selected + ;; window, which might not be the window in which the current buffer + ;; is displayed. + (let ((cbuf-window (get-buffer-window (current-buffer)))) + (if (window-live-p cbuf-window) + (with-selected-window cbuf-window + (+ (line-number-display-width) 2)) + 4))) + (defun tabulated-list-init-header () "Set up header line for the Tabulated List buffer." ;; FIXME: Should share code with tabulated-list-print-col! @@ -195,7 +206,7 @@ Populated by `tabulated-list-init-header'.") keymap ,tabulated-list-sort-button-map)) (cols nil)) (if display-line-numbers - (setq x (+ x (line-number-display-width) 2))) + (setq x (+ x (tabulated-list-line-number-width)))) (push (propertize " " 'display `(space :align-to ,x)) cols) (dotimes (n (length tabulated-list-format)) (let* ((col (aref tabulated-list-format n)) @@ -413,7 +424,7 @@ of column descriptors." (ncols (length tabulated-list-format)) (inhibit-read-only t)) (if display-line-numbers - (setq x (+ x (line-number-display-width) 2))) + (setq x (+ x (tabulated-list-line-number-width)))) (if (> tabulated-list-padding 0) (insert (make-string x ?\s))) (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). commit 3baf2d840f90a86acd9c6180179e127d8e715897 Author: Martin Rudalics Date: Sat Aug 19 11:23:10 2017 +0200 Fix one more issue reported by Alex (Bug#27999) * doc/lispref/windows.texi (Preserving Window Sizes) (Window Parameters): Use the term `window-preserved-size' instead of `preserved-size' (Bug#27999). diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 0df8e5ee04..5014cd3d82 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1085,7 +1085,7 @@ by that function is preserved. @end table @code{window-preserve-size} installs a window parameter (@pxref{Window -Parameters}) called @code{preserved-size} which is consulted by the +Parameters}) called @code{window-preserved-size} which is consulted by the window resizing functions. This parameter will not prevent resizing the window when the window shows another buffer than the one when @code{window-preserve-size} was invoked or if its size has changed since @@ -5016,8 +5016,8 @@ This parameter specifies the window that this one has been cloned from. It is installed by @code{window-state-get} (@pxref{Window Configurations}). -@item preserved-size -@vindex preserved-size, a window parameter +@item window-preserved-size +@vindex window-preserved-size, a window parameter This parameter specifies a buffer, a direction where @code{nil} means vertical and @code{t} horizontal, and a size in pixels. If this window displays the specified buffer and its size in the indicated direction commit f0d5dcc41b680e3b09df93e1be3c663248d160b1 Author: Martin Rudalics Date: Sat Aug 19 10:58:25 2017 +0200 Rename `no-delete-other-window' to `no-delete-other-windows' diff --git a/etc/NEWS b/etc/NEWS index 54be0fca4a..259b4ce86a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1568,7 +1568,7 @@ a new window when opening man pages when there's already one, use (mode . Man-mode)))) +++ -*** New window parameter 'no-delete-other-window' prevents that +*** New window parameter 'no-delete-other-windows' prevents that its window gets deleted by 'delete-other-windows'. +++ commit 8a9905e2f723d757f1a75d2b45855f7fb1074632 Author: Martin Rudalics Date: Sat Aug 19 10:55:04 2017 +0200 Fix two side window problems noted by Alex (Bug#27999) * lisp/window.el (display-buffer-in-side-window): Fix doc-string typo. (delete-other-windows): Rename the `no-delete-other-window' parameter to `no-delete-other-windows' (see the discussion in Bug#27999 for the rationale of this change). * doc/lispref/windows.texi (Deleting Windows) (Frame Layouts with Side Windows, Window Parameters): Rename `no-delete-other-window' to `no-delete-other-windows'. diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index eb5c2fc46b..0df8e5ee04 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -1319,8 +1319,8 @@ argument @var{window}, in lieu of the usual action of @code{delete-other-windows}. @xref{Window Parameters}. Also, if @code{ignore-window-parameters} is @code{nil}, this function -does not delete any window whose @code{no-delete-other-window} parameter -is non-@code{nil}. +does not delete any window whose @code{no-delete-other-windows} +parameter is non-@code{nil}. @end deffn @deffn Command delete-windows-on &optional buffer-or-name frame @@ -3381,7 +3381,7 @@ producing the frame layout sketched above. @example @group (defvar parameters - '(window-parameters . ((no-other-window . t) (no-delete-other-window . t)))) + '(window-parameters . ((no-other-window . t) (no-delete-other-windows . t)))) (setq fit-window-to-buffer-horizontally t) (setq window-resize-pixelwise t) @@ -3423,7 +3423,7 @@ retain their respective sizes when maximizing the frame, the variable are accessible via @kbd{C-x o} by installing the @code{no-other-window} parameter for each of these windows. In addition, it makes sure that side windows are not deleted via @kbd{C-x 1} by installing the -@code{no-delete-other-window} parameter for each of these windows. +@code{no-delete-other-windows} parameter for each of these windows. Since @code{dired} buffers have no fixed names, we use a special function @code{dired-default-directory-on-left} in order to display a @@ -4990,8 +4990,8 @@ This parameter affects the execution of @code{delete-window} This parameter affects the execution of @code{delete-other-windows} (@pxref{Deleting Windows}). -@item no-delete-other-window -@vindex no-delete-other-window, a window parameter +@item no-delete-other-windows +@vindex no-delete-other-windows, a window parameter This parameter marks the window as not deletable by @code{delete-other-windows} (@pxref{Deleting Windows}). diff --git a/lisp/window.el b/lisp/window.el index f1c82c759d..7aea9ae739 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -999,7 +999,7 @@ for displaying BUFFER, nil if no suitable window can be found. This function installs the `window-side' and `window-slot' parameters and makes them persistent. It neither modifies ALIST nor installs any other window parameters unless they have been -explicitly provided via a `window-parameter' entry in ALIST." +explicitly provided via a `window-parameters' entry in ALIST." (let* ((side (or (cdr (assq 'side alist)) 'bottom)) (slot (or (cdr (assq 'slot alist)) 0)) (left-or-right (memq side '(left right))) @@ -4106,7 +4106,7 @@ Else, if WINDOW is part of an atomic window, call this function with the root of the atomic window as its argument. Signal an error if that root window is the root window of WINDOW's frame. Also signal an error if WINDOW is a side window. Do not delete -any window whose `no-delete-other-window' parameter is non-nil." +any window whose `no-delete-other-windows' parameter is non-nil." (interactive) (setq window (window-normalize-window window)) (let* ((frame (window-frame window)) @@ -4137,17 +4137,17 @@ any window whose `no-delete-other-window' parameter is non-nil." (cond ((or ignore-window-parameters - (not (window-with-parameter 'no-delete-other-window nil frame))) + (not (window-with-parameter 'no-delete-other-windows nil frame))) (setq main (frame-root-window frame))) ((catch 'tag (walk-window-tree (lambda (other) (when (or (and (window-parameter other 'window-side) (not (window-parameter - other 'no-delete-other-window))) + other 'no-delete-other-windows))) (and (not (window-parameter other 'window-side)) (window-parameter - other 'no-delete-other-window))) + other 'no-delete-other-windows))) (throw 'tag nil)))) t) (setq main (window-main-window frame))) @@ -4158,7 +4158,7 @@ any window whose `no-delete-other-window' parameter is non-nil." (when (and (window-live-p other) (not (eq other window)) (not (window-parameter - other 'no-delete-other-window)) + other 'no-delete-other-windows)) ;; When WINDOW and the other window are part of the ;; same atomic window, don't delete the other. (or (not atom-root) commit 82b05985ba55761c497810cf9e14fd530253a1b2 Author: Alex Schroeder Date: Sat Aug 19 10:39:37 2017 +0200 Use define-minor-mode for rcirc-omit-mode diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index ddff25c1e9..c01ece9641 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -176,10 +176,30 @@ underneath each nick." "If non-nil, activity in this buffer is considered low priority.") (make-variable-buffer-local 'rcirc-low-priority-flag) -(defvar rcirc-omit-mode nil - "Non-nil if Rcirc-Omit mode is enabled. -Use the command `rcirc-omit-mode' to change this variable.") -(make-variable-buffer-local 'rcirc-omit-mode) +(defcustom rcirc-omit-responses + '("JOIN" "PART" "QUIT" "NICK") + "Responses which will be hidden when `rcirc-omit-mode' is enabled." + :type '(repeat string) + :group 'rcirc) + +(define-minor-mode rcirc-omit-mode + "Toggle the hiding of \"uninteresting\" lines. +With a prefix argument ARG, enable Rcirc-Omit mode if ARG is +positive, and disable it otherwise. If called from Lisp, enable +the mode if ARG is omitted or nil. + +Uninteresting lines are those whose responses are listed in +`rcirc-omit-responses'." + nil " Omit" nil + (if rcirc-omit-mode + (progn + (add-to-invisibility-spec '(rcirc-omit . nil)) + (message "Rcirc-Omit mode enabled")) + (remove-from-invisibility-spec '(rcirc-omit . nil)) + (message "Rcirc-Omit mode disabled")) + (dolist (window (get-buffer-window-list (current-buffer))) + (with-selected-window window + (recenter (when (> (point) rcirc-prompt-start-marker) -1))))) (defcustom rcirc-time-format "%H:%M " "Describes how timestamps are printed. @@ -1405,12 +1425,6 @@ the of the following escape sequences replaced by the described values: :value-type string) :group 'rcirc) -(defcustom rcirc-omit-responses - '("JOIN" "PART" "QUIT" "NICK") - "Responses which will be hidden when `rcirc-omit-mode' is enabled." - :type '(repeat string) - :group 'rcirc) - (defun rcirc-format-response-string (process sender response target text) "Return a nicely-formatted response string, incorporating TEXT \(and perhaps other arguments). The specific formatting used @@ -1881,9 +1895,6 @@ if ARG is omitted or nil." (or (assq 'rcirc-low-priority-flag minor-mode-alist) (setq minor-mode-alist (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist))) -(or (assq 'rcirc-omit-mode minor-mode-alist) - (setq minor-mode-alist - (cons '(rcirc-omit-mode " Omit") minor-mode-alist))) (defun rcirc-toggle-ignore-buffer-activity () "Toggle the value of `rcirc-ignore-buffer-activity-flag'." @@ -1905,23 +1916,6 @@ if ARG is omitted or nil." "Activity in this buffer is normal priority")) (force-mode-line-update)) -(defun rcirc-omit-mode () - "Toggle the Rcirc-Omit mode. -If enabled, \"uninteresting\" lines are not shown. -Uninteresting lines are those whose responses are listed in -`rcirc-omit-responses'." - (interactive) - (setq rcirc-omit-mode (not rcirc-omit-mode)) - (if rcirc-omit-mode - (progn - (add-to-invisibility-spec '(rcirc-omit . nil)) - (message "Rcirc-Omit mode enabled")) - (remove-from-invisibility-spec '(rcirc-omit . nil)) - (message "Rcirc-Omit mode disabled")) - (dolist (window (get-buffer-window-list (current-buffer))) - (with-selected-window window - (recenter (when (> (point) rcirc-prompt-start-marker) -1))))) - (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) commit e58b3ef78b7db5190bd940495da6de0b6737f955 Author: Paul Eggert Date: Sat Aug 19 00:48:28 2017 -0700 Clarify behavior of symlinks and directories * doc/lispref/files.texi (Saving Buffers): Document how functions like rename-file work with symlinks and directories. This patch attempts to document the current behavior better, in preparation for possibly changing it. See Bug#27986. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 9359d3eaa0..5a52765131 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -401,6 +401,8 @@ If @var{confirm} is non-@code{nil}, that means to ask for confirmation before overwriting an existing file. Interactively, confirmation is required, unless the user supplies a prefix argument. +@c FIXME: This disagrees with the doc string, which talks about +@c directory names, not directories. See Bug#27986. If @var{filename} is an existing directory, or a symbolic link to one, @code{write-file} uses the name of the visited file, in directory @var{filename}. If the buffer is not visiting a file, it uses the @@ -628,7 +630,10 @@ If @var{mustbenew} is non-@code{nil}, then @code{write-region} asks for confirmation if @var{filename} names an existing file. If @var{mustbenew} is the symbol @code{excl}, then @code{write-region} does not ask for confirmation, but instead it signals an error -@code{file-already-exists} if the file already exists. +@code{file-already-exists} if the file already exists. Although +@code{write-region} normally follows a symbolic link and creates the +pointed-to file if the symbolic link is dangling, it does not follow +symbolic links if @var{mustbenew} is @code{excl}. The test for an existing file, when @var{mustbenew} is @code{excl}, uses a special system feature. At least for files on a local disk, there is @@ -817,9 +822,7 @@ are silently and automatically ignored. These functions test for permission to access a file for reading, writing, or execution. Unless explicitly stated otherwise, they -recursively follow symbolic links for their file name arguments, at -all levels (at the level of the file itself and at all levels of -parent directories). +follow symbolic links. @xref{Kinds of Files}. On some operating systems, more complex sets of access permissions can be specified, via mechanisms such as Access Control Lists (ACLs). @@ -838,8 +841,8 @@ If the file does not exist, or if access control policies prevent you from finding its attributes, this function returns @code{nil}. Directories are files, so @code{file-exists-p} returns @code{t} when -given a directory name. However, symbolic links are treated -specially; @code{file-exists-p} returns @code{t} for a symbolic link +given a directory name. However, because @code{file-exists-p} follows +symbolic links, it returns @code{t} for a symbolic link name only if the target file exists. @end defun @@ -906,10 +909,7 @@ returns @code{t} for nonexistent files. If the optional argument @var{group} is non-@code{nil}, this function also checks that the file's group would be unchanged. -If @var{filename} is a symbolic link, then, unlike the other functions -discussed here, @code{file-ownership-preserved-p} does @emph{not} -replace @var{filename} with its target. However, it does recursively -follow symbolic links at all levels of parent directories. +This function does not follow symbolic links. @end defun @defun file-modes filename @@ -919,8 +919,8 @@ follow symbolic links at all levels of parent directories. @cindex file modes This function returns the @dfn{mode bits} of @var{filename}---an integer summarizing its read, write, and execution permissions. -Symbolic links in @var{filename} are recursively followed at all -levels. If the file does not exist, the return value is @code{nil}. +This function follows symbolic links. If the file does not exist, the +return value is @code{nil}. @xref{File permissions,,, coreutils, The @sc{gnu} @code{Coreutils} Manual}, for a description of mode bits. For example, if the @@ -971,19 +971,26 @@ Unix. These conventions are also followed by @code{file-attributes} @subsection Distinguishing Kinds of Files @cindex file classification @cindex classification of file types +@cindex symbolic links This section describes how to distinguish various kinds of files, such as directories, symbolic links, and ordinary files. + Symbolic links are ordinarily followed wherever they appear. For +example, to interpret the file name @file{a/b/c}, any of @file{a}, +@file{a/b}, and @file{a/b/c} can be symbolic links that are followed, +possibly recursively if the link targets are themselves symbolic +links. However, a few functions do not follow symbolic links at the +end of a file name (@file{a/b/c} in this example). Such a function +is said to @dfn{not follow symbolic links}. + @defun file-symlink-p filename -@cindex file symbolic links -If the file @var{filename} is a symbolic link, the -@code{file-symlink-p} function returns its (non-recursive) link target +@cindex symbolic links +If the file @var{filename} is a symbolic link, this function does not +follow it and instead returns its link target as a string. (The link target string is not necessarily the full absolute file name of the target; determining the full file name that -the link points to is nontrivial, see below.) If the leading -directories of @var{filename} include symbolic links, this function -recursively follows them. +the link points to is nontrivial, see below.) If the file @var{filename} is not a symbolic link, or does not exist, @code{file-symlink-p} returns @code{nil}. @@ -1011,9 +1018,9 @@ Here are a few examples of using this function: Note that in the third example, the function returned @file{sym-link}, but did not proceed to resolve it, although that file is itself a -symbolic link. This is what we meant by ``non-recursive'' above---the -process of following the symbolic links does not recurse if the link -target is itself a link. +symbolic link. That is because this function does not follow symbolic +links---the process of following the symbolic links does not apply to +the last component of the file name. The string that this function returns is what is recorded in the symbolic link; it may or may not include any leading directories. @@ -1044,12 +1051,10 @@ link. If you actually need the file name of the link target, use @ref{Truenames}. @end defun -The next two functions recursively follow symbolic links at -all levels for @var{filename}. - @defun file-directory-p filename This function returns @code{t} if @var{filename} is the name of an existing directory, @code{nil} otherwise. +This function follows symbolic links. @example @group @@ -1080,6 +1085,7 @@ existing directory, @code{nil} otherwise. This function returns @code{t} if the file @var{filename} exists and is a regular file (not a directory, named pipe, terminal, or other I/O device). +This function follows symbolic links. @end defun @node Truenames @@ -1231,15 +1237,11 @@ on the 19th, @file{aug-20} was written on the 20th, and the file @end example @end defun - If the @var{filename} argument to the next two functions is a -symbolic link, then these function do @emph{not} replace it with its -target. However, they both recursively follow symbolic links at all -levels of parent directories. - @defun file-attributes filename &optional id-format @anchor{Definition of file-attributes} This function returns a list of attributes of file @var{filename}. If -the specified file cannot be opened, it returns @code{nil}. +the specified file's attributes cannot be accessed, it returns @code{nil}. +This function does not follow symbolic links. The optional parameter @var{id-format} specifies the preferred format of attributes @acronym{UID} and @acronym{GID} (see below)---the valid values are @code{'string} and @code{'integer}. The latter is @@ -1391,7 +1393,7 @@ This function returns the number of names (i.e., hard links) that file @var{filename} has. If the file does not exist, this function returns @code{nil}. Note that symbolic links have no effect on this function, because they are not considered to be names of the files -they link to. +they link to. This function does not follow symbolic links. @example @group @@ -1553,6 +1555,16 @@ a @code{file-missing} error instead. made by these functions instead of writing them immediately to secondary storage. @xref{Files and Storage}. +@c FIXME: This paragraph is purposely silent on what happens if +@c @var{newname} is not a directory name but happens to name a +@c directory. See Bug#27986 for discussion on how to clear this up. + In the functions that have an argument @var{newname}, if this +argument is a directory name it is treated as if the nondirectory part +of the source name were appended. Typically, a directory name is one +that ends in @samp{/} (@pxref{Directory Names}). For example, if the +old name is @file{a/b/c}, the @var{newname} @file{d/e/f/} is treated +as if it were @file{d/e/f/c}. + In the functions that have an argument @var{newname}, if a file by the name of @var{newname} already exists, the actions taken depend on the value of the argument @var{ok-if-already-exists}: @@ -1570,11 +1582,6 @@ Replace the old file without confirmation if @var{ok-if-already-exists} is any other value. @end itemize -The next four commands all recursively follow symbolic links at all -levels of parent directories for their first argument, but, if that -argument is itself a symbolic link, then only @code{copy-file} -replaces it with its (recursive) target. - @deffn Command add-name-to-file oldname newname &optional ok-if-already-exists @cindex file with multiple names @cindex file hard link @@ -1582,6 +1589,14 @@ This function gives the file named @var{oldname} the additional name @var{newname}. This means that @var{newname} becomes a new hard link to @var{oldname}. +If @var{newname} is a symbolic link, its directory entry is replaced, +not the directory entry it points to. If @var{oldname} is a symbolic +link, this function might or might not follow the link; it does not +follow the link on GNU platforms. If @var{oldname} is a directory, +this function typically fails, although for the superuser on a few +old-fashioned non-GNU platforms it can succeed and create a filesystem +that is not tree-structured. + In the first part of the following example, we list two files, @file{foo} and @file{foo3}. @@ -1649,14 +1664,34 @@ This command renames the file @var{filename} as @var{newname}. If @var{filename} has additional names aside from @var{filename}, it continues to have those names. In fact, adding the name @var{newname} with @code{add-name-to-file} and then deleting @var{filename} has the -same effect as renaming, aside from momentary intermediate states. +same effect as renaming, aside from momentary intermediate states and +treatment of errors, directories and symbolic links. + +This command does not follow symbolic links. If @var{filename} is a +symbolic link, this command renames the symbolic link, not the file it +points to. If @var{newname} is a symbolic link, its directory entry +is replaced, not the directory entry it points to. + +This command does nothing if @var{filename} and @var{newname} are the +same directory entry, i.e., if they refer to the same parent directory +and give the same name within that directory. Otherwise, if +@var{filename} and @var{newname} name the same file, this command does +nothing on POSIX-conforming systems, and removes @var{filename} on +some non-POSIX systems. + +If @var{newname} exists, then it must be an empty directory if +@var{oldname} is a directory and a non-directory otherwise. @end deffn @deffn Command copy-file oldname newname &optional ok-if-already-exists time preserve-uid-gid preserve-extended-attributes This command copies the file @var{oldname} to @var{newname}. An -error is signaled if @var{oldname} does not exist. If @var{newname} +error is signaled if @var{oldname} is not a regular file. If @var{newname} names a directory, it copies @var{oldname} into that directory, preserving its final name component. +@c FIXME: See Bug#27986 for how the previous sentence might change. + +This function follows symbolic links, except that it does not follow a +dangling symbolic link to create @var{newname}. If @var{time} is non-@code{nil}, then this function gives the new file the same last-modified time that the old one has. (This works on only @@ -1689,7 +1724,11 @@ SELinux context are not copied over in either case. @kindex file-already-exists This command makes a symbolic link to @var{filename}, named @var{newname}. This is like the shell command @samp{ln -s -@var{filename} @var{newname}}. +@var{filename} @var{newname}}. The @var{filename} argument +is treated only as a string; it need not name an existing file. +If @var{filename} is a relative file name, the resulting symbolic link +is interpreted relative to the directory containing the symbolic link. +@xref{Relative File Names}. This function is not available on systems that don't support symbolic links. @@ -1702,8 +1741,7 @@ links. This command deletes the file @var{filename}. If the file has multiple names, it continues to exist under the other names. If @var{filename} is a symbolic link, @code{delete-file} deletes only the -symbolic link and not its target (though it does follow symbolic links -at all levels of parent directories). +symbolic link and not its target. A suitable kind of @code{file-error} error is signaled if the file does not exist, or is not deletable. (On Unix and GNU/Linux, a file @@ -1724,8 +1762,7 @@ See also @code{delete-directory} in @ref{Create/Delete Dirs}. @cindex file modes, setting @deffn Command set-file-modes filename mode This function sets the @dfn{file mode} (or @dfn{permissions}) of -@var{filename} to @var{mode}. It recursively follows symbolic links -at all levels for @var{filename}. +@var{filename} to @var{mode}. This function follows symbolic links. If called non-interactively, @var{mode} must be an integer. Only the lowest 12 bits of the integer are used; on most systems, only the commit 6763399ef3f268269fefd75d7c7a4ac012f66833 Author: Paul Eggert Date: Fri Aug 18 23:52:19 2017 -0700 Fix recently-introduced file descriptor leak * src/fileio.c (Fmake_temp_file_internal): Don’t leak a file descriptor if write_region signals an error. diff --git a/src/fileio.c b/src/fileio.c index 6b3bdf2154..f954ac12b5 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -693,10 +693,14 @@ This function does not grok magic file names. */) bool failed = fd < 0; if (!failed) { + ptrdiff_t count = SPECPDL_INDEX (); + record_unwind_protect_int (close_file_unwind, fd); val = DECODE_FILE (val); if (STRINGP (text) && SBYTES (text) != 0) write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd); failed = NILP (dir_flag) && emacs_close (fd) != 0; + /* Discard the unwind protect. */ + specpdl_ptr = specpdl + count; } if (failed) { commit e73691e1a47834aff367c9131fc3c7d78751d821 Author: Paul Eggert Date: Fri Aug 18 20:36:10 2017 -0700 Improve make-temp-file performance on local files * lisp/files.el (make-temp-file): Let make-temp-file-internal do the work of inserting the text. * src/fileio.c (Fmake_temp_file_internal): New arg TEXT. All callers changed. diff --git a/lisp/files.el b/lisp/files.el index a2b474f8d2..0311cc6d21 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1404,24 +1404,20 @@ of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created file. You can then use `write-region' to write new data into the file. -If TEXT is non-nil, it will be inserted in the new file. Otherwise -the file will be empty. - If DIR-FLAG is non-nil, create a new empty directory instead of a file. -If SUFFIX is non-nil, add that at the end of the file name." +If SUFFIX is non-nil, add that at the end of the file name. + +If TEXT is a string, insert it into the new file; DIR-FLAG should be nil. +Otherwise the file will be empty." (let ((absolute-prefix (if (or (zerop (length prefix)) (member prefix '("." ".."))) (concat (file-name-as-directory temporary-file-directory) prefix) - (expand-file-name prefix temporary-file-directory))) - (contents (if (stringp text) text ""))) + (expand-file-name prefix temporary-file-directory)))) (if (find-file-name-handler absolute-prefix 'write-region) - (files--make-magic-temp-file absolute-prefix dir-flag suffix contents) - (let ((file (make-temp-file-internal absolute-prefix - (if dir-flag t) (or suffix "")))) - (when (and (stringp text) (not dir-flag)) - (write-region contents nil file nil 'silent)) - file)))) + (files--make-magic-temp-file absolute-prefix dir-flag suffix text) + (make-temp-file-internal absolute-prefix + (if dir-flag t) (or suffix "") text)))) (defun files--make-magic-temp-file (absolute-prefix &optional dir-flag suffix text) diff --git a/src/fileio.c b/src/fileio.c index 1b832be344..6b3bdf2154 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -657,18 +657,20 @@ In Unix-syntax, this function just removes the final slash. */) } DEFUN ("make-temp-file-internal", Fmake_temp_file_internal, - Smake_temp_file_internal, 3, 3, 0, + Smake_temp_file_internal, 4, 4, 0, doc: /* Generate a new file whose name starts with PREFIX, a string. Return the name of the generated file. If DIR-FLAG is zero, do not create the file, just its name. Otherwise, if DIR-FLAG is non-nil, create an empty directory. The file name should end in SUFFIX. Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs -working directory. +working directory. If TEXT is a string, insert it into the newly +created file. Signal an error if the file could not be created. This function does not grok magic file names. */) - (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix) + (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix, + Lisp_Object text) { CHECK_STRING (prefix); CHECK_STRING (suffix); @@ -688,7 +690,15 @@ This function does not grok magic file names. */) : EQ (dir_flag, make_number (0)) ? GT_NOCREATE : GT_DIR); int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind); - if (fd < 0 || (NILP (dir_flag) && emacs_close (fd) != 0)) + bool failed = fd < 0; + if (!failed) + { + val = DECODE_FILE (val); + if (STRINGP (text) && SBYTES (text) != 0) + write_region (text, Qnil, val, Qnil, Qnil, Qnil, Qnil, fd); + failed = NILP (dir_flag) && emacs_close (fd) != 0; + } + if (failed) { static char const kind_message[][32] = { @@ -698,7 +708,7 @@ This function does not grok magic file names. */) }; report_file_error (kind_message[kind], prefix); } - return DECODE_FILE (val); + return val; } @@ -715,7 +725,7 @@ For that reason, you should normally use `make-temp-file' instead. */) (Lisp_Object prefix) { return Fmake_temp_file_internal (prefix, make_number (0), - empty_unibyte_string); + empty_unibyte_string, Qnil); } DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, diff --git a/src/filelock.c b/src/filelock.c index fec9bc044a..fd4f0aa864 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -210,7 +210,7 @@ get_boot_time (void) names up to 8 bytes long. Choose a 2 byte prefix, so the 6-byte suffix does not make the name too long. */ filename = Fmake_temp_file_internal (build_string ("wt"), Qnil, - empty_unibyte_string); + empty_unibyte_string, Qnil); CALLN (Fcall_process, build_string ("gzip"), Qnil, list2 (QCfile, filename), Qnil, build_string ("-cd"), tempname); commit e66e81679c3c91d6bf8f62c7abcd968430b4d1fe Author: Noam Postavsky Date: Mon Aug 7 08:56:42 2017 -0400 Don't lose arguments to eshell aliases (Bug#27954) * lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias): Use ARGS. diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index 5bf80b2310..990eb02024 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -225,7 +225,7 @@ file named by `eshell-aliases-file'.") (eshell-command-arguments ',eshell-last-arguments) (eshell-prevent-alias-expansion ',(cons command eshell-prevent-alias-expansion))) - ,(eshell-parse-command (nth 1 alias)))))))) + ,(eshell-parse-command (nth 1 alias) args))))))) (defun eshell-alias-completions (name) "Find all possible completions for NAME. commit 8ed64463005c9c94d6822229567717e48e5ee0c5 Author: Noam Postavsky Date: Fri Aug 18 22:27:08 2017 -0400 ; * test/lisp/auth-source-tests.el: Require `cl-lib' instead of `cl'. diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 90a4475ab0..41bd8c90c2 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -27,7 +27,7 @@ ;;; Code: (require 'ert) -(require 'cl) +(require 'cl-lib) (require 'auth-source) (defvar secrets-enabled t commit fe87e356124494b8450d12f1c23f3fb08bbf7b06 Author: Ted Zlatanov Date: Fri Aug 18 22:07:36 2017 -0400 * lisp/files.el (make-temp-file): Fix directory use case. diff --git a/lisp/files.el b/lisp/files.el index af5d3ba53e..a2b474f8d2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1419,7 +1419,8 @@ If SUFFIX is non-nil, add that at the end of the file name." (files--make-magic-temp-file absolute-prefix dir-flag suffix contents) (let ((file (make-temp-file-internal absolute-prefix (if dir-flag t) (or suffix "")))) - (write-region contents nil file nil 'silent) + (when (and (stringp text) (not dir-flag)) + (write-region contents nil file nil 'silent)) file)))) (defun files--make-magic-temp-file (absolute-prefix commit 94f3f13d6db0103267c514133109aebee6efb023 Author: Ted Zlatanov Date: Fri Aug 18 21:55:11 2017 -0400 Fix and document make-temp-file optional text parameter * lisp/files.el (make-temp-file): Fix initial TEXT parameter. (files--make-magic-temp-file): Support optional TEXT parameter. * etc/NEWS: Document it. * doc/lispref/files.texi: Document it. * test/lisp/auth-source-tests.el: Minor reformat. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 25f32c231c..9359d3eaa0 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2467,11 +2467,12 @@ construct a name for such a file: The job of @code{make-temp-file} is to prevent two different users or two different jobs from trying to use the exact same file name. -@defun make-temp-file prefix &optional dir-flag suffix +@defun make-temp-file prefix &optional dir-flag suffix text This function creates a temporary file and returns its name. Emacs creates the temporary file's name by adding to @var{prefix} some random characters that are different in each Emacs job. The result is -guaranteed to be a newly created empty file. On MS-DOS, this function +guaranteed to be a newly created file, containing @var{text} if that's +given as a string and empty otherwise. On MS-DOS, this function can truncate the @var{string} prefix to fit into the 8+3 file-name limits. If @var{prefix} is a relative file name, it is expanded against @code{temporary-file-directory}. @@ -2494,6 +2495,8 @@ not the directory name, of that directory. @xref{Directory Names}. If @var{suffix} is non-@code{nil}, @code{make-temp-file} adds it at the end of the file name. +If @var{text} is a string, @code{make-temp-file} inserts it in the file. + To prevent conflicts among different libraries running in the same Emacs, each Lisp program that uses @code{make-temp-file} should have its own @var{prefix}. The number added to the end of @var{prefix} diff --git a/etc/NEWS b/etc/NEWS index 9e86af5775..54be0fca4a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1210,6 +1210,8 @@ propagated to file name handlers now. * Lisp Changes in Emacs 26.1 +** New optional argument TEXT in 'make-temp-file'. + ** New function `define-symbol-prop'. +++ diff --git a/lisp/files.el b/lisp/files.el index 4dc1238f95..af5d3ba53e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1404,8 +1404,8 @@ of PREFIX, and expanding against `temporary-file-directory' if necessary), is guaranteed to point to a newly created file. You can then use `write-region' to write new data into the file. -If TEXT is non-nil, it will be inserted in the new -file. Otherwise the file will be empty. +If TEXT is non-nil, it will be inserted in the new file. Otherwise +the file will be empty. If DIR-FLAG is non-nil, create a new empty directory instead of a file. @@ -1413,20 +1413,25 @@ If SUFFIX is non-nil, add that at the end of the file name." (let ((absolute-prefix (if (or (zerop (length prefix)) (member prefix '("." ".."))) (concat (file-name-as-directory temporary-file-directory) prefix) - (expand-file-name prefix temporary-file-directory)))) + (expand-file-name prefix temporary-file-directory))) + (contents (if (stringp text) text ""))) (if (find-file-name-handler absolute-prefix 'write-region) - (files--make-magic-temp-file absolute-prefix dir-flag suffix) - (make-temp-file-internal absolute-prefix - (if dir-flag t) (or suffix ""))))) - -(defun files--make-magic-temp-file (absolute-prefix &optional dir-flag suffix) - "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX). + (files--make-magic-temp-file absolute-prefix dir-flag suffix contents) + (let ((file (make-temp-file-internal absolute-prefix + (if dir-flag t) (or suffix "")))) + (write-region contents nil file nil 'silent) + file)))) + +(defun files--make-magic-temp-file (absolute-prefix + &optional dir-flag suffix text) + "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX TEXT). This implementation works on magic file names." ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. (with-file-modes ?\700 - (let (file) + (let ((contents (if (stringp text) text "")) + file) (while (condition-case () (progn (setq file (make-temp-name absolute-prefix)) @@ -1434,7 +1439,7 @@ This implementation works on magic file names." (setq file (concat file suffix))) (if dir-flag (make-directory file) - (write-region (or text "") nil file nil 'silent nil 'excl)) + (write-region contents nil file nil 'silent nil 'excl)) nil) (file-already-exists t)) ;; the file was somehow created by someone else between diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index f35c400953..90a4475ab0 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -267,10 +267,8 @@ :host "b1" :port "b2" :user "b3") )) - (netrc-file (make-temp-file - "auth-source-test" - nil nil - (mapconcat 'identity entries "\n"))) + (netrc-file (make-temp-file "auth-source-test" nil nil + (mapconcat 'identity entries "\n"))) (auth-sources (list netrc-file)) (auth-source-do-cache nil) found found-as-string) commit 10cde01c5e39f13287c64ec53adb191b8331a6cf Author: Ted Zlatanov Date: Fri Aug 18 21:14:17 2017 -0400 * test/lisp/auth-source-tests.el: Avoid `string-join' to be simple. diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 99d830c6b0..f35c400953 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -270,7 +270,7 @@ (netrc-file (make-temp-file "auth-source-test" nil nil - (string-join entries "\n"))) + (mapconcat 'identity entries "\n"))) (auth-sources (list netrc-file)) (auth-source-do-cache nil) found found-as-string) commit 9ff5edc71373df398557f2fe45cc80099cc45317 Author: Ted Zlatanov Date: Fri Aug 18 18:44:58 2017 -0400 * test/lisp/auth-source-tests.el: Minor cleanups to use CL. diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index eb56e94af2..99d830c6b0 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -27,6 +27,7 @@ ;;; Code: (require 'ert) +(require 'cl) (require 'auth-source) (defvar secrets-enabled t @@ -266,20 +267,16 @@ :host "b1" :port "b2" :user "b3") )) - (text (string-join entries "\n")) (netrc-file (make-temp-file "auth-source-test" nil nil (string-join entries "\n"))) (auth-sources (list netrc-file)) - (auth-source-do-cache nil)) + (auth-source-do-cache nil) + found found-as-string) (dolist (test tests) - (let ((testname (car test)) - (needed (cadr test)) - (parameters (cddr test)) - found found-as-string) - + (cl-destructuring-bind (testname needed &rest parameters) test (setq found (apply #'auth-source-search parameters)) (when (listp found) (dolist (f found) commit 7098823b422c8334ef34664a9033b519f73ea7e1 Author: João Távora Date: Thu Aug 17 10:44:38 2017 +0100 Fix default value of electric-pair-pairs and electric-pair-text-pairs Fixes: debbugs:24901 A previous change, titled "Add support for curly quotation marks to electric-pair-mode", attempted to add these characters to the default value of these variables. But it did so in a quoted list, preventing evaluation of the relevant expressions and resulting in an invalid format. * lisp/elec-pair.el (electric-pair-pairs, electric-pair-text-pairs): Use backquote and comma. diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index f990851185..2a4895eb2b 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -28,9 +28,9 @@ ;;; Electric pairing. (defcustom electric-pair-pairs - '((?\" . ?\") - ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) - ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) + `((?\" . ?\") + (,(nth 0 electric-quote-chars) . ,(nth 1 electric-quote-chars)) + (,(nth 2 electric-quote-chars) . ,(nth 3 electric-quote-chars))) "Alist of pairs that should be used regardless of major mode. Pairs of delimiters in this list are a fallback in case they have @@ -43,9 +43,9 @@ See also the variable `electric-pair-text-pairs'." :type '(repeat (cons character character))) (defcustom electric-pair-text-pairs - '((?\" . ?\" ) - ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) - ((nth 2 electric-quote-chars) . (nth 3 electric-quote-chars))) + `((?\" . ?\") + (,(nth 0 electric-quote-chars) . ,(nth 1 electric-quote-chars)) + (,(nth 2 electric-quote-chars) . ,(nth 3 electric-quote-chars))) "Alist of pairs that should always be used in comments and strings. Pairs of delimiters in this list are a fallback in case they have commit 39e6692efe6797c4462a9b0cd0177c289fa9989b Author: Noam Postavsky Date: Thu Aug 17 07:06:47 2017 -0400 * lisp/elec-pair.el (electric-pair-text-pairs): Don't autoload (Bug#24901). * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Require `elec-pair' explicitly in the interactive case. diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index 87e82e24fb..f990851185 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -42,7 +42,6 @@ See also the variable `electric-pair-text-pairs'." :group 'electricity :type '(repeat (cons character character))) -;;;###autoload (defcustom electric-pair-text-pairs '((?\" . ?\" ) ((nth 0 electric-quote-chars) . (nth 1 electric-quote-chars)) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 47739f5957..0bf8857960 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -231,9 +231,12 @@ Blank lines separate paragraphs. Semicolons start comments. (defvar project-vc-external-roots-function) (lisp-mode-variables nil nil 'elisp) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) - (setq-local electric-pair-text-pairs - (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs)) - (setq-local electric-quote-string t) + (unless noninteractive + (require 'elec-pair) + (defvar electric-pair-text-pairs) + (setq-local electric-pair-text-pairs + (append '((?\` . ?\') (?‘ . ?’)) electric-pair-text-pairs)) + (setq-local electric-quote-string t)) (setq imenu-case-fold-search nil) (add-function :before-until (local 'eldoc-documentation-function) #'elisp-eldoc-documentation-function) commit 44b06ac657e124d8f48002396bace6813b30de69 Author: Mats Lidell Date: Sat Aug 19 00:18:22 2017 +0200 * etc/tutorials/TUTORIAL.sv: synced with TUTORIAL diff --git a/etc/tutorials/TUTORIAL.sv b/etc/tutorials/TUTORIAL.sv index 30608c5688..45bd35067b 100644 --- a/etc/tutorials/TUTORIAL.sv +++ b/etc/tutorials/TUTORIAL.sv @@ -18,13 +18,18 @@ Tecknen ">>" i vänstermarginalen anger att du kan prova ett kommando. Till exempel: <> [Tomma rader av pedagogiska skäl. Texten fortsätter nedanför.] ->> Tryck C-v (View next screen) för att hoppa till nästa skärmbild. +>> Tryck C-v (View next screen) för att rulla nedåt i handledningen. Prova nu. Håll ned kontrolltangenten och tryck v. Gör så i - fortsättningen när du är färdig med en skärmbild. + fortsättningen när du når slutet av en skärmbild. -Notera att det är ett överlapp på två rader när du byter från -skärmbild till skärmbild. Detta är för att behålla sammanhanget när du -bläddrar framåt i filen. +Notera att det är ett överlapp på två rader när du rullar en hel sida. +Detta är för att behålla sammanhanget när du bläddrar framåt i texten. + +Det här är en kopia av Emacs användarhandledning, som anpassats något +för dig. Längre fram kommer vi att instruera dig att prova olika +kommandon som ändrar i texten. Var inte orolig om du ändrar texten +innan vi säger till dig att göra det. Det kallas för att redigera och +det är det som Emacs är till för. Det första du behöver veta är hur du manövrerar från plats till plats i texten. Du har redan lärt dig hur du flyttar en skärmbild framåt, @@ -34,6 +39,7 @@ META-, EDIT- eller ALT-tangent.) >> Prova att trycka M-v och C-v några gånger. +Det är OK att rulla texten på andra sätt om du vet hur. * SAMMANFATTNING ---------------- commit 3565437bf27373fe053d93dbb0c295f221834b07 Author: Ted Zlatanov Date: Fri Aug 18 18:30:37 2017 -0400 Add auth-source tests and codify its API better The auth-source behavior was unclear in some API use cases, so these extra tests codify and test it. For details see https://github.com/DamienCassou/auth-password-store/issues/29 * lisp/files.el (make-temp-file): Add new initial TEXT parameter. * test/lisp/auth-source-tests.el (auth-source-test-searches): Add auth-source tests and simplify them with the new `make-temp-file'. diff --git a/lisp/files.el b/lisp/files.el index b05d453b0e..4dc1238f95 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1397,13 +1397,16 @@ the variable `temporary-file-directory' is returned." default-directory temporary-file-directory)))) -(defun make-temp-file (prefix &optional dir-flag suffix) +(defun make-temp-file (prefix &optional dir-flag suffix text) "Create a temporary file. The returned file name (created by appending some random characters at the end of PREFIX, and expanding against `temporary-file-directory' if necessary), -is guaranteed to point to a newly created empty file. +is guaranteed to point to a newly created file. You can then use `write-region' to write new data into the file. +If TEXT is non-nil, it will be inserted in the new +file. Otherwise the file will be empty. + If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." @@ -1431,7 +1434,7 @@ This implementation works on magic file names." (setq file (concat file suffix))) (if dir-flag (make-directory file) - (write-region "" nil file nil 'silent nil 'excl)) + (write-region (or text "") nil file nil 'silent nil 'excl)) nil) (file-already-exists t)) ;; the file was somehow created by someone else between diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 9753029f19..eb56e94af2 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -228,5 +228,71 @@ (should-not (auth-source-remembered-p '(:host "xedd"))) (should-not (auth-source-remembered-p '(:host t))))) +(ert-deftest auth-source-test-searches () + "Test auth-source searches with various parameters" + :tags '(auth-source auth-source/netrc) + (let* ((entries '("machine a1 port a2 user a3 password a4" + "machine b1 port b2 user b3 password b4" + "machine c1 port c2 user c3 password c4")) + ;; First element: test description. + ;; Second element: expected return data, serialized to a string. + ;; Rest of elements: the parameters for `auth-source-search'. + (tests '(("any host, max 1" + "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))" + :max 1 :host t) + ("any host, default max is 1" + "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))" + :host t) + ("any host, boolean return" + "t" + :host t :max 0) + ("no parameters, default max is 1" + "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\"))" + ) + ("host c1, default max is 1" + "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))" + :host "c1") + ("host list of (c1), default max is 1" + "((:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))" + :host ("c1")) + ("any host, max 4" + "((:host \"a1\" :port \"a2\" :user \"a3\" :secret \"a4\") (:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\") (:host \"c1\" :port \"c2\" :user \"c3\" :secret \"c4\"))" + :host t :max 4) + ("host b1, default max is 1" + "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))" + :host "b1") + ("host b1, port b2, user b3, default max is 1" + "((:host \"b1\" :port \"b2\" :user \"b3\" :secret \"b4\"))" + :host "b1" :port "b2" :user "b3") + )) + + (text (string-join entries "\n")) + (netrc-file (make-temp-file + "auth-source-test" + nil nil + (string-join entries "\n"))) + (auth-sources (list netrc-file)) + (auth-source-do-cache nil)) + + (dolist (test tests) + (let ((testname (car test)) + (needed (cadr test)) + (parameters (cddr test)) + found found-as-string) + + (setq found (apply #'auth-source-search parameters)) + (when (listp found) + (dolist (f found) + (setf f (plist-put f :secret + (let ((secret (plist-get f :secret))) + (if (functionp secret) + (funcall secret) + secret)))))) + + (setq found-as-string (format "%s: %S" testname found)) + ;; (message "With parameters %S found: [%s] needed: [%s]" parameters found-as-string needed) + (should (equal found-as-string (concat testname ": " needed))))) + (delete-file netrc-file))) + (provide 'auth-source-tests) ;;; auth-source-tests.el ends here commit e962ca57e0bfe3bc2e319bb03dc0c6a9b1a7c5ee Author: Eli Zaretskii Date: Fri Aug 18 12:33:08 2017 +0300 Don't call the same hook twice due to obsolete aliases * lisp/international/robin.el (robin-activate): * lisp/international/quail.el (quail-activate): * lisp/international/mule-cmds.el (deactivate-input-method): * lisp/emulation/viper-init.el (viper-deactivate-input-method): Don't call the same hook twice, when the obsolete and the advertised symbols are aliased. (Bug#28118) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 0d47801123..a67dd4d762 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -344,9 +344,7 @@ Use `\\[viper-set-expert-level]' to change this.") (quail-delete-overlays)) (setq describe-current-input-method-function nil) (setq current-input-method nil) - (run-hooks - 'input-method-inactivate-hook ; for backward compatibility - 'input-method-deactivate-hook) + (run-hooks 'input-method-deactivate-hook) (force-mode-line-update)) )) (defun viper-activate-input-method () diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index bcbc92844d..ee31dea69e 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1482,9 +1482,7 @@ If INPUT-METHOD is nil, deactivate any current input method." current-input-method-title nil) (funcall deactivate-current-input-method-function)) (unwind-protect - (run-hooks - 'input-method-inactivate-hook ; for backward compatibility - 'input-method-deactivate-hook) + (run-hooks 'input-method-deactivate-hook) (setq current-input-method nil) (force-mode-line-update))))) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index 036b80eb02..b7f0b15639 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -569,9 +569,7 @@ While this input method is active, the variable (setq describe-current-input-method-function nil) (quail-hide-guidance) (remove-hook 'post-command-hook 'quail-show-guidance t) - (run-hooks - 'quail-inactivate-hook ; for backward compatibility - 'quail-deactivate-hook)) + (run-hooks 'quail-deactivate-hook)) (kill-local-variable 'input-method-function)) ;; Let's activate Quail input method. (if (null quail-current-package) diff --git a/lisp/international/robin.el b/lisp/international/robin.el index 0ef90b1893..077809b6c1 100644 --- a/lisp/international/robin.el +++ b/lisp/international/robin.el @@ -413,9 +413,7 @@ While this input method is active, the variable (progn (setq robin-mode nil) (setq describe-current-input-method-function nil) - (run-hooks - 'robin-inactivate-hook ; for backward compatibility - 'robin-deactivate-hook)) + (run-hooks 'robin-deactivate-hook)) (kill-local-variable 'input-method-function)) ;; activate robin input method. commit fb1a489757eb9237afbd2e39e453e4a5e06c9d86 Author: Felipe Ochoa Date: Fri Aug 18 12:05:12 2017 +0300 A new face for show-paren in expression mode * lisp/faces.el (show-paren-match-expression): Define the new face. * lisp/paren.el (show-paren-function): Apply the different face when in expression mode. (Bug#28047) Copyright-paperwork-exempt: yes diff --git a/lisp/faces.el b/lisp/faces.el index 01d94d7aae..d9c90fda6b 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2854,6 +2854,13 @@ It is used for characters of no fonts too." "Face used for a matching paren." :group 'paren-showing-faces) +(defface show-paren-match-expression + '((t :inherit show-paren-match)) + "Face used for a matching paren when highlighting the whole expression. +This face is used by `show-paren-mode'." + :group 'paren-showing-faces + :version "26.1") + (defface show-paren-mismatch '((((class color)) (:foreground "white" :background "purple")) (t (:inverse-video t))) diff --git a/lisp/paren.el b/lisp/paren.el index a4d9200c42..5ccfa5faa9 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -247,13 +247,21 @@ It is the default value of `show-paren-data-function'." (there-beg (nth 2 data)) (there-end (nth 3 data)) (mismatch (nth 4 data)) + (highlight-expression + (or (eq show-paren-style 'expression) + (and there-beg + (eq show-paren-style 'mixed) + (let ((closest (if (< there-beg here-beg) + (1- there-end) (1+ there-beg)))) + (not (pos-visible-in-window-p closest)))))) (face - (if mismatch - (progn - (if show-paren-ring-bell-on-mismatch - (beep)) - 'show-paren-mismatch) - 'show-paren-match))) + (cond + (mismatch + (if show-paren-ring-bell-on-mismatch + (beep)) + 'show-paren-mismatch) + (highlight-expression 'show-paren-match-expression) + (t 'show-paren-match)))) ;; ;; If matching backwards, highlight the closeparen ;; before point as well as its matching open. @@ -276,11 +284,7 @@ It is the default value of `show-paren-data-function'." ;; If it's an unmatched paren, turn off any such highlighting. (if (not there-beg) (delete-overlay show-paren--overlay) - (if (or (eq show-paren-style 'expression) - (and (eq show-paren-style 'mixed) - (let ((closest (if (< there-beg here-beg) - (1- there-end) (1+ there-beg)))) - (not (pos-visible-in-window-p closest))))) + (if highlight-expression (move-overlay show-paren--overlay (if (< there-beg here-beg) here-end here-beg) (if (< there-beg here-beg) there-beg there-end) commit 99b3250d04288260e3a6db864cda910d8093bee1 Author: Eli Zaretskii Date: Fri Aug 18 11:47:29 2017 +0300 Non-ASCII support for man page section and header names * lisp/man.el (Man-name-regexp, Man-page-header-regexp) (Man-heading-regexp): Replace ASCII character classes by equivalent classes that allow non-ASCII characters. Suggested by Grégory Mounié . (Bug#27978) diff --git a/lisp/man.el b/lisp/man.el index 0e1c92956b..13efc21b03 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -278,7 +278,7 @@ Used in `bookmark-set' to get the default bookmark name." :type 'hook :group 'man) -(defvar Man-name-regexp "[-a-zA-Z0-9_­+][-a-zA-Z0-9_.:­+]*" +(defvar Man-name-regexp "[-[:alnum:]_­+][-[:alnum:]_.:­+]*" "Regular expression describing the name of a manpage (without section).") (defvar Man-section-regexp "[0-9][a-zA-Z0-9+]*\\|[LNln]" @@ -286,13 +286,13 @@ Used in `bookmark-set' to get the default bookmark name." (defvar Man-page-header-regexp (if (string-match "-solaris2\\." system-configuration) - (concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp + (concat "^[-[:alnum:]_].*[ \t]\\(" Man-name-regexp "(\\(" Man-section-regexp "\\))\\)$") (concat "^[ \t]*\\(" Man-name-regexp "(\\(" Man-section-regexp "\\))\\).*\\1")) "Regular expression describing the heading of a page.") -(defvar Man-heading-regexp "^\\([A-Z][A-Z0-9 /-]+\\)$" +(defvar Man-heading-regexp "^\\([[:upper:]][[:upper:]0-9 /-]+\\)$" "Regular expression describing a manpage heading entry.") (defvar Man-see-also-regexp "SEE ALSO" commit a1ed97e5108450853fb983d96e4b14c26393231b Author: Eli Zaretskii Date: Fri Aug 18 11:32:10 2017 +0300 Implement HiDPI support for underwave on MS-Windows * src/w32term.c (x_get_scale_factor): New function. (w32_draw_underwave): Use it. * src/xterm.c (x_draw_underwave): Offset the wave starting point to make it identical with original code. diff --git a/src/w32term.c b/src/w32term.c index 0f7bb9337f..6d2fa33585 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -32,6 +32,7 @@ along with GNU Emacs. If not, see . */ #include /* for O_RDWR */ #endif #include +#include #include "coding.h" #include "frame.h" @@ -308,6 +309,20 @@ w32_restore_glyph_string_clip (struct glyph_string *s) } } +static void +x_get_scale_factor(struct w32_display_info *dpyinfo, int *scale_x, int *scale_y) +{ + const int base_res = 96; + + *scale_x = *scale_y = 1; + + if (dpyinfo) + { + *scale_x = floor (dpyinfo->resx / base_res); + *scale_y = floor (dpyinfo->resy / base_res); + } +} + /* Draw a wavy line under S. The wave fills wave_height pixels from y0. @@ -322,7 +337,12 @@ w32_restore_glyph_string_clip (struct glyph_string *s) static void w32_draw_underwave (struct glyph_string *s, COLORREF color) { - int wave_height = 3, wave_length = 2; + struct w32_display_info *dpyinfo = FRAME_DISPLAY_INFO (s->f); + + int scale_x, scale_y; + x_get_scale_factor (dpyinfo, &scale_x, &scale_y); + + int wave_height = 3 * scale_y, wave_length = 2 * scale_x, thickness = scale_y; int dx, dy, x0, y0, width, x1, y1, x2, y2, odd, xmax; XRectangle wave_clip, string_clip, final_clip; RECT w32_final_clip, w32_string_clip; @@ -331,7 +351,7 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color) dx = wave_length; dy = wave_height - 1; x0 = s->x; - y0 = s->ybase - wave_height + 3; + y0 = s->ybase + wave_height / 2 - scale_y; width = s->width; xmax = x0 + width; @@ -348,7 +368,7 @@ w32_draw_underwave (struct glyph_string *s, COLORREF color) if (!x_intersect_rectangles (&wave_clip, &string_clip, &final_clip)) return; - hp = CreatePen (PS_SOLID, 0, color); + hp = CreatePen (PS_SOLID, thickness, color); oldhp = SelectObject (s->hdc, hp); CONVERT_FROM_XRECT (final_clip, w32_final_clip); w32_set_clip_rectangle (s->hdc, &w32_final_clip); diff --git a/src/xterm.c b/src/xterm.c index 5c1b061566..2efa70b1dc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -3519,7 +3519,7 @@ x_draw_underwave (struct glyph_string *s) dx = wave_length; dy = wave_height - 1; x0 = s->x; - y0 = s->ybase + wave_height / 2; + y0 = s->ybase + wave_height / 2 - scale_y; width = s->width; xmax = x0 + width; commit efb508bbb42a214966483c911f2cfc5a4eba73f5 Author: Stephen Pegoraro Date: Fri Aug 18 11:02:40 2017 +0300 Support HiDPI displays for wave style underlines * src/xterm.c (x_draw_underwave): Compute height, length and thickness based on scale factor. (x_get_scale_factor): New function. Copyright-paperwork-exempt: yes diff --git a/src/xterm.c b/src/xterm.c index a214cd8103..5c1b061566 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -23,9 +23,7 @@ along with GNU Emacs. If not, see . */ #include #include #include -#ifdef USE_CAIRO #include -#endif #include "lisp.h" #include "blockinput.h" @@ -3475,6 +3473,21 @@ x_draw_stretch_glyph_string (struct glyph_string *s) s->background_filled_p = true; } +static void +x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) +{ + const int base_res = 96; + struct x_display_info * dpyinfo = x_display_info_for_display (disp); + + *scale_x = *scale_y = 1; + + if (dpyinfo) + { + *scale_x = floor (dpyinfo->resx / base_res); + *scale_y = floor (dpyinfo->resy / base_res); + } +} + /* Draw a wavy line under S. The wave fills wave_height pixels from y0. @@ -3485,11 +3498,16 @@ x_draw_stretch_glyph_string (struct glyph_string *s) wave_height = 3 | * * * * */ - static void x_draw_underwave (struct glyph_string *s) { - int wave_height = 3, wave_length = 2; + /* Adjust for scale/HiDPI. */ + int scale_x, scale_y; + + x_get_scale_factor (s->display, &scale_x, &scale_y); + + int wave_height = 3 * scale_y, wave_length = 2 * scale_x, thickness = scale_y; + #ifdef USE_CAIRO x_draw_horizontal_wave (s->f, s->gc, s->x, s->ybase - wave_height + 3, s->width, wave_height, wave_length); @@ -3501,7 +3519,7 @@ x_draw_underwave (struct glyph_string *s) dx = wave_length; dy = wave_height - 1; x0 = s->x; - y0 = s->ybase - wave_height + 3; + y0 = s->ybase + wave_height / 2; width = s->width; xmax = x0 + width; @@ -3535,6 +3553,8 @@ x_draw_underwave (struct glyph_string *s) while (x1 <= xmax) { + XSetLineAttributes (s->display, s->gc, thickness, LineSolid, CapButt, + JoinRound); XDrawLine (s->display, FRAME_X_DRAWABLE (s->f), s->gc, x1, y1, x2, y2); x1 = x2, y1 = y2; x2 += dx, y2 = y0 + odd*dy; commit 65d3c27fe13565bfacd4e5138cd217d6084c6ee9 Author: Bastien Date: Fri Aug 18 09:39:54 2017 +0200 Delete library-of-babel.org * etc/org/library-of-babel.org: Delete file. diff --git a/etc/org/library-of-babel.org b/etc/org/library-of-babel.org deleted file mode 100644 index 0098e72639..0000000000 --- a/etc/org/library-of-babel.org +++ /dev/null @@ -1,584 +0,0 @@ -#+title: The Library of Babel -#+author: Org-mode People -#+STARTUP: hideblocks - -* Introduction - -The Library of Babel is an extensible collection of ready-made and -easily-shortcut-callable source-code blocks for handling common tasks. -Org-babel comes pre-populated with the source-code blocks located in -this file. It is possible to add source-code blocks from any org-mode -file to the library by calling =(org-babel-lob-ingest -"path/to/file.org")=. - -This file is included in worg mainly less for viewing through the web -interface, and more for contribution through the worg git repository. -If you have code snippets that you think others may find useful please -add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg. - -The raw Org-mode text of this file can be downloaded at -[[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]] - -* Simple - -A collection of simple utility functions: - -#+name: echo -#+begin_src emacs-lisp :var input="echo'd" - input -#+end_src - -* File I/O - -** Reading and writing files - -Read the contents of the file at =file=. The =:results vector= and -=:results scalar= header arguments can be used to read the contents of -file as either a table or a string. - -#+name: read -#+begin_src emacs-lisp :var file="" :var format="" - (if (string= format "csv") - (with-temp-buffer - (org-table-import (expand-file-name file) nil) - (org-table-to-lisp)) - (with-temp-buffer - (insert-file-contents (expand-file-name file)) - (buffer-string))) -#+end_src - -Write =data= to a file at =file=. If =data= is a list, then write it -as a table in traditional Org-mode table syntax. - -#+name: write -#+begin_src emacs-lisp :var data="" :var file="" :var ext='() - (flet ((echo (r) (if (stringp r) r (format "%S" r)))) - (with-temp-file file - (case (and (listp data) - (or ext (intern (file-name-extension file)))) - ('tsv (insert (orgtbl-to-tsv data '(:fmt echo)))) - ('csv (insert (orgtbl-to-csv data '(:fmt echo)))) - (t (org-babel-insert-result data))))) - nil -#+end_src - -** Remote files - -*** json - -Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects. - -#+name: json -#+begin_src emacs-lisp :var file='() :var url='() - (require 'json) - (cond - (file - (with-temp-filebuffer file - (goto-char (point-min)) - (json-read))) - (url - (require 'w3m) - (with-temp-buffer - (w3m-retrieve url) - (goto-char (point-min)) - (json-read)))) -#+end_src - -*** Google docs - -The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line -tool. This tool provides functionality for accessing Google services -from the command line, and the following code blocks use /googlecl/ -for reading from and writing to Google docs with Org-mode code blocks. - -**** Read a document from Google docs - -The =google= command seems to be throwing "Moved Temporarily" errors -when trying to download textual documents, but this is working fine -for spreadsheets. - -#+name: gdoc-read -#+begin_src emacs-lisp :var title="example" :var format="csv" - (let* ((file (concat title "." format)) - (cmd (format "google docs get --format %S --title %S" format title))) - (message cmd) (message (shell-command-to-string cmd)) - (prog1 (if (string= format "csv") - (with-temp-buffer - (org-table-import (shell-quote-argument file) '(4)) - (org-table-to-lisp)) - (with-temp-buffer - (insert-file-contents (shell-quote-argument file)) - (buffer-string))) - (delete-file file))) -#+end_src - -For example, a line like the following can be used to read the -contents of a spreadsheet named =num-cells= into a table. -: #+call: gdoc-read(title="num-cells"") - -A line like the following can be used to read the contents of a -document as a string. - -: #+call: gdoc-read(title="loremi", :format "txt") - -**** Write a document to a Google docs - -Write =data= to a google document named =title=. If =data= is tabular -it will be saved to a spreadsheet, otherwise it will be saved as a -normal document. - -#+name: gdoc-write -#+begin_src emacs-lisp :var title="babel-upload" :var data=fibs(n=10) :results silent - (let* ((format (if (listp data) "csv" "txt")) - (tmp-file (make-temp-file "org-babel-google-doc" nil (concat "." format))) - (cmd (format "google docs upload --title %S %S" title tmp-file))) - (with-temp-file tmp-file - (insert - (if (listp data) - (orgtbl-to-csv - data '(:fmt (lambda (el) (if (stringp el) el (format "%S" el))))) - (if (stringp data) data (format "%S" data))))) - (message cmd) - (prog1 (shell-command-to-string cmd) (delete-file tmp-file))) -#+end_src - -example usage -: #+name: fibs -: #+begin_src emacs-lisp :var n=8 -: (flet ((fib (m) (if (< m 2) 1 (+ (fib (- m 1)) (fib (- m 2)))))) -: (mapcar (lambda (el) (list el (fib el))) (number-sequence 0 (- n 1)))) -: #+end_src -: -: #+call: gdoc-write(title="fibs", data=fibs(n=10)) - -* Plotting code - -** R - -Plot column 2 (y axis) against column 1 (x axis). Columns 3 and -beyond, if present, are ignored. - -#+name: R-plot -#+begin_src R :var data=R-plot-example-data -plot(data) -#+end_src - -#+tblname: R-plot-example-data -| 1 | 2 | -| 2 | 4 | -| 3 | 9 | -| 4 | 16 | -| 5 | 25 | - -#+call: R-plot(data=R-plot-example-data) - -#+resname: R-plot(data=R-plot-example-data) -: nil - -** Gnuplot - -* Org reference - -** Headline references - -#+name: headline -#+begin_src emacs-lisp :var headline=top :var file='() - (save-excursion - (when file (get-file-buffer file)) - (org-open-link-from-string (org-make-link-string headline)) - (save-restriction - (org-narrow-to-subtree) - (buffer-string))) -#+end_src - -#+call: headline(headline="headline references") - -* Tables - -** LaTeX Table Export - -*** booktabs - -This source block can be used to wrap a table in the latex =booktabs= -environment. The source block adds a =toprule= and =bottomrule= (so -don't use =hline= at the top or bottom of the table). The =hline= -after the header is replaced with a =midrule=. - -Note that this function bypasses the Org-mode LaTeX exporter and calls -=orgtbl-to-generic= to create the output table. This means that the -entries in the table are not translated from Org-mode to LaTeX. - -It takes the following arguments -- all but the first two are -optional. - -| arg | description | -|-------+--------------------------------------------| -| table | a reference to the table | -| align | alignment string | -| env | optional environment, default to "tabular" | -| width | optional width specification string | - -#+name: booktabs -#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var align='() :var env="tabular" :var width='() :noweb yes :results latex - (flet ((to-tab (tab) - (orgtbl-to-generic - (mapcar (lambda (lis) - (if (listp lis) - (mapcar (lambda (el) - (if (stringp el) - el - (format "%S" el))) lis) - lis)) tab) - (list :lend " \\\\" :sep " & " :hline "\\hline")))) - (org-fill-template - " - \\begin{%env}%width%align - \\toprule - %table - \\bottomrule - \\end{%env}\n" - (list - (cons "env" (or env "table")) - (cons "width" (if width (format "{%s}" width) "")) - (cons "align" (if align (format "{%s}" align) "")) - (cons "table" - ;; only use \midrule if it looks like there are column headers - (if (equal 'hline (second table)) - (concat (to-tab (list (first table))) - "\n\\midrule\n" - (to-tab (cddr table))) - (to-tab table)))))) -#+end_src - -*** longtable - -This block can be used to wrap a table in the latex =longtable= -environment, it takes the following arguments -- all but the first two -are optional. - -| arg | description | -|-----------+-------------------------------------------------------------| -| table | a reference to the table | -| align | optional alignment string | -| width | optional width specification string | -| hline | the string to use as hline separator, defaults to "\\hline" | -| head | optional "head" string | -| firsthead | optional "firsthead" string | -| foot | optional "foot" string | -| lastfoot | optional "lastfoot" string | - -#+name: longtable -#+begin_src emacs-lisp :var table='((:table)) :var align='() :var width='() :var hline="\\hline" :var firsthead='() :var head='() :var foot='() :var lastfoot='() :noweb yes :results latex - (org-fill-template - " - \\begin{longtable}%width%align - %firsthead - %head - %foot - %lastfoot - - %table - \\end{longtable}\n" - (list - (cons "width" (if width (format "{%s}" width) "")) - (cons "align" (if align (format "{%s}" align) "")) - (cons "firsthead" (if firsthead (concat firsthead "\n\\endfirsthead\n") "")) - (cons "head" (if head (concat head "\n\\endhead\n") "")) - (cons "foot" (if foot (concat foot "\n\\endfoot\n") "")) - (cons "lastfoot" (if lastfoot (concat lastfoot "\n\\endlastfoot\n") "")) - (cons "table" (orgtbl-to-generic - (mapcar (lambda (lis) - (if (listp lis) - (mapcar (lambda (el) - (if (stringp el) - el - (format "%S" el))) lis) - lis)) table) - (list :lend " \\\\" :sep " & " :hline hline))))) -#+end_src - -*** booktabs-notes - -This source block builds on [[booktabs]]. It accepts two additional -arguments, both of which are optional. - -#+tblname: arguments -| arg | description | -|--------+------------------------------------------------------| -| notes | an org-mode table with footnotes | -| lspace | if non-nil, insert =addlinespace= after =bottomrule= | - -An example footnote to the =arguments= table specifies the column -span. Note the use of LaTeX, rather than Org-mode, markup. - -#+tblname: arguments-notes -| \multicolumn{2}{l}{This is a footnote to the \emph{arguments} table.} | - -#+name: booktabs-notes -#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var notes='() :var align='() :var env="tabular" :var width='() :var lspace='() :noweb yes :results latex - (flet ((to-tab (tab) - (orgtbl-to-generic - (mapcar (lambda (lis) - (if (listp lis) - (mapcar (lambda (el) - (if (stringp el) - el - (format "%S" el))) lis) - lis)) tab) - (list :lend " \\\\" :sep " & " :hline "\\hline")))) - (org-fill-template - " - \\begin{%env}%width%align - \\toprule - %table - \\bottomrule%spacer - %notes - \\end{%env}\n" - (list - (cons "env" (or env "table")) - (cons "width" (if width (format "{%s}" width) "")) - (cons "align" (if align (format "{%s}" align) "")) - (cons "spacer" (if lspace "\\addlinespace" "")) - (cons "table" - ;; only use \midrule if it looks like there are column headers - (if (equal 'hline (second table)) - (concat (to-tab (list (first table))) - "\n\\midrule\n" - (to-tab (cddr table))) - (to-tab table))) - (cons "notes" (if notes (to-tab notes) "")) - ))) -#+end_src - -** Elegant lisp for transposing a matrix - -#+tblname: transpose-example -| 1 | 2 | 3 | -| 4 | 5 | 6 | - -#+name: transpose -#+begin_src emacs-lisp :var table=transpose-example - (apply #'mapcar* #'list table) -#+end_src - -#+resname: -| 1 | 4 | -| 2 | 5 | -| 3 | 6 | - -** Convert every element of a table to a string - -#+tblname: hetero-table -| 1 | 2 | 3 | -| a | b | c | - -#+name: all-to-string -#+begin_src emacs-lisp :var tbl='() - (defun all-to-string (tbl) - (if (listp tbl) - (mapcar #'all-to-string tbl) - (if (stringp tbl) - tbl - (format "%s" tbl)))) - (all-to-string tbl) -#+end_src - -#+begin_src emacs-lisp :var tbl=hetero-table - (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl) -#+end_src - -#+name: -| nil | nil | nil | -| t | t | t | - -#+begin_src emacs-lisp :var tbl=all-to-string(hetero-table) - (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl) -#+end_src - -#+name: -| t | t | t | -| t | t | t | - -* Misc - -** File-specific Version Control logging - :PROPERTIES: - :AUTHOR: Luke Crook - :END: - -This function will attempt to retrieve the entire commit log for the -file associated with the current buffer and insert this log into the -export. The function uses the Emacs VC commands to interface to the -local version control system, but has only been tested to work with -Git. 'limit' is currently unsupported. - -#+name: vc-log -#+headers: :var limit=-1 -#+headers: :var buf=(buffer-name (current-buffer)) -#+begin_src emacs-lisp - ;; Most of this code is copied from vc.el vc-print-log - (require 'vc) - (when (vc-find-backend-function - (vc-backend (buffer-file-name (get-buffer buf))) 'print-log) - (let ((limit -1) - (vc-fileset nil) - (backend nil) - (files nil)) - (with-current-buffer (get-buffer buf) - (setq vc-fileset (vc-deduce-fileset t)) ; FIXME: Why t? --Stef - (setq backend (car vc-fileset)) - (setq files (cadr vc-fileset))) - (with-temp-buffer - (let ((status (vc-call-backend - backend 'print-log files (current-buffer)))) - (when (and (processp status) ; Make sure status is a process - (= 0 (process-exit-status status))) ; which has not terminated - (while (not (eq 'exit (process-status status))) - (sit-for 1 t))) - (buffer-string))))) -#+end_src - -** Trivial python code blocks - -#+name: python-identity -#+begin_src python :var a=1 -a -#+end_src - -#+name: python-add -#+begin_src python :var a=1 :var b=2 -a + b -#+end_src - -** Arithmetic - -#+name: lob-add -#+begin_src emacs-lisp :var a=0 :var b=0 - (+ a b) -#+end_src - -#+name: lob-minus -#+begin_src emacs-lisp :var a=0 :var b=0 - (- a b) -#+end_src - -#+name: lob-times -#+begin_src emacs-lisp :var a=0 :var b=0 - (* a b) -#+end_src - -#+name: lob-div -#+begin_src emacs-lisp :var a=0 :var b=0 - (/ a b) -#+end_src - -* GANTT Charts - -The =elispgantt= source block was sent to the mailing list by Eric -Fraga. It was modified slightly by Tom Dye. - -#+name: elispgantt -#+begin_src emacs-lisp :var table=gantttest - (let ((dates "") - (entries (nthcdr 2 table)) - (milestones "") - (nmilestones 0) - (ntasks 0) - (projecttime 0) - (tasks "") - (xlength 1)) - (message "Initial: %s\n" table) - (message "Entries: %s\n" entries) - (while entries - (let ((entry (first entries))) - (if (listp entry) - (let ((id (first entry)) - (type (nth 1 entry)) - (label (nth 2 entry)) - (task (nth 3 entry)) - (dependencies (nth 4 entry)) - (start (nth 5 entry)) - (duration (nth 6 entry)) - (end (nth 7 entry)) - (alignment (nth 8 entry))) - (if (> start projecttime) (setq projecttime start)) - (if (string= type "task") - (let ((end (+ start duration)) - (textposition (+ start (/ duration 2))) - (flush "")) - (if (string= alignment "left") - (progn - (setq textposition start) - (setq flush "[left]")) - (if (string= alignment "right") - (progn - (setq textposition end) - (setq flush "[right]")))) - (setq tasks - (format "%s \\gantttask{%s}{%s}{%d}{%d}{%d}{%s}\n" - tasks label task start end textposition flush)) - (setq ntasks (+ 1 ntasks)) - (if (> end projecttime) - (setq projecttime end))) - (if (string= type "milestone") - (progn - (setq milestones - (format - "%s \\ganttmilestone{$\\begin{array}{c}\\mbox{%s}\\\\ \\mbox{%s}\\end{array}$}{%d}\n" - milestones label task start)) - (setq nmilestones (+ 1 nmilestones))) - (if (string= type "date") - (setq dates (format "%s \\ganttdateline{%s}{%d}\n" - dates label start)) - (message "Ignoring entry with type %s\n" type))))) - (message "Ignoring non-list entry %s\n" entry)) ; end if list entry - (setq entries (cdr entries)))) ; end while entries left - (format "\\pgfdeclarelayer{background} - \\pgfdeclarelayer{foreground} - \\pgfsetlayers{background,foreground} - \\renewcommand{\\ganttprojecttime}{%d} - \\renewcommand{\\ganttntasks}{%d} - \\noindent - \\begin{tikzpicture}[y=-0.75cm,x=0.75\\textwidth] - \\begin{pgfonlayer}{background} - \\draw[very thin, red!10!white] (0,1+\\ganttntasks) grid [ystep=0.75cm,xstep=1/\\ganttprojecttime] (1,0); - \\draw[\\ganttdatelinecolour] (0,0) -- (1,0); - \\draw[\\ganttdatelinecolour] (0,1+\\ganttntasks) -- (1,1+\\ganttntasks); - \\end{pgfonlayer} - %s - %s - %s - \\end{tikzpicture}" projecttime ntasks tasks milestones dates)) -#+end_src - -* Available languages - :PROPERTIES: - :AUTHOR: Bastien - :END: - -** From Org's core - -| Language | Identifier | Language | Identifier | -|------------+------------+----------------+------------| -| Asymptote | asymptote | Awk | awk | -| Emacs Calc | calc | C | C | -| C++ | C++ | Clojure | clojure | -| CSS | css | ditaa | ditaa | -| Graphviz | dot | Emacs Lisp | emacs-lisp | -| gnuplot | gnuplot | Haskell | haskell | -| Javascript | js | LaTeX | latex | -| Ledger | ledger | Lisp | lisp | -| Lilypond | lilypond | MATLAB | matlab | -| Mscgen | mscgen | Objective Caml | ocaml | -| Octave | octave | Org-mode | org | -| | | Perl | perl | -| Plantuml | plantuml | Python | python | -| R | R | Ruby | ruby | -| Sass | sass | Scheme | scheme | -| GNU Screen | screen | shell | sh | -| SQL | sql | SQLite | sqlite | - -** From Org's contrib/babel/langs - -- ob-oz.el, by Torsten Anders and Eric Schulte -- ob-fomus.el, by Torsten Anders commit bc5fba7aae4beb56d983e057cfc968856ffe53ae Author: Eli Zaretskii Date: Fri Aug 18 09:33:11 2017 +0300 ; Minor copyedits in manuals. * doc/lispref/variables.texi (Lexical Binding): The future is here. * doc/emacs/files.texi (Copying and Naming): Use @w{..} around constructs that could be split between lines, but shouldn't. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 04d2fc1c99..9195bc47ef 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1556,10 +1556,14 @@ not accept wildcard file names. In all these commands, if the argument @var{new} is just a directory name, the real new name is in that directory, with the same -non-directory component as @var{old}. For example, +non-directory component as @var{old}. For example, the command @c FIXME: '/tmp' should be '/tmp/' because '/tmp' @c is not "just a directory name". -@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp @key{RET}} +@c And actually the fact that ``directory name'' must end in a slash +@c is not explained anywhere in this manual. Moreover, it many times +@c uses ``directory name'' in contexts where the string it alludes to +@c will clearly _not_ end in a slash +@w{@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp @key{RET}}} renames @file{~/foo} to @file{/tmp/foo}. All these commands ask for confirmation when the new file name already exists, too. @@ -1586,8 +1590,8 @@ different file systems, the file @var{old} is copied and deleted. @ifnottex If a file is under version control (@pxref{Version Control}), you -should rename it using @kbd{M-x vc-rename-file} instead of @kbd{M-x -rename-file}. @xref{VC Delete/Rename}. +should rename it using @w{@kbd{M-x vc-rename-file}} instead of +@w{@kbd{M-x rename-file}}. @xref{VC Delete/Rename}. @end ifnottex @findex add-name-to-file diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 7650ed4e3d..50739e6b5f 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1017,11 +1017,11 @@ variables like @code{case-fold-search}: @subsection Lexical Binding Lexical binding was introduced to Emacs, as an optional feature, in -version 24.1. We expect its importance to increase in the future. +version 24.1. We expect its importance to increase with time. Lexical binding opens up many more opportunities for optimization, so programs using it are likely to run faster in future Emacs versions. -Lexical binding is also more compatible with concurrency, which we -want to add to Emacs in the future. +Lexical binding is also more compatible with concurrency, which was +added to Emacs in version 26.1. A lexically-bound variable has @dfn{lexical scope}, meaning that any reference to the variable must be located textually within the binding commit 7ab95461f7aa7e3d19eed99d6410dc25778a8f1b Author: Glenn Morris Date: Thu Aug 17 21:49:27 2017 -0400 * doc/emacs/files.texi (Copying and Naming): Avoid confusing texi2pdf. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 9d6e62b5f3..04d2fc1c99 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1556,13 +1556,11 @@ not accept wildcard file names. In all these commands, if the argument @var{new} is just a directory name, the real new name is in that directory, with the same -non-directory component as @var{old}. For example, @kbd{M-x -rename-file @key{RET} ~/foo @key{RET} -@c FIXME: This part of the example should be '/tmp/' not '/tmp', -@c because '/tmp' is not "just a directory name". -/tmp -@c -@key{RET}} renames @file{~/foo} to @file{/tmp/foo}. All these +non-directory component as @var{old}. For example, +@c FIXME: '/tmp' should be '/tmp/' because '/tmp' +@c is not "just a directory name". +@kbd{M-x rename-file @key{RET} ~/foo @key{RET} /tmp @key{RET}} +renames @file{~/foo} to @file{/tmp/foo}. All these commands ask for confirmation when the new file name already exists, too. commit cb7aa6c4a33debd4e0b72e00f846df92f395a181 Author: Noam Postavsky Date: Sat Jul 22 23:54:34 2017 -0400 Remove custom version parsing from epg-config.el (Bug#27963) * lisp/epg-config.el (epg-config--compare-version) (epg-config--parse-version): Remove. (epg-check-configuration): Use `version<=' instead. diff --git a/lisp/epg-config.el b/lisp/epg-config.el index 7b963add88..6aed354ca4 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -210,34 +210,16 @@ version requirement is met." (declare (obsolete epg-find-configuration "25.1")) (epg-config--make-gpg-configuration epg-gpg-program)) -(defun epg-config--parse-version (string) - (let ((index 0) - version) - (while (eq index (string-match "\\([0-9]+\\)\\.?" string index)) - (setq version (cons (string-to-number (match-string 1 string)) - version) - index (match-end 0))) - (nreverse version))) - -(defun epg-config--compare-version (v1 v2) - (while (and v1 v2 (= (car v1) (car v2))) - (setq v1 (cdr v1) v2 (cdr v2))) - (- (or (car v1) 0) (or (car v2) 0))) - ;;;###autoload (defun epg-check-configuration (config &optional minimum-version) "Verify that a sufficient version of GnuPG is installed." - (let ((entry (assq 'version config)) - version) - (unless (and entry - (stringp (cdr entry))) - (error "Undetermined version: %S" entry)) - (setq version (epg-config--parse-version (cdr entry)) - minimum-version (epg-config--parse-version - (or minimum-version - epg-gpg-minimum-version))) - (unless (>= (epg-config--compare-version version minimum-version) 0) - (error "Unsupported version: %s" (cdr entry))))) + (let ((version (alist-get 'version config))) + (unless (stringp version) + (error "Undetermined version: %S" version)) + (unless (version<= (or minimum-version + epg-gpg-minimum-version) + version) + (error "Unsupported version: %s" version)))) ;;;###autoload (defun epg-expand-group (config group) commit 87645443b5c6dffea928a19c50aded605a28279c Author: Mark Oteiza Date: Thu Aug 17 20:00:52 2017 -0400 Treat control characters in JSON strings as invalid * lisp/json.el (json-peek): Reduce to following-char. (json-pop, json-read): Zero (null char) means end of file. (json-read-escaped-char): Delimit URL properly. (json-read-string): Signal error for ASCII control characters. * test/lisp/json-tests.el (test-json-peek): Check for zero instead of :json-eof symbol. (test-json-read-string): New test for control characters in JSON strings. diff --git a/lisp/json.el b/lisp/json.el index 627e65efa4..64486258cc 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -193,12 +193,12 @@ Unlike `reverse', this keeps the property-value pairs intact." (defsubst json-peek () "Return the character at point." - (or (char-after (point)) :json-eof)) + (following-char)) (defsubst json-pop () "Advance past the character at point, returning it." (let ((char (json-peek))) - (if (eq char :json-eof) + (if (zerop char) (signal 'json-end-of-file nil) (json-advance) char))) @@ -380,7 +380,7 @@ representation will be parsed correctly." (special (cdr special)) ((not (eq char ?u)) char) ;; Special-case UTF-16 surrogate pairs, - ;; cf. https://tools.ietf.org/html/rfc7159#section-7. Note that + ;; cf. . Note that ;; this clause overlaps with the next one and therefore has to ;; come first. ((looking-at @@ -406,6 +406,8 @@ representation will be parsed correctly." (let ((characters '()) (char (json-peek))) (while (not (= char ?\")) + (when (< char 32) + (signal 'json-string-format (list (prin1-char char)))) (push (if (= char ?\\) (json-read-escaped-char) (json-pop)) @@ -686,12 +688,12 @@ become JSON objects." Advances point just past JSON object." (json-skip-whitespace) (let ((char (json-peek))) - (if (not (eq char :json-eof)) - (let ((record (cdr (assq char json-readtable)))) - (if (functionp (car record)) - (apply (car record) (cdr record)) - (signal 'json-readtable-error record))) - (signal 'json-end-of-file nil)))) + (if (zerop char) + (signal 'json-end-of-file nil) + (let ((record (cdr (assq char json-readtable)))) + (if (functionp (car record)) + (apply (car record) (cdr record)) + (signal 'json-readtable-error record)))))) ;; Syntactic sugar for the reader diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index c6bd295d66..1d13ccf074 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el @@ -75,7 +75,7 @@ Point is moved to beginning of the buffer." (ert-deftest test-json-peek () (json-tests--with-temp-buffer "" - (should (eq (json-peek) :json-eof))) + (should (zerop (json-peek)))) (json-tests--with-temp-buffer "{ \"a\": 1 }" (should (equal (json-peek) ?{)))) @@ -164,6 +164,8 @@ Point is moved to beginning of the buffer." (should (equal (json-read-escaped-char) ?\")))) (ert-deftest test-json-read-string () + (json-tests--with-temp-buffer "\"formfeed\f\"" + (should-error (json-read-string) :type 'json-string-format)) (json-tests--with-temp-buffer "\"foo \\\"bar\\\"\"" (should (equal (json-read-string) "foo \"bar\""))) (json-tests--with-temp-buffer "\"abcαβγ\"" commit 61631476d79cdb10272091251f3b84817fbc631a Author: Eli Zaretskii Date: Thu Aug 17 19:48:49 2017 +0300 Support Posix semantics of 'rename' on MS-Windows * src/w32.c (sys_rename_replace): Support Posix semantics of 'rename': return an error if OLD is a directory while NEW is not, or vice versa. diff --git a/src/w32.c b/src/w32.c index 7cd58d07d8..1b1f8d8480 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4504,12 +4504,12 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) result = _wrename (temp_w, newname_w); if (result < 0) { - DWORD attributes; DWORD w32err = GetLastError (); if (errno == EACCES && newname_dev != oldname_dev) { + DWORD attributes; /* The implementation of `rename' on Windows does not return errno = EXDEV when you are moving a directory to a different storage device (ex. logical disk). It returns @@ -4521,10 +4521,24 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) } else if (errno == EEXIST && force) { + DWORD attributes_old; + DWORD attributes_new; + if (_wchmod (newname_w, 0666) != 0) return result; - if ((attributes = GetFileAttributesW (newname_w)) != -1 - && (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0) + attributes_old = GetFileAttributesW (temp_w); + attributes_new = GetFileAttributesW (newname_w); + if (attributes_old != -1 && attributes_new != -1 + && ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) + != (attributes_new & FILE_ATTRIBUTE_DIRECTORY))) + { + if ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) != 0) + errno = ENOTDIR; + else + errno = EISDIR; + return -1; + } + if ((attributes_new & FILE_ATTRIBUTE_DIRECTORY) != 0) { if (_wrmdir (newname_w) != 0) return result; @@ -4553,22 +4567,36 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) result = rename (temp_a, newname_a); if (result < 0) { - DWORD attributes; DWORD w32err = GetLastError (); if (errno == EACCES && newname_dev != oldname_dev) { + DWORD attributes; if ((attributes = GetFileAttributesA (temp_a)) != -1 && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; } else if (errno == EEXIST && force) { + DWORD attributes_old; + DWORD attributes_new; + if (_chmod (newname_a, 0666) != 0) return result; - if ((attributes = GetFileAttributesA (newname_a)) != -1 - && (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0) + attributes_old = GetFileAttributesA (temp_a); + attributes_new = GetFileAttributesA (newname_a); + if (attributes_old != -1 && attributes_new != -1 + && ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) + != (attributes_new & FILE_ATTRIBUTE_DIRECTORY))) + { + if ((attributes_old & FILE_ATTRIBUTE_DIRECTORY) != 0) + errno = ENOTDIR; + else + errno = EISDIR; + return -1; + } + if ((attributes_new & FILE_ATTRIBUTE_DIRECTORY) != 0) { if (_rmdir (newname_a) != 0) return result; commit 7791bca1c5f01fbb41215d9ba09b9432e9a07b49 Author: Eli Zaretskii Date: Thu Aug 17 17:58:08 2017 +0300 * src/w32.c (sys_rename_replace): Support renaming a directory. diff --git a/src/w32.c b/src/w32.c index c821e245d8..7cd58d07d8 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4504,6 +4504,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) result = _wrename (temp_w, newname_w); if (result < 0) { + DWORD attributes; DWORD w32err = GetLastError (); if (errno == EACCES @@ -4514,8 +4515,6 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) different storage device (ex. logical disk). It returns EACCES instead. So here we handle such situations and return EXDEV. */ - DWORD attributes; - if ((attributes = GetFileAttributesW (temp_w)) != -1 && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; @@ -4524,7 +4523,13 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) { if (_wchmod (newname_w, 0666) != 0) return result; - if (_wunlink (newname_w) != 0) + if ((attributes = GetFileAttributesW (newname_w)) != -1 + && (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0) + { + if (_wrmdir (newname_w) != 0) + return result; + } + else if (_wunlink (newname_w) != 0) return result; result = _wrename (temp_w, newname_w); } @@ -4548,13 +4553,12 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) result = rename (temp_a, newname_a); if (result < 0) { + DWORD attributes; DWORD w32err = GetLastError (); if (errno == EACCES && newname_dev != oldname_dev) { - DWORD attributes; - if ((attributes = GetFileAttributesA (temp_a)) != -1 && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; @@ -4563,7 +4567,13 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) { if (_chmod (newname_a, 0666) != 0) return result; - if (_unlink (newname_a) != 0) + if ((attributes = GetFileAttributesA (newname_a)) != -1 + && (attributes & FILE_ATTRIBUTE_DIRECTORY) != 0) + { + if (_rmdir (newname_a) != 0) + return result; + } + else if (_unlink (newname_a) != 0) return result; result = rename (temp_a, newname_a); } commit 5a5aa6ed27e910a216339df44f96f81e3d6b6ef6 Merge: 2cfb32bf4c 13993c46a2 Author: Eli Zaretskii Date: Thu Aug 17 17:44:22 2017 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit 2cfb32bf4cbb726b83db82e414acced03781f99d Author: Eli Zaretskii Date: Thu Aug 17 17:43:19 2017 +0300 Fix the MS-Windows build * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_open): Omit Gnulib module 'open'. * lib-src/etags.c (O_CLOEXEC) [WINDOWSNT]: Restore definition. diff --git a/lib-src/etags.c b/lib-src/etags.c index bec61a8a23..5e05c19c62 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -111,6 +111,8 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # undef HAVE_NTGUI # undef DOS_NT # define DOS_NT +/* The WINDOWSNT build doesn't use Gnulib's fcntl.h. */ +# define O_CLOEXEC O_NOINHERIT #endif /* WINDOWSNT */ #include diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index d2b96f99e2..b75e36f5aa 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -50,6 +50,7 @@ OMIT_GNULIB_MODULE_dirfd = true OMIT_GNULIB_MODULE_fcntl = true OMIT_GNULIB_MODULE_fcntl-h = true OMIT_GNULIB_MODULE_inttypes-incomplete = true +OMIT_GNULIB_MODULE_open = true OMIT_GNULIB_MODULE_pipe2 = true OMIT_GNULIB_MODULE_secure_getenv = true OMIT_GNULIB_MODULE_signal-h = true commit 13993c46a21495167517f76d2e36b6c09ac5e89e Author: João Távora Date: Thu Aug 17 14:18:00 2017 +0100 Add flymake-backends defcustom * lisp/progmodes/flymake-proc.el (flymake-proc-can-syntax-check-buffer): Rename from flymake-can-syntax-check-file. Suitable for adding to flymake-backends. (flymake-proc-start-syntax-check): Rename from flymake-start-syntax-check. Don't check again if buffer can be checked. (add-to-list flymake-backends): Hook only flymake-ui.el * lisp/progmodes/flymake-ui.el (flymake-backends): New defcustom. (flymake-on-timer-event, flymake-after-change-function) (flymake-after-save-hook, flymake-find-file-hook): Call new flymake--start-syntax-check-buffer and flymake--can-syntax-check-buffer. (flymake-mode): Call flymake--can-syntax-check-buffer and set flymake-backend. (flymake--backend): New buffer-local variable. diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el index 8a2fede2df..30555559e6 100644 --- a/lisp/progmodes/flymake-proc.el +++ b/lisp/progmodes/flymake-proc.el @@ -120,10 +120,12 @@ NAME is the file name function to use, default `flymake-get-real-file-name'." (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) mode-and-masks)) -(defun flymake-can-syntax-check-file (file-name) - "Determine whether we can syntax check FILE-NAME. -Return nil if we cannot, non-nil if we can." - (if (flymake-get-init-function file-name) t nil)) +(defun flymake-proc-can-syntax-check-buffer () + "Determine whether we can syntax check current buffer. +Return nil if we cannot, non-nil if +we can." + (and buffer-file-name + (if (flymake-get-init-function buffer-file-name) t nil))) (defun flymake-get-init-function (file-name) "Return init function to be used for the file." @@ -714,12 +716,11 @@ Return its components if so, nil otherwise." (error (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) -(defun flymake-start-syntax-check () +(defun flymake-proc-start-syntax-check () "Start syntax checking for current buffer." (interactive) (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file buffer-file-name)) + (when (not flymake-is-running) (when (or (not flymake-compilation-prevents-syntax-check) (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") (flymake-clear-buildfile-cache) @@ -1084,5 +1085,13 @@ Use CREATE-TEMP-F for creating temp copy." (list "val" (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))) + +;;;; Hook onto flymake-ui + +(add-to-list 'flymake-backends + `(flymake-proc-can-syntax-check-buffer + . + flymake-proc-start-syntax-check)) + (provide 'flymake-proc) ;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el index c1dffb4e7e..3fb1ecaa7f 100644 --- a/lisp/progmodes/flymake-ui.el +++ b/lisp/progmodes/flymake-ui.el @@ -108,6 +108,17 @@ See `flymake-error-bitmap' and `flymake-warning-bitmap'." :group 'flymake :type 'integer) +(defcustom flymake-backends '() + "Ordered list of backends providing syntax check information for a buffer. +Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE +and CHECKER are functions called with a single argument, the +buffer in which `flymake-mode' was enabled. PREDICATE is expected +to (quickly) return t or nil if the buffer can be syntax checked +by CHECKER, which in can performs more morose operations, +possibly asynchronously." + :group 'flymake + :type 'alist) + (defvar-local flymake-timer nil "Timer for starting syntax check.") @@ -368,7 +379,7 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (setq flymake-last-change-time nil) (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check))))) + (flymake--start-syntax-check))))) (define-obsolete-function-alias 'flymake-display-err-menu-for-current-line 'flymake-popup-current-error-menu "24.4") @@ -442,6 +453,20 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" (buffer-name) status warning)) +(defvar-local flymake--backend nil + "The currently active backend selected by `flymake-mode'") + +(defun flymake--can-syntax-check-buffer (buffer) + (let ((all flymake-backends) + (candidate)) + (catch 'done + (while (setq candidate (pop all)) + (when (with-current-buffer buffer (funcall (car candidate))) + (throw 'done (cdr candidate))))))) + +(defun flymake--start-syntax-check () + (funcall flymake--backend)) + ;;;###autoload (define-minor-mode flymake-mode nil :group 'flymake :lighter flymake-mode-line @@ -449,31 +474,36 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." ;; Turning the mode ON. (flymake-mode - (cond - ((not buffer-file-name) - (message "Flymake unable to run without a buffer file name")) - ((not (flymake-can-syntax-check-file buffer-file-name)) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - - (flymake-report-status "" "") - - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake-start-syntax-check)))))) + (let* ((backend (flymake--can-syntax-check-buffer (current-buffer)))) + (cond + ((not backend) + (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) + (t + (setq flymake--backend backend) + + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) + + (flymake-report-status "" "") + + (setq flymake-timer + (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) + + (when (and flymake-start-syntax-check-on-find-file + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name))) + (with-demoted-errors + (flymake--start-syntax-check))))) + ) + ) ;; Turning the mode OFF. (t + (setq flymake--backend nil) + (remove-hook 'after-change-functions 'flymake-after-change-function t) (remove-hook 'after-save-hook 'flymake-after-save-hook t) (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) @@ -505,14 +535,14 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (let((new-text (buffer-substring start stop))) (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check)) + (flymake--start-syntax-check)) (setq flymake-last-change-time (float-time)))) (defun flymake-after-save-hook () (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? (progn (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + (flymake--start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) (defun flymake-kill-buffer-hook () (when flymake-timer @@ -523,10 +553,10 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (defun flymake-find-file-hook () ;;+(when flymake-start-syntax-check-on-find-file ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check) + ;;+ (flymake--start-syntax-check) ;;+) (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake-can-syntax-check-file buffer-file-name)) + (flymake--can-syntax-check-buffer (current-buffer))) (flymake-mode) (flymake-log 3 "automatically turned ON flymake mode"))) commit eb34f7f5a29e7bf62326ecb6e693f28878be28cd Author: João Távora Date: Thu Aug 17 12:43:05 2017 +0100 Split flymake.el into flymake-proc.el and flymake-ui.el flymake.el is now a stub that requires both files. * lisp/progmodes/flymake-proc.el: New file. * lisp/progmodes/flymake-ui.el: New file. * lisp/progmodes/flymake.el: Split into flymake-ui.el and flymake-proc.el. Require both files. diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el new file mode 100644 index 0000000000..8a2fede2df --- /dev/null +++ b/lisp/progmodes/flymake-proc.el @@ -0,0 +1,1088 @@ +;;; flymake-proc.el --- Flymake for external syntax checker processes -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2017 Free Software Foundation, Inc. + +;; Author: Pavel Kobyakov +;; Maintainer: Leo Liu +;; Version: 0.3 +;; Keywords: c languages tools + +;; 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: +;; +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. +;; +;; This file contains the most original implementation of flymake's +;; main source of on-the-fly diagnostic info, the external syntax +;; checker backend. +;; +;;; Bugs/todo: + +;; - Only uses "Makefile", not "makefile" or "GNUmakefile" +;; (from http://bugs.debian.org/337339). + +;;; Code: + +(require 'flymake-ui) + +(defcustom flymake-compilation-prevents-syntax-check t + "If non-nil, don't start syntax check if compilation is running." + :group 'flymake + :type 'boolean) + +(defcustom flymake-xml-program + (if (executable-find "xmlstarlet") "xmlstarlet" "xml") + "Program to use for XML validation." + :type 'file + :group 'flymake + :version "24.4") + +(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") + "Dirs where to look for master files." + :group 'flymake + :type '(repeat (string))) + +(defcustom flymake-master-file-count-limit 32 + "Max number of master files to check." + :group 'flymake + :type 'integer) + +(defcustom flymake-allowed-file-name-masks + '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) + ("\\.xml\\'" flymake-xml-init) + ("\\.html?\\'" flymake-xml-init) + ("\\.cs\\'" flymake-simple-make-init) + ("\\.p[ml]\\'" flymake-perl-init) + ("\\.php[345]?\\'" flymake-php-init) + ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) + ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) + ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) + ("\\.tex\\'" flymake-simple-tex-init) + ("\\.idl\\'" flymake-simple-make-init) + ;; ("\\.cpp\\'" 1) + ;; ("\\.java\\'" 3) + ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") + ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) + ;; ("\\.idl\\'" 1) + ;; ("\\.odl\\'" 1) + ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") + ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) + ;; ("\\.tex\\'" 1) + ) + "Files syntax checking is allowed for. +This is an alist with elements of the form: + REGEXP INIT [CLEANUP [NAME]] +REGEXP is a regular expression that matches a file name. +INIT is the init function to use. +CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. +NAME is the file name function to use, default `flymake-get-real-file-name'." + :group 'flymake + :type '(alist :key-type (regexp :tag "File regexp") + :value-type + (list :tag "Handler functions" + (function :tag "Init function") + (choice :tag "Cleanup function" + (const :tag "flymake-simple-cleanup" nil) + function) + (choice :tag "Name function" + (const :tag "flymake-get-real-file-name" nil) + function)))) + +(defvar flymake-processes nil + "List of currently active flymake processes.") + +(defvar-local flymake-output-residual nil) + +(defun flymake-get-file-name-mode-and-masks (file-name) + "Return the corresponding entry from `flymake-allowed-file-name-masks'." + (unless (stringp file-name) + (error "Invalid file-name")) + (let ((fnm flymake-allowed-file-name-masks) + (mode-and-masks nil)) + (while (and (not mode-and-masks) fnm) + (if (string-match (car (car fnm)) file-name) + (setq mode-and-masks (cdr (car fnm)))) + (setq fnm (cdr fnm))) + (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) + mode-and-masks)) + +(defun flymake-can-syntax-check-file (file-name) + "Determine whether we can syntax check FILE-NAME. +Return nil if we cannot, non-nil if we can." + (if (flymake-get-init-function file-name) t nil)) + +(defun flymake-get-init-function (file-name) + "Return init function to be used for the file." + (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) + ;;(flymake-log 0 "calling %s" init-f) + ;;(funcall init-f (current-buffer)) + init-f)) + +(defun flymake-get-cleanup-function (file-name) + "Return cleanup function to be used for the file." + (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) + 'flymake-simple-cleanup)) + +(defun flymake-get-real-file-name-function (file-name) + (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) + 'flymake-get-real-file-name)) + +(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) + +(defun flymake-get-buildfile-from-cache (dir-name) + "Look up DIR-NAME in cache and return its associated value. +If DIR-NAME is not found, return nil." + (gethash dir-name flymake-find-buildfile-cache)) + +(defun flymake-add-buildfile-to-cache (dir-name buildfile) + "Associate DIR-NAME with BUILDFILE in the buildfile cache." + (puthash dir-name buildfile flymake-find-buildfile-cache)) + +(defun flymake-clear-buildfile-cache () + "Clear the buildfile cache." + (clrhash flymake-find-buildfile-cache)) + +(defun flymake-find-buildfile (buildfile-name source-dir-name) + "Find buildfile starting from current directory. +Buildfile includes Makefile, build.xml etc. +Return its file name if found, or nil if not found." + (or (flymake-get-buildfile-from-cache source-dir-name) + (let* ((file (locate-dominating-file source-dir-name buildfile-name))) + (if file + (progn + (flymake-log 3 "found buildfile at %s" file) + (flymake-add-buildfile-to-cache source-dir-name file) + file) + (progn + (flymake-log 3 "buildfile for %s not found" source-dir-name) + nil))))) + +(defun flymake-fix-file-name (name) + "Replace all occurrences of `\\' with `/'." + (when name + (setq name (expand-file-name name)) + (setq name (abbreviate-file-name name)) + (setq name (directory-file-name name)) + name)) + +(defun flymake-same-files (file-name-one file-name-two) + "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. +Return t if so, nil if not." + (equal (flymake-fix-file-name file-name-one) + (flymake-fix-file-name file-name-two))) + +;; This is bound dynamically to pass a parameter to a sort predicate below +(defvar flymake-included-file-name) + +(defun flymake-find-possible-master-files (file-name master-file-dirs masks) + "Find (by name and location) all possible master files. + +Name is specified by FILE-NAME and location is specified by +MASTER-FILE-DIRS. Master files include .cpp and .c for .h. +Files are searched for starting from the .h directory and max +max-level parent dirs. File contents are not checked." + (let* ((dirs master-file-dirs) + (files nil) + (done nil)) + + (while (and (not done) dirs) + (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) + (masks masks)) + (while (and (file-exists-p dir) (not done) masks) + (let* ((mask (car masks)) + (dir-files (directory-files dir t mask))) + + (flymake-log 3 "dir %s, %d file(s) for mask %s" + dir (length dir-files) mask) + (while (and (not done) dir-files) + (when (not (file-directory-p (car dir-files))) + (setq files (cons (car dir-files) files)) + (when (>= (length files) flymake-master-file-count-limit) + (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) + (setq done t))) + (setq dir-files (cdr dir-files)))) + (setq masks (cdr masks)))) + (setq dirs (cdr dirs))) + (when files + (let ((flymake-included-file-name (file-name-nondirectory file-name))) + (setq files (sort files 'flymake-master-file-compare)))) + (flymake-log 3 "found %d possible master file(s)" (length files)) + files)) + +(defun flymake-master-file-compare (file-one file-two) + "Compare two files specified by FILE-ONE and FILE-TWO. +This function is used in sort to move most possible file names +to the beginning of the list (File.h -> File.cpp moved to top)." + (and (equal (file-name-sans-extension flymake-included-file-name) + (file-name-base file-one)) + (not (equal file-one file-two)))) + +(defvar flymake-check-file-limit 8192 + "Maximum number of chars to look at when checking possible master file. +Nil means search the entire file.") + +(defun flymake-check-patch-master-file-buffer + (master-file-temp-buffer + master-file-name patched-master-file-name + source-file-name patched-source-file-name + include-dirs regexp) + "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. +If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME +instead of SOURCE-FILE-NAME. + +For example, foo.cpp is a master file if it includes foo.h. + +When a buffer for MASTER-FILE-NAME exists, use it as a source +instead of reading master file from disk." + (let* ((source-file-nondir (file-name-nondirectory source-file-name)) + (source-file-extension (file-name-extension source-file-nondir)) + (source-file-nonext (file-name-sans-extension source-file-nondir)) + (found nil) + (inc-name nil) + (search-limit flymake-check-file-limit)) + (setq regexp + (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" + ;; Hack for tex files, where \include often excludes .tex. + ;; Maybe this is safe generally. + (if (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex")) + (format "%s\\(?:\\.%s\\)?" + (regexp-quote source-file-nonext) + (regexp-quote source-file-extension)) + (regexp-quote source-file-nondir)))) + (unwind-protect + (with-current-buffer master-file-temp-buffer + (if (or (not search-limit) + (> search-limit (point-max))) + (setq search-limit (point-max))) + (flymake-log 3 "checking %s against regexp %s" + master-file-name regexp) + (goto-char (point-min)) + (while (and (< (point) search-limit) + (re-search-forward regexp search-limit t)) + (let ((match-beg (match-beginning 1)) + (match-end (match-end 1))) + + (flymake-log 3 "found possible match for %s" source-file-nondir) + (setq inc-name (match-string 1)) + (and (> (length source-file-extension) 1) + (string-equal source-file-extension "tex") + (not (string-match (format "\\.%s\\'" source-file-extension) + inc-name)) + (setq inc-name (concat inc-name "." source-file-extension))) + (when (eq t (compare-strings + source-file-nondir nil nil + inc-name (- (length inc-name) + (length source-file-nondir)) nil)) + (flymake-log 3 "inc-name=%s" inc-name) + (when (flymake-check-include source-file-name inc-name + include-dirs) + (setq found t) + ;; replace-match is not used here as it fails in + ;; XEmacs with 'last match not a buffer' error as + ;; check-includes calls replace-in-string + (flymake-replace-region + match-beg match-end + (file-name-nondirectory patched-source-file-name)))) + (forward-line 1))) + (when found + (flymake-save-buffer-in-file patched-master-file-name))) + ;;+(flymake-log 3 "killing buffer %s" + ;; (buffer-name master-file-temp-buffer)) + (kill-buffer master-file-temp-buffer)) + ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) + (when found + (flymake-log 2 "found master file %s" master-file-name)) + found)) + +;;; XXX: remove +(defun flymake-replace-region (beg end rep) + "Replace text in BUFFER in region (BEG END) with REP." + (save-excursion + (goto-char end) + ;; Insert before deleting, so as to better preserve markers's positions. + (insert rep) + (delete-region beg end))) + +(defun flymake-read-file-to-temp-buffer (file-name) + "Insert contents of FILE-NAME into newly created temp buffer." + (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) + (with-current-buffer temp-buffer + (insert-file-contents file-name)) + temp-buffer)) + +(defun flymake-copy-buffer-to-temp-buffer (buffer) + "Copy contents of BUFFER into newly created temp buffer." + (with-current-buffer + (get-buffer-create (generate-new-buffer-name + (concat "flymake:" (buffer-name buffer)))) + (insert-buffer-substring buffer) + (current-buffer))) + +(defun flymake-check-include (source-file-name inc-name include-dirs) + "Check if SOURCE-FILE-NAME can be found in include path. +Return t if it can be found via include path using INC-NAME." + (if (file-name-absolute-p inc-name) + (flymake-same-files source-file-name inc-name) + (while (and include-dirs + (not (flymake-same-files + source-file-name + (concat (file-name-directory source-file-name) + "/" (car include-dirs) + "/" inc-name)))) + (setq include-dirs (cdr include-dirs))) + include-dirs)) + +(defun flymake-find-buffer-for-file (file-name) + "Check if there exists a buffer visiting FILE-NAME. +Return t if so, nil if not." + (let ((buffer-name (get-file-buffer file-name))) + (if buffer-name + (get-buffer buffer-name)))) + +(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) + "Save SOURCE-FILE-NAME with a different name. +Find master file, patch and save it." + (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) + (master-file-count (length possible-master-files)) + (idx 0) + (temp-buffer nil) + (master-file-name nil) + (patched-master-file-name nil) + (found nil)) + + (while (and (not found) (< idx master-file-count)) + (setq master-file-name (nth idx possible-master-files)) + (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) + (if (flymake-find-buffer-for-file master-file-name) + (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) + (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) + (setq found + (flymake-check-patch-master-file-buffer + temp-buffer + master-file-name + patched-master-file-name + source-file-name + patched-source-file-name + (funcall get-incl-dirs-f (file-name-directory master-file-name)) + include-regexp)) + (setq idx (1+ idx))) + (if found + (list master-file-name patched-master-file-name) + (progn + (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count + (file-name-nondirectory source-file-name)) + nil)))) + +(defun flymake-save-buffer-in-file (file-name) + "Save the entire buffer contents into file FILE-NAME. +Create parent directories as needed." + (make-directory (file-name-directory file-name) 1) + (write-region nil nil file-name nil 566) + (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) + +(defun flymake-process-filter (process output) + "Parse OUTPUT and highlight error lines. +It's flymake process filter." + (let ((source-buffer (process-buffer process))) + + (flymake-log 3 "received %d byte(s) of output from process %d" + (length output) (process-id process)) + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (flymake-parse-output-and-residual output))))) + +(defun flymake-process-sentinel (process _event) + "Sentinel for syntax check buffers." + (when (memq (process-status process) '(signal exit)) + (let* ((exit-status (process-exit-status process)) + (command (process-command process)) + (source-buffer (process-buffer process)) + (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) + + (flymake-log 2 "process %d exited with code %d" + (process-id process) exit-status) + (condition-case err + (progn + (flymake-log 3 "cleaning up using %s" cleanup-f) + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + (funcall cleanup-f))) + + (delete-process process) + (setq flymake-processes (delq process flymake-processes)) + + (when (buffer-live-p source-buffer) + (with-current-buffer source-buffer + + (flymake-parse-residual) + (flymake-post-syntax-check exit-status command) + (setq flymake-is-running nil)))) + (error + (let ((err-str (format "Error in process sentinel for buffer %s: %s" + source-buffer (error-message-string err)))) + (flymake-log 0 err-str) + (with-current-buffer source-buffer + (setq flymake-is-running nil)))))))) + +(defun flymake-post-syntax-check (exit-status command) + (save-restriction + (widen) + (setq flymake-err-info flymake-new-err-info) + (setq flymake-new-err-info nil) + (setq flymake-err-info + (flymake-fix-line-numbers + flymake-err-info 1 (count-lines (point-min) (point-max)))) + (flymake-delete-own-overlays) + (flymake-highlight-err-lines flymake-err-info) + (let (err-count warn-count) + (setq err-count (flymake-get-err-count flymake-err-info "e")) + (setq warn-count (flymake-get-err-count flymake-err-info "w")) + (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" + (buffer-name) err-count warn-count + (- (float-time) flymake-check-start-time)) + (setq flymake-check-start-time nil) + + (if (and (equal 0 err-count) (equal 0 warn-count)) + (if (equal 0 exit-status) + (flymake-report-status "" "") ; PASSED + (if (not flymake-check-was-interrupted) + (flymake-report-fatal-status "CFGERR" + (format "Configuration error has occurred while running %s" command)) + (flymake-report-status nil ""))) ; "STOPPED" + (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) + +(defun flymake-parse-output-and-residual (output) + "Split OUTPUT into lines, merge in residual if necessary." + (let* ((buffer-residual flymake-output-residual) + (total-output (if buffer-residual (concat buffer-residual output) output)) + (lines-and-residual (flymake-split-output total-output)) + (lines (nth 0 lines-and-residual)) + (new-residual (nth 1 lines-and-residual))) + (setq flymake-output-residual new-residual) + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info lines)))) + +(defun flymake-parse-residual () + "Parse residual if it's non empty." + (when flymake-output-residual + (setq flymake-new-err-info + (flymake-parse-err-lines + flymake-new-err-info + (list flymake-output-residual))) + (setq flymake-output-residual nil))) + +(defun flymake-fix-line-numbers (err-info-list min-line max-line) + "Replace line numbers with fixed value. +If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. +If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. +The reason for this fix is because some compilers might report +line number outside the file being compiled." + (let* ((count (length err-info-list)) + (err-info nil) + (line 0)) + (while (> count 0) + (setq err-info (nth (1- count) err-info-list)) + (setq line (flymake-er-get-line err-info)) + (when (or (< line min-line) (> line max-line)) + (setq line (if (< line min-line) min-line max-line)) + (setq err-info-list (flymake-set-at err-info-list (1- count) + (flymake-er-make-er line + (flymake-er-get-line-err-info-list err-info))))) + (setq count (1- count)))) + err-info-list) + +(defun flymake-parse-err-lines (err-info-list lines) + "Parse err LINES, store info in ERR-INFO-LIST." + (let* ((count (length lines)) + (idx 0) + (line-err-info nil) + (real-file-name nil) + (source-file-name buffer-file-name) + (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) + + (while (< idx count) + (setq line-err-info (flymake-parse-line (nth idx lines))) + (when line-err-info + (setq real-file-name (funcall get-real-file-name-f + (flymake-ler-file line-err-info))) + (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) + + (when (flymake-same-files real-file-name source-file-name) + (setq line-err-info (flymake-ler-set-file line-err-info nil)) + (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) + (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) + (setq idx (1+ idx))) + err-info-list)) + +(defun flymake-split-output (output) + "Split OUTPUT into lines. +Return last one as residual if it does not end with newline char. +Returns ((LINES) RESIDUAL)." + (when (and output (> (length output) 0)) + (let* ((lines (split-string output "[\n\r]+" t)) + (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) + (residual nil)) + (when (not complete) + (setq residual (car (last lines))) + (setq lines (butlast lines))) + (list lines residual)))) + +(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) + "Grab error line patterns from ORIGINAL-LIST in compile.el format. +Convert it to flymake internal format." + (let* ((converted-list '())) + (dolist (item original-list) + (setq item (cdr item)) + (let ((regexp (nth 0 item)) + (file (nth 1 item)) + (line (nth 2 item)) + (col (nth 3 item))) + (if (consp file) (setq file (car file))) + (if (consp line) (setq line (car line))) + (if (consp col) (setq col (car col))) + + (when (not (functionp line)) + (setq converted-list (cons (list regexp file line col) converted-list))))) + converted-list)) + +(require 'compile) + +(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text + (append + '( + ;; MS Visual C++ 6.0 + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; jikes + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; MS midl + ("midl[ ]*:[ ]*\\(command line error .*\\)" + nil nil nil 1) + ;; MS C# + ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" + 1 3 nil 4) + ;; perl + ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) + ;; PHP + ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) + ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) + ;; ant/javac. Note this also matches gcc warnings! + (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" + 2 4 nil 5)) + ;; compilation-error-regexp-alist) + (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) + "Patterns for matching error/warning lines. Each pattern has the form +\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). +Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns +from compile.el") + +(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") +(defvar flymake-warning-predicate "^[wW]arning" + "Predicate matching against error text to detect a warning. +Takes a single argument, the error's text and should return non-nil +if it's a warning. +Instead of a function, it can also be a regular expression.") + +(defun flymake-parse-line (line) + "Parse LINE to see if it is an error or warning. +Return its components if so, nil otherwise." + (let ((raw-file-name nil) + (line-no 0) + (err-type "e") + (err-text nil) + (patterns flymake-err-line-patterns) + (matched nil)) + (while (and patterns (not matched)) + (when (string-match (car (car patterns)) line) + (let* ((file-idx (nth 1 (car patterns))) + (line-idx (nth 2 (car patterns)))) + + (setq raw-file-name (if file-idx (match-string file-idx line) nil)) + (setq line-no (if line-idx (string-to-number + (match-string line-idx line)) 0)) + (setq err-text (if (> (length (car patterns)) 4) + (match-string (nth 4 (car patterns)) line) + (flymake-patch-err-text + (substring line (match-end 0))))) + (if (null err-text) + (setq err-text "") + (when (cond ((stringp flymake-warning-predicate) + (string-match flymake-warning-predicate err-text)) + ((functionp flymake-warning-predicate) + (funcall flymake-warning-predicate err-text))) + (setq err-type "w"))) + (flymake-log + 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" + file-idx line-idx raw-file-name line-no err-text) + (setq matched t))) + (setq patterns (cdr patterns))) + (if matched + (flymake-ler-make-ler raw-file-name line-no err-type err-text) + ()))) + +(defun flymake-get-project-include-dirs-imp (basedir) + "Include dirs for the project current file belongs to." + (if (flymake-get-project-include-dirs-from-cache basedir) + (progn + (flymake-get-project-include-dirs-from-cache basedir)) + ;;else + (let* ((command-line (concat "make -C " + (shell-quote-argument basedir) + " DUMPVARS=INCLUDE_DIRS dumpvars")) + (output (shell-command-to-string command-line)) + (lines (split-string output "\n" t)) + (count (length lines)) + (idx 0) + (inc-dirs nil)) + (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) + (setq idx (1+ idx))) + (when (< idx count) + (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) + (inc-count (length inc-lines))) + (while (> inc-count 0) + (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) + (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) + (setq inc-count (1- inc-count))))) + (flymake-add-project-include-dirs-to-cache basedir inc-dirs) + inc-dirs))) + +(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp + "Function used to get project include dirs, one parameter: basedir name.") + +(defun flymake-get-project-include-dirs (basedir) + (funcall flymake-get-project-include-dirs-function basedir)) + +(defun flymake-get-system-include-dirs () + "System include dirs - from the `INCLUDE' env setting." + (let* ((includes (getenv "INCLUDE"))) + (if includes (split-string includes path-separator t) nil))) + +(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) + +(defun flymake-get-project-include-dirs-from-cache (base-dir) + (gethash base-dir flymake-project-include-dirs-cache)) + +(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) + (puthash base-dir include-dirs flymake-project-include-dirs-cache)) + +(defun flymake-clear-project-include-dirs-cache () + (clrhash flymake-project-include-dirs-cache)) + +(defun flymake-get-include-dirs (base-dir) + "Get dirs to use when resolving local file names." + (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) + include-dirs)) + +;; (defun flymake-restore-formatting () +;; "Remove any formatting made by flymake." +;; ) + +;; (defun flymake-get-program-dir (buffer) +;; "Get dir to start program in." +;; (unless (bufferp buffer) +;; (error "Invalid buffer")) +;; (with-current-buffer buffer +;; default-directory)) + +(defun flymake-safe-delete-file (file-name) + (when (and file-name (file-exists-p file-name)) + (delete-file file-name) + (flymake-log 1 "deleted file %s" file-name))) + +(defun flymake-safe-delete-directory (dir-name) + (condition-case nil + (progn + (delete-directory dir-name) + (flymake-log 1 "deleted dir %s" dir-name)) + (error + (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) + +(defun flymake-start-syntax-check () + "Start syntax checking for current buffer." + (interactive) + (flymake-log 3 "flymake is running: %s" flymake-is-running) + (when (and (not flymake-is-running) + (flymake-can-syntax-check-file buffer-file-name)) + (when (or (not flymake-compilation-prevents-syntax-check) + (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") + (flymake-clear-buildfile-cache) + (flymake-clear-project-include-dirs-cache) + + (setq flymake-check-was-interrupted nil) + + (let* ((source-file-name buffer-file-name) + (init-f (flymake-get-init-function source-file-name)) + (cleanup-f (flymake-get-cleanup-function source-file-name)) + (cmd-and-args (funcall init-f)) + (cmd (nth 0 cmd-and-args)) + (args (nth 1 cmd-and-args)) + (dir (nth 2 cmd-and-args))) + (if (not cmd-and-args) + (progn + (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) + (funcall cleanup-f)) + (progn + (setq flymake-last-change-time nil) + (flymake-start-syntax-check-process cmd args dir))))))) + +(defun flymake-start-syntax-check-process (cmd args dir) + "Start syntax check process." + (condition-case err + (let* ((process + (let ((default-directory (or dir default-directory))) + (when dir + (flymake-log 3 "starting process on dir %s" dir)) + (apply 'start-file-process + "flymake-proc" (current-buffer) cmd args)))) + (set-process-sentinel process 'flymake-process-sentinel) + (set-process-filter process 'flymake-process-filter) + (set-process-query-on-exit-flag process nil) + (push process flymake-processes) + + (setq flymake-is-running t) + (setq flymake-last-change-time nil) + (setq flymake-check-start-time (float-time)) + + (flymake-report-status nil "*") + (flymake-log 2 "started process %d, command=%s, dir=%s" + (process-id process) (process-command process) + default-directory) + process) + (error + (let* ((err-str + (format-message + "Failed to launch syntax check process `%s' with args %s: %s" + cmd args (error-message-string err))) + (source-file-name buffer-file-name) + (cleanup-f (flymake-get-cleanup-function source-file-name))) + (flymake-log 0 err-str) + (funcall cleanup-f) + (flymake-report-fatal-status "PROCERR" err-str))))) + +(defun flymake-kill-process (proc) + "Kill process PROC." + (kill-process proc) + (let* ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (setq flymake-check-was-interrupted t)))) + (flymake-log 1 "killed process %d" (process-id proc))) + +(defun flymake-stop-all-syntax-checks () + "Kill all syntax check processes." + (interactive) + (while flymake-processes + (flymake-kill-process (pop flymake-processes)))) + +(defun flymake-compilation-is-running () + (and (boundp 'compilation-in-progress) + compilation-in-progress)) + +(defun flymake-compile () + "Kill all flymake syntax checks, start compilation." + (interactive) + (flymake-stop-all-syntax-checks) + (call-interactively 'compile)) + +;;;; general init-cleanup and helper routines +(defun flymake-create-temp-inplace (file-name prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + (or prefix + (setq prefix "flymake")) + (let* ((ext (file-name-extension file-name)) + (temp-name (file-truename + (concat (file-name-sans-extension file-name) + "_" prefix + (and ext (concat "." ext)))))) + (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) + temp-name)) + +(defun flymake-create-temp-with-folder-structure (file-name _prefix) + (unless (stringp file-name) + (error "Invalid file-name")) + + (let* ((dir (file-name-directory file-name)) + ;; Not sure what this slash-pos is all about, but I guess it's just + ;; trying to remove the leading / of absolute file names. + (slash-pos (string-match "/" dir)) + (temp-dir (expand-file-name (substring dir (1+ slash-pos)) + temporary-file-directory))) + + (file-truename (expand-file-name (file-name-nondirectory file-name) + temp-dir)))) + +(defun flymake-delete-temp-directory (dir-name) + "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." + (let* ((temp-dir temporary-file-directory) + (suffix (substring dir-name (1+ (length temp-dir))))) + + (while (> (length suffix) 0) + (setq suffix (directory-file-name suffix)) + ;;+(flymake-log 0 "suffix=%s" suffix) + (flymake-safe-delete-directory + (file-truename (expand-file-name suffix temp-dir))) + (setq suffix (file-name-directory suffix))))) + +(defvar-local flymake-temp-source-file-name nil) +(defvar-local flymake-master-file-name nil) +(defvar-local flymake-temp-master-file-name nil) +(defvar-local flymake-base-dir nil) + +(defun flymake-init-create-temp-buffer-copy (create-temp-f) + "Make a temporary copy of the current buffer, save its name in buffer data and return the name." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) + + (flymake-save-buffer-in-file temp-source-file-name) + (setq flymake-temp-source-file-name temp-source-file-name) + temp-source-file-name)) + +(defun flymake-simple-cleanup () + "Do cleanup after `flymake-init-create-temp-buffer-copy'. +Delete temp file." + (flymake-safe-delete-file flymake-temp-source-file-name) + (setq flymake-last-change-time nil)) + +(defun flymake-get-real-file-name (file-name-from-err-msg) + "Translate file name from error message to \"real\" file name. +Return full-name. Names are real, not patched." + (let* ((real-name nil) + (source-file-name buffer-file-name) + (master-file-name flymake-master-file-name) + (temp-source-file-name flymake-temp-source-file-name) + (temp-master-file-name flymake-temp-master-file-name) + (base-dirs + (list flymake-base-dir + (file-name-directory source-file-name) + (if master-file-name (file-name-directory master-file-name)))) + (files (list (list source-file-name source-file-name) + (list temp-source-file-name source-file-name) + (list master-file-name master-file-name) + (list temp-master-file-name master-file-name)))) + + (when (equal 0 (length file-name-from-err-msg)) + (setq file-name-from-err-msg source-file-name)) + + (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) + ;; if real-name is nil, than file name from err msg is none of the files we've patched + (if (not real-name) + (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) + (if (not real-name) + (setq real-name file-name-from-err-msg)) + (setq real-name (flymake-fix-file-name real-name)) + (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) + real-name)) + +(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) + (let* ((base-dirs-count (length base-dirs)) + (file-count (length files)) + (real-name nil)) + + (while (and (not real-name) (> base-dirs-count 0)) + (setq file-count (length files)) + (while (and (not real-name) (> file-count 0)) + (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) + (this-file (nth 0 (nth (1- file-count) files))) + (this-real-name (nth 1 (nth (1- file-count) files)))) + ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) + (when (and this-dir this-file (flymake-same-files + (expand-file-name file-name-from-err-msg this-dir) + this-file)) + (setq real-name this-real-name))) + (setq file-count (1- file-count))) + (setq base-dirs-count (1- base-dirs-count))) + real-name)) + +(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) + (let* ((real-name nil)) + (if (file-name-absolute-p file-name-from-err-msg) + (setq real-name file-name-from-err-msg) + (let* ((base-dirs-count (length base-dirs))) + (while (and (not real-name) (> base-dirs-count 0)) + (let* ((full-name (expand-file-name file-name-from-err-msg + (nth (1- base-dirs-count) base-dirs)))) + (if (file-exists-p full-name) + (setq real-name full-name)) + (setq base-dirs-count (1- base-dirs-count)))))) + real-name)) + +(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) + "Find buildfile, store its dir in buffer data and return its dir, if found." + (let* ((buildfile-dir + (flymake-find-buildfile buildfile-name + (file-name-directory source-file-name)))) + (if buildfile-dir + (setq flymake-base-dir buildfile-dir) + (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) + (flymake-report-fatal-status + "NOMK" (format "No buildfile (%s) found for %s" + buildfile-name source-file-name))))) + +(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) + "Find master file (or buffer), create its copy along with a copy of the source file." + (let* ((source-file-name buffer-file-name) + (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) + (master-and-temp-master (flymake-create-master-file + source-file-name temp-source-file-name + get-incl-dirs-f create-temp-f + master-file-masks include-regexp))) + + (if (not master-and-temp-master) + (progn + (flymake-log 1 "cannot find master file for %s" source-file-name) + (flymake-report-status "!" "") ; NOMASTER + nil) + (setq flymake-master-file-name (nth 0 master-and-temp-master)) + (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) + +(defun flymake-master-cleanup () + (flymake-simple-cleanup) + (flymake-safe-delete-file flymake-temp-master-file-name)) + +;;;; make-specific init-cleanup routines +(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) + "Create a command line for syntax check using GET-CMD-LINE-F." + (funcall get-cmd-line-f + (if use-relative-source + (file-relative-name source-file-name base-dir) + source-file-name) + (if use-relative-base-dir + (file-relative-name base-dir + (file-name-directory source-file-name)) + base-dir))) + +(defun flymake-get-make-cmdline (source base-dir) + (list "make" + (list "-s" + "-C" + base-dir + (concat "CHK_SOURCES=" source) + "SYNTAX_CHECK_MODE=1" + "check-syntax"))) + +(defun flymake-get-ant-cmdline (source base-dir) + (list "ant" + (list "-buildfile" + (concat base-dir "/" "build.xml") + (concat "-DCHK_SOURCES=" source) + "check-syntax"))) + +(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) + "Create syntax check command line for a directly checked source file. +Use CREATE-TEMP-F for creating temp copy." + (let* ((args nil) + (source-file-name buffer-file-name) + (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) + (if buildfile-dir + (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) + (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir + use-relative-base-dir use-relative-source + get-cmdline-f)))) + args)) + +(defun flymake-simple-make-init () + (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) + +(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) + "Create make command line for a source file checked via master file compilation." + (let* ((make-args nil) + (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy + get-incl-dirs-f 'flymake-create-temp-inplace + master-file-masks include-regexp))) + (when temp-master-file-name + (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) + (if buildfile-dir + (setq make-args (flymake-get-syntax-check-program-args + temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) + make-args)) + +(defun flymake-find-make-buildfile (source-dir) + (flymake-find-buildfile "Makefile" source-dir)) + +;;;; .h/make specific +(defun flymake-master-make-header-init () + (flymake-master-make-init + 'flymake-get-include-dirs + '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") + "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) + +;;;; .java/make specific +(defun flymake-simple-make-java-init () + (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) + +(defun flymake-simple-ant-java-init () + (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) + +(defun flymake-simple-java-cleanup () + "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." + (flymake-safe-delete-file flymake-temp-source-file-name) + (when flymake-temp-source-file-name + (flymake-delete-temp-directory + (file-name-directory flymake-temp-source-file-name)))) + +;;;; perl-specific init-cleanup routines +(defun flymake-perl-init () + (let* ((temp-file (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "perl" (list "-wc " local-file)))) + +;;;; php-specific init-cleanup routines +(defun flymake-php-init () + (let* ((temp-file (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)) + (local-file (file-relative-name + temp-file + (file-name-directory buffer-file-name)))) + (list "php" (list "-f" local-file "-l")))) + +;;;; tex-specific init-cleanup routines +(defun flymake-get-tex-args (file-name) + ;;(list "latex" (list "-c-style-errors" file-name)) + (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) + +(defun flymake-simple-tex-init () + (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) + +;; Perhaps there should be a buffer-local variable flymake-master-file +;; that people can set to override this stuff. Could inherit from +;; the similar AUCTeX variable. +(defun flymake-master-tex-init () + (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy + 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace + '("\\.tex\\'") + "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) + (when temp-master-file-name + (flymake-get-tex-args temp-master-file-name)))) + +(defun flymake-get-include-dirs-dot (_base-dir) + '(".")) + +;;;; xml-specific init-cleanup routines +(defun flymake-xml-init () + (list flymake-xml-program + (list "val" (flymake-init-create-temp-buffer-copy + 'flymake-create-temp-inplace)))) + +(provide 'flymake-proc) +;;; flymake-proc.el ends here diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el new file mode 100644 index 0000000000..c1dffb4e7e --- /dev/null +++ b/lisp/progmodes/flymake-ui.el @@ -0,0 +1,601 @@ +;;; flymake-ui.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2017 Free Software Foundation, Inc. + +;; Author: Pavel Kobyakov +;; Maintainer: Leo Liu +;; Version: 0.3 +;; Keywords: c languages tools + +;; 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: +;; +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.xo +;; +;; This file contains the UI for displaying and interacting with the +;; results of such checks, as well as entry points for backends to +;; hook on to. Backends are sources of diagnostic info. +;; +;;; Code: + +(eval-when-compile (require 'cl-lib)) + +(defgroup flymake nil + "Universal on-the-fly syntax checker." + :version "23.1" + :link '(custom-manual "(flymake) Top") + :group 'tools) + +(defcustom flymake-error-bitmap '(exclamation-mark error) + "Bitmap (a symbol) used in the fringe for indicating errors. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-warning-bitmap 'question-mark + "Bitmap (a symbol) used in the fringe for indicating warnings. +The value may also be a list of two elements where the second +element specifies the face for the bitmap. For possible bitmap +symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. + +The option `flymake-fringe-indicator-position' controls how and where +this is used." + :group 'flymake + :version "24.3" + :type '(choice (symbol :tag "Bitmap") + (list :tag "Bitmap and face" + (symbol :tag "Bitmap") + (face :tag "Face")))) + +(defcustom flymake-fringe-indicator-position 'left-fringe + "The position to put flymake fringe indicator. +The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. +See `flymake-error-bitmap' and `flymake-warning-bitmap'." + :group 'flymake + :version "24.3" + :type '(choice (const left-fringe) + (const right-fringe) + (const :tag "No fringe indicators" nil))) + +(defcustom flymake-start-syntax-check-on-newline t + "Start syntax check if newline char was added/removed from the buffer." + :group 'flymake + :type 'boolean) + +(defcustom flymake-no-changes-timeout 0.5 + "Time to wait after last change before starting compilation." + :group 'flymake + :type 'number) + +(defcustom flymake-gui-warnings-enabled t + "Enables/disables GUI warnings." + :group 'flymake + :type 'boolean) +(make-obsolete-variable 'flymake-gui-warnings-enabled + "it no longer has any effect." "26.1") + +(defcustom flymake-start-syntax-check-on-find-file t + "Start syntax check on find file." + :group 'flymake + :type 'boolean) + +(defcustom flymake-log-level -1 + "Logging level, only messages with level lower or equal will be logged. +-1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" + :group 'flymake + :type 'integer) + +(defvar-local flymake-timer nil + "Timer for starting syntax check.") + +(defvar-local flymake-last-change-time nil + "Time of last buffer change.") + +(defvar-local flymake-check-start-time nil + "Time at which syntax check was started.") + +(defvar-local flymake-check-was-interrupted nil + "Non-nil if syntax check was killed by `flymake-compile'.") + +(defvar-local flymake-err-info nil + "Sorted list of line numbers and lists of err info in the form (file, err-text).") + +(defvar-local flymake-new-err-info nil + "Same as `flymake-err-info', effective when a syntax check is in progress.") + +(defun flymake-log (level text &rest args) + "Log a message at level LEVEL. +If LEVEL is higher than `flymake-log-level', the message is +ignored. Otherwise, it is printed using `message'. +TEXT is a format control string, and the remaining arguments ARGS +are the string substitutions (see the function `format')." + (if (<= level flymake-log-level) + (let* ((msg (apply #'format-message text args))) + (message "%s" msg)))) + +(defun flymake-ins-after (list pos val) + "Insert VAL into LIST after position POS. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) + tmp)) + +(defun flymake-set-at (list pos val) + "Set VAL at position POS in LIST. +POS counts from zero." + (let ((tmp (copy-sequence list))) + (setcar (nthcdr pos tmp) val) + tmp)) + +(defun flymake-er-make-er (line-no line-err-info-list) + (list line-no line-err-info-list)) + +(defun flymake-er-get-line (err-info) + (nth 0 err-info)) + +(defun flymake-er-get-line-err-info-list (err-info) + (nth 1 err-info)) + +(cl-defstruct (flymake-ler + (:constructor nil) + (:constructor flymake-ler-make-ler (file line type text &optional full-file))) + file line type text full-file) + +(defun flymake-ler-set-file (line-err-info file) + (flymake-ler-make-ler file + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) + +(defun flymake-ler-set-full-file (line-err-info full-file) + (flymake-ler-make-ler (flymake-ler-file line-err-info) + (flymake-ler-line line-err-info) + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + full-file)) + +(defun flymake-ler-set-line (line-err-info line) + (flymake-ler-make-ler (flymake-ler-file line-err-info) + line + (flymake-ler-type line-err-info) + (flymake-ler-text line-err-info) + (flymake-ler-full-file line-err-info))) + +(defun flymake-get-line-err-count (line-err-info-list type) + "Return number of errors of specified TYPE. +Value of TYPE is either \"e\" or \"w\"." + (let* ((idx 0) + (count (length line-err-info-list)) + (err-count 0)) + + (while (< idx count) + (when (equal type (flymake-ler-type (nth idx line-err-info-list))) + (setq err-count (1+ err-count))) + (setq idx (1+ idx))) + err-count)) + +(defun flymake-get-err-count (err-info-list type) + "Return number of errors of specified TYPE for ERR-INFO-LIST." + (let* ((idx 0) + (count (length err-info-list)) + (err-count 0)) + (while (< idx count) + (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) + (setq idx (1+ idx))) + err-count)) + +(defun flymake-highlight-err-lines (err-info-list) + "Highlight error lines in BUFFER using info from ERR-INFO-LIST." + (save-excursion + (dolist (err err-info-list) + (flymake-highlight-line (car err) (nth 1 err))))) + +(defun flymake-overlay-p (ov) + "Determine whether overlay OV was created by flymake." + (and (overlayp ov) (overlay-get ov 'flymake-overlay))) + +(defun flymake-make-overlay (beg end tooltip-text face bitmap) + "Allocate a flymake overlay in range BEG and END." + (when (not (flymake-region-has-flymake-overlays beg end)) + (let ((ov (make-overlay beg end nil t)) + (fringe (and flymake-fringe-indicator-position + (propertize "!" 'display + (cons flymake-fringe-indicator-position + (if (listp bitmap) + bitmap + (list bitmap))))))) + (overlay-put ov 'face face) + (overlay-put ov 'help-echo tooltip-text) + (overlay-put ov 'flymake-overlay t) + (overlay-put ov 'priority 100) + (overlay-put ov 'evaporate t) + (overlay-put ov 'before-string fringe) + ;;+(flymake-log 3 "created overlay %s" ov) + ov) + (flymake-log 3 "created an overlay at (%d-%d)" beg end))) + +(defun flymake-delete-own-overlays () + "Delete all flymake overlays in BUFFER." + (dolist (ol (overlays-in (point-min) (point-max))) + (when (flymake-overlay-p ol) + (delete-overlay ol) + ;;+(flymake-log 3 "deleted overlay %s" ol) + ))) + +(defun flymake-region-has-flymake-overlays (beg end) + "Check if region specified by BEG and END has overlay. +Return t if it has at least one flymake overlay, nil if no overlay." + (let ((ov (overlays-in beg end)) + (has-flymake-overlays nil)) + (while (consp ov) + (when (flymake-overlay-p (car ov)) + (setq has-flymake-overlays t)) + (setq ov (cdr ov))) + has-flymake-overlays)) + +(defface flymake-errline + '((((supports :underline (:style wave))) + :underline (:style wave :color "Red1")) + (t + :inherit error)) + "Face used for marking error lines." + :version "24.4" + :group 'flymake) + +(defface flymake-warnline + '((((supports :underline (:style wave))) + :underline (:style wave :color "DarkOrange")) + (t + :inherit warning)) + "Face used for marking warning lines." + :version "24.4" + :group 'flymake) + +(defun flymake-highlight-line (line-no line-err-info-list) + "Highlight line LINE-NO in current buffer. +Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." + (goto-char (point-min)) + (forward-line (1- line-no)) + (pcase-let* ((beg (progn (back-to-indentation) (point))) + (end (progn + (end-of-line) + (skip-chars-backward " \t\f\t\n" beg) + (if (eq (point) beg) + (line-beginning-position 2) + (point)))) + (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) + (`(,face ,bitmap) + (if (> (flymake-get-line-err-count line-err-info-list "e") 0) + (list 'flymake-errline flymake-error-bitmap) + (list 'flymake-warnline flymake-warning-bitmap)))) + (flymake-make-overlay beg end tooltip-text face bitmap))) + +(defun flymake-find-err-info (err-info-list line-no) + "Find (line-err-info-list pos) for specified LINE-NO." + (if err-info-list + (let* ((line-err-info-list nil) + (pos 0) + (count (length err-info-list))) + + (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) + (setq pos (1+ pos))) + (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) + (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) + (list line-err-info-list pos)) + '(nil 0))) + +(defun flymake-line-err-info-is-less-or-equal (line-one line-two) + (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) + (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) + (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) + (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) + +(defun flymake-add-line-err-info (line-err-info-list line-err-info) + "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. +For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. +The new element is inserted in the proper position, according to +the predicate `flymake-line-err-info-is-less-or-equal'. +The updated value of LINE-ERR-INFO-LIST is returned." + (if (not line-err-info-list) + (list line-err-info) + (let* ((count (length line-err-info-list)) + (idx 0)) + (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) + (setq idx (1+ idx))) + (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) + (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) + line-err-info-list))) + +(defun flymake-add-err-info (err-info-list line-err-info) + "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. +Returns the updated value of ERR-INFO-LIST. +For the format of ERR-INFO-LIST, see `flymake-err-info'. +For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." + (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) + (info-and-pos (flymake-find-err-info err-info-list line-no)) + (exists (car info-and-pos)) + (pos (nth 1 info-and-pos)) + (line-err-info-list nil) + (err-info nil)) + + (if exists + (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) + (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) + + (setq err-info (flymake-er-make-er line-no line-err-info-list)) + (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) + ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) + (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) + err-info-list)) + +(defvar-local flymake-is-running nil + "If t, flymake syntax check process is running for the current buffer.") + +(defun flymake-on-timer-event (buffer) + "Start a syntax check for buffer BUFFER if necessary." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (and (not flymake-is-running) + flymake-last-change-time + (> (- (float-time) flymake-last-change-time) + flymake-no-changes-timeout)) + + (setq flymake-last-change-time nil) + (flymake-log 3 "starting syntax check as more than 1 second passed since last change") + (flymake-start-syntax-check))))) + +(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line + 'flymake-popup-current-error-menu "24.4") + +(defun flymake-popup-current-error-menu (&optional event) + "Pop up a menu with errors/warnings for current line." + (interactive (list last-nonmenu-event)) + (let* ((line-no (line-number-at-pos)) + (errors (or (car (flymake-find-err-info flymake-err-info line-no)) + (user-error "No errors for current line"))) + (menu (mapcar (lambda (x) + (if (flymake-ler-file x) + (cons (format "%s - %s(%d)" + (flymake-ler-text x) + (flymake-ler-file x) + (flymake-ler-line x)) + x) + (list (flymake-ler-text x)))) + errors)) + (event (if (mouse-event-p event) + event + (list 'mouse-1 (posn-at-point)))) + (title (format "Line %d: %d error(s), %d warning(s)" + line-no + (flymake-get-line-err-count errors "e") + (flymake-get-line-err-count errors "w"))) + (choice (x-popup-menu event (list title (cons "" menu))))) + (flymake-log 3 "choice=%s" choice) + (when choice + (flymake-goto-file-and-line (flymake-ler-full-file choice) + (flymake-ler-line choice))))) + +(defun flymake-goto-file-and-line (file line) + "Try to get buffer for FILE and goto line LINE in it." + (if (not (file-exists-p file)) + (flymake-log 1 "File %s does not exist" file) + (find-file file) + (goto-char (point-min)) + (forward-line (1- line)))) + +;; flymake minor mode declarations +(defvar-local flymake-mode-line nil) +(defvar-local flymake-mode-line-e-w nil) +(defvar-local flymake-mode-line-status nil) + +(defun flymake-report-status (e-w &optional status) + "Show status in mode line." + (when e-w + (setq flymake-mode-line-e-w e-w)) + (when status + (setq flymake-mode-line-status status)) + (let* ((mode-line " Flymake")) + (when (> (length flymake-mode-line-e-w) 0) + (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) + (setq mode-line (concat mode-line flymake-mode-line-status)) + (setq flymake-mode-line mode-line) + (force-mode-line-update))) + +;; Nothing in flymake uses this at all any more, so this is just for +;; third-party compatibility. +(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") + +(defun flymake-report-fatal-status (status warning) + "Display a warning and switch flymake mode off." + ;; This first message was always shown by default, and flymake-log + ;; does nothing by default, hence the use of message. + ;; Another option is display-warning. + (if (< flymake-log-level 0) + (message "Flymake: %s. Flymake will be switched OFF" warning)) + (flymake-mode 0) + (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" + (buffer-name) status warning)) + +;;;###autoload +(define-minor-mode flymake-mode nil + :group 'flymake :lighter flymake-mode-line + (cond + + ;; Turning the mode ON. + (flymake-mode + (cond + ((not buffer-file-name) + (message "Flymake unable to run without a buffer file name")) + ((not (flymake-can-syntax-check-file buffer-file-name)) + (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) + (t + (add-hook 'after-change-functions 'flymake-after-change-function nil t) + (add-hook 'after-save-hook 'flymake-after-save-hook nil t) + (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) + ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) + + (flymake-report-status "" "") + + (setq flymake-timer + (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) + + (when (and flymake-start-syntax-check-on-find-file + ;; Since we write temp files in current dir, there's no point + ;; trying if the directory is read-only (bug#8954). + (file-writable-p (file-name-directory buffer-file-name))) + (with-demoted-errors + (flymake-start-syntax-check)))))) + + ;; Turning the mode OFF. + (t + (remove-hook 'after-change-functions 'flymake-after-change-function t) + (remove-hook 'after-save-hook 'flymake-after-save-hook t) + (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) + ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) + + (flymake-delete-own-overlays) + + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil)) + + (setq flymake-is-running nil)))) + +;;;###autoload +(defun flymake-mode-on () + "Turn flymake mode on." + (flymake-mode 1) + (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) + +;;;###autoload +(defun flymake-mode-off () + "Turn flymake mode off." + (flymake-mode 0) + (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) + +(defun flymake-after-change-function (start stop _len) + "Start syntax check for current buffer if it isn't already running." + ;;+(flymake-log 0 "setting change time to %s" (float-time)) + (let((new-text (buffer-substring start stop))) + (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) + (flymake-log 3 "starting syntax check as new-line has been seen") + (flymake-start-syntax-check)) + (setq flymake-last-change-time (float-time)))) + +(defun flymake-after-save-hook () + (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? + (progn + (flymake-log 3 "starting syntax check as buffer was saved") + (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) + +(defun flymake-kill-buffer-hook () + (when flymake-timer + (cancel-timer flymake-timer) + (setq flymake-timer nil))) + +;;;###autoload +(defun flymake-find-file-hook () + ;;+(when flymake-start-syntax-check-on-find-file + ;;+ (flymake-log 3 "starting syntax check on file open") + ;;+ (flymake-start-syntax-check) + ;;+) + (when (and (not (local-variable-p 'flymake-mode (current-buffer))) + (flymake-can-syntax-check-file buffer-file-name)) + (flymake-mode) + (flymake-log 3 "automatically turned ON flymake mode"))) + +(defun flymake-get-first-err-line-no (err-info-list) + "Return first line with error." + (when err-info-list + (flymake-er-get-line (car err-info-list)))) + +(defun flymake-get-last-err-line-no (err-info-list) + "Return last line with error." + (when err-info-list + (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) + +(defun flymake-get-next-err-line-no (err-info-list line-no) + "Return next line with error." + (when err-info-list + (let* ((count (length err-info-list)) + (idx 0)) + (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) + (setq idx (1+ idx))) + (if (< idx count) + (flymake-er-get-line (nth idx err-info-list)))))) + +(defun flymake-get-prev-err-line-no (err-info-list line-no) + "Return previous line with error." + (when err-info-list + (let* ((count (length err-info-list))) + (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) + (setq count (1- count))) + (if (> count 0) + (flymake-er-get-line (nth (1- count) err-info-list)))))) + +(defun flymake-skip-whitespace () + "Move forward until non-whitespace is reached." + (while (looking-at "[ \t]") + (forward-char))) + +(defun flymake-goto-line (line-no) + "Go to line LINE-NO, then skip whitespace." + (goto-char (point-min)) + (forward-line (1- line-no)) + (flymake-skip-whitespace)) + +(defun flymake-goto-next-error () + "Go to next error in err ring." + (interactive) + (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) + (when (not line-no) + (setq line-no (flymake-get-first-err-line-no flymake-err-info)) + (flymake-log 1 "passed end of file")) + (if line-no + (flymake-goto-line line-no) + (flymake-log 1 "no errors in current buffer")))) + +(defun flymake-goto-prev-error () + "Go to previous error in err ring." + (interactive) + (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) + (when (not line-no) + (setq line-no (flymake-get-last-err-line-no flymake-err-info)) + (flymake-log 1 "passed beginning of file")) + (if line-no + (flymake-goto-line line-no) + (flymake-log 1 "no errors in current buffer")))) + +(defun flymake-patch-err-text (string) + (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) + (match-string 1 string) + string)) + +(provide 'flymake-ui) +;;; flymake-ui.el ends here diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index ed34d9aaa5..6ae2280a35 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -24,1626 +24,18 @@ ;;; Commentary: ;; -;; Flymake is a minor Emacs mode performing on-the-fly syntax checks -;; using the external syntax check tool (for C/C++ this is usually the -;; compiler). - -;;; Bugs/todo: - -;; - Only uses "Makefile", not "makefile" or "GNUmakefile" -;; (from http://bugs.debian.org/337339). +;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. +;; +;; It collects diagnostic information for multiple sources and +;; visually annotates the relevant lines in the buffer. +;; +;; This file is just a stub for that loads the UI and backends, which +;; could also be loaded separately. ;;; Code: -(eval-when-compile (require 'cl-lib)) - -(defgroup flymake nil - "Universal on-the-fly syntax checker." - :version "23.1" - :link '(custom-manual "(flymake) Top") - :group 'tools) - -(defcustom flymake-error-bitmap '(exclamation-mark error) - "Bitmap (a symbol) used in the fringe for indicating errors. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-warning-bitmap 'question-mark - "Bitmap (a symbol) used in the fringe for indicating warnings. -The value may also be a list of two elements where the second -element specifies the face for the bitmap. For possible bitmap -symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. - -The option `flymake-fringe-indicator-position' controls how and where -this is used." - :group 'flymake - :version "24.3" - :type '(choice (symbol :tag "Bitmap") - (list :tag "Bitmap and face" - (symbol :tag "Bitmap") - (face :tag "Face")))) - -(defcustom flymake-fringe-indicator-position 'left-fringe - "The position to put flymake fringe indicator. -The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. -See `flymake-error-bitmap' and `flymake-warning-bitmap'." - :group 'flymake - :version "24.3" - :type '(choice (const left-fringe) - (const right-fringe) - (const :tag "No fringe indicators" nil))) - -(defcustom flymake-compilation-prevents-syntax-check t - "If non-nil, don't start syntax check if compilation is running." - :group 'flymake - :type 'boolean) - -(defcustom flymake-start-syntax-check-on-newline t - "Start syntax check if newline char was added/removed from the buffer." - :group 'flymake - :type 'boolean) - -(defcustom flymake-no-changes-timeout 0.5 - "Time to wait after last change before starting compilation." - :group 'flymake - :type 'number) - -(defcustom flymake-gui-warnings-enabled t - "Enables/disables GUI warnings." - :group 'flymake - :type 'boolean) -(make-obsolete-variable 'flymake-gui-warnings-enabled - "it no longer has any effect." "26.1") - -(defcustom flymake-start-syntax-check-on-find-file t - "Start syntax check on find file." - :group 'flymake - :type 'boolean) - -(defcustom flymake-log-level -1 - "Logging level, only messages with level lower or equal will be logged. --1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG" - :group 'flymake - :type 'integer) - -(defcustom flymake-xml-program - (if (executable-find "xmlstarlet") "xmlstarlet" "xml") - "Program to use for XML validation." - :type 'file - :group 'flymake - :version "24.4") - -(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest") - "Dirs where to look for master files." - :group 'flymake - :type '(repeat (string))) - -(defcustom flymake-master-file-count-limit 32 - "Max number of master files to check." - :group 'flymake - :type 'integer) - -(defcustom flymake-allowed-file-name-masks - '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init) - ("\\.xml\\'" flymake-xml-init) - ("\\.html?\\'" flymake-xml-init) - ("\\.cs\\'" flymake-simple-make-init) - ("\\.p[ml]\\'" flymake-perl-init) - ("\\.php[345]?\\'" flymake-php-init) - ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup) - ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup) - ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup) - ("\\.tex\\'" flymake-simple-tex-init) - ("\\.idl\\'" flymake-simple-make-init) - ;; ("\\.cpp\\'" 1) - ;; ("\\.java\\'" 3) - ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'") - ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2)) - ;; ("\\.idl\\'" 1) - ;; ("\\.odl\\'" 1) - ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'") - ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 )) - ;; ("\\.tex\\'" 1) - ) - "Files syntax checking is allowed for. -This is an alist with elements of the form: - REGEXP INIT [CLEANUP [NAME]] -REGEXP is a regular expression that matches a file name. -INIT is the init function to use. -CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. -NAME is the file name function to use, default `flymake-get-real-file-name'." - :group 'flymake - :type '(alist :key-type (regexp :tag "File regexp") - :value-type - (list :tag "Handler functions" - (function :tag "Init function") - (choice :tag "Cleanup function" - (const :tag "flymake-simple-cleanup" nil) - function) - (choice :tag "Name function" - (const :tag "flymake-get-real-file-name" nil) - function)))) - -(defvar-local flymake-is-running nil - "If t, flymake syntax check process is running for the current buffer.") - -(defvar-local flymake-timer nil - "Timer for starting syntax check.") - -(defvar-local flymake-last-change-time nil - "Time of last buffer change.") - -(defvar-local flymake-check-start-time nil - "Time at which syntax check was started.") - -(defvar-local flymake-check-was-interrupted nil - "Non-nil if syntax check was killed by `flymake-compile'.") - -(defvar-local flymake-err-info nil - "Sorted list of line numbers and lists of err info in the form (file, err-text).") - -(defvar-local flymake-new-err-info nil - "Same as `flymake-err-info', effective when a syntax check is in progress.") - -(defun flymake-log (level text &rest args) - "Log a message at level LEVEL. -If LEVEL is higher than `flymake-log-level', the message is -ignored. Otherwise, it is printed using `message'. -TEXT is a format control string, and the remaining arguments ARGS -are the string substitutions (see the function `format')." - (if (<= level flymake-log-level) - (let* ((msg (apply #'format-message text args))) - (message "%s" msg)))) - -(defun flymake-ins-after (list pos val) - "Insert VAL into LIST after position POS. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp))) - tmp)) - -(defun flymake-set-at (list pos val) - "Set VAL at position POS in LIST. -POS counts from zero." - (let ((tmp (copy-sequence list))) - (setcar (nthcdr pos tmp) val) - tmp)) - -(defvar flymake-processes nil - "List of currently active flymake processes.") - -(defvar-local flymake-output-residual nil) - -(defun flymake-get-file-name-mode-and-masks (file-name) - "Return the corresponding entry from `flymake-allowed-file-name-masks'." - (unless (stringp file-name) - (error "Invalid file-name")) - (let ((fnm flymake-allowed-file-name-masks) - (mode-and-masks nil)) - (while (and (not mode-and-masks) fnm) - (if (string-match (car (car fnm)) file-name) - (setq mode-and-masks (cdr (car fnm)))) - (setq fnm (cdr fnm))) - (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks)) - mode-and-masks)) - -(defun flymake-can-syntax-check-file (file-name) - "Determine whether we can syntax check FILE-NAME. -Return nil if we cannot, non-nil if we can." - (if (flymake-get-init-function file-name) t nil)) - -(defun flymake-get-init-function (file-name) - "Return init function to be used for the file." - (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name)))) - ;;(flymake-log 0 "calling %s" init-f) - ;;(funcall init-f (current-buffer)) - init-f)) - -(defun flymake-get-cleanup-function (file-name) - "Return cleanup function to be used for the file." - (or (nth 1 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-simple-cleanup)) - -(defun flymake-get-real-file-name-function (file-name) - (or (nth 2 (flymake-get-file-name-mode-and-masks file-name)) - 'flymake-get-real-file-name)) - -(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal)) - -(defun flymake-get-buildfile-from-cache (dir-name) - "Look up DIR-NAME in cache and return its associated value. -If DIR-NAME is not found, return nil." - (gethash dir-name flymake-find-buildfile-cache)) - -(defun flymake-add-buildfile-to-cache (dir-name buildfile) - "Associate DIR-NAME with BUILDFILE in the buildfile cache." - (puthash dir-name buildfile flymake-find-buildfile-cache)) - -(defun flymake-clear-buildfile-cache () - "Clear the buildfile cache." - (clrhash flymake-find-buildfile-cache)) - -(defun flymake-find-buildfile (buildfile-name source-dir-name) - "Find buildfile starting from current directory. -Buildfile includes Makefile, build.xml etc. -Return its file name if found, or nil if not found." - (or (flymake-get-buildfile-from-cache source-dir-name) - (let* ((file (locate-dominating-file source-dir-name buildfile-name))) - (if file - (progn - (flymake-log 3 "found buildfile at %s" file) - (flymake-add-buildfile-to-cache source-dir-name file) - file) - (progn - (flymake-log 3 "buildfile for %s not found" source-dir-name) - nil))))) - -(defun flymake-fix-file-name (name) - "Replace all occurrences of `\\' with `/'." - (when name - (setq name (expand-file-name name)) - (setq name (abbreviate-file-name name)) - (setq name (directory-file-name name)) - name)) - -(defun flymake-same-files (file-name-one file-name-two) - "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file. -Return t if so, nil if not." - (equal (flymake-fix-file-name file-name-one) - (flymake-fix-file-name file-name-two))) - -;; This is bound dynamically to pass a parameter to a sort predicate below -(defvar flymake-included-file-name) - -(defun flymake-find-possible-master-files (file-name master-file-dirs masks) - "Find (by name and location) all possible master files. - -Name is specified by FILE-NAME and location is specified by -MASTER-FILE-DIRS. Master files include .cpp and .c for .h. -Files are searched for starting from the .h directory and max -max-level parent dirs. File contents are not checked." - (let* ((dirs master-file-dirs) - (files nil) - (done nil)) - - (while (and (not done) dirs) - (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name))) - (masks masks)) - (while (and (file-exists-p dir) (not done) masks) - (let* ((mask (car masks)) - (dir-files (directory-files dir t mask))) - - (flymake-log 3 "dir %s, %d file(s) for mask %s" - dir (length dir-files) mask) - (while (and (not done) dir-files) - (when (not (file-directory-p (car dir-files))) - (setq files (cons (car dir-files) files)) - (when (>= (length files) flymake-master-file-count-limit) - (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit) - (setq done t))) - (setq dir-files (cdr dir-files)))) - (setq masks (cdr masks)))) - (setq dirs (cdr dirs))) - (when files - (let ((flymake-included-file-name (file-name-nondirectory file-name))) - (setq files (sort files 'flymake-master-file-compare)))) - (flymake-log 3 "found %d possible master file(s)" (length files)) - files)) - -(defun flymake-master-file-compare (file-one file-two) - "Compare two files specified by FILE-ONE and FILE-TWO. -This function is used in sort to move most possible file names -to the beginning of the list (File.h -> File.cpp moved to top)." - (and (equal (file-name-sans-extension flymake-included-file-name) - (file-name-base file-one)) - (not (equal file-one file-two)))) - -(defvar flymake-check-file-limit 8192 - "Maximum number of chars to look at when checking possible master file. -Nil means search the entire file.") - -(defun flymake-check-patch-master-file-buffer - (master-file-temp-buffer - master-file-name patched-master-file-name - source-file-name patched-source-file-name - include-dirs regexp) - "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME. -If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME -instead of SOURCE-FILE-NAME. - -For example, foo.cpp is a master file if it includes foo.h. - -When a buffer for MASTER-FILE-NAME exists, use it as a source -instead of reading master file from disk." - (let* ((source-file-nondir (file-name-nondirectory source-file-name)) - (source-file-extension (file-name-extension source-file-nondir)) - (source-file-nonext (file-name-sans-extension source-file-nondir)) - (found nil) - (inc-name nil) - (search-limit flymake-check-file-limit)) - (setq regexp - (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\"" - ;; Hack for tex files, where \include often excludes .tex. - ;; Maybe this is safe generally. - (if (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex")) - (format "%s\\(?:\\.%s\\)?" - (regexp-quote source-file-nonext) - (regexp-quote source-file-extension)) - (regexp-quote source-file-nondir)))) - (unwind-protect - (with-current-buffer master-file-temp-buffer - (if (or (not search-limit) - (> search-limit (point-max))) - (setq search-limit (point-max))) - (flymake-log 3 "checking %s against regexp %s" - master-file-name regexp) - (goto-char (point-min)) - (while (and (< (point) search-limit) - (re-search-forward regexp search-limit t)) - (let ((match-beg (match-beginning 1)) - (match-end (match-end 1))) - - (flymake-log 3 "found possible match for %s" source-file-nondir) - (setq inc-name (match-string 1)) - (and (> (length source-file-extension) 1) - (string-equal source-file-extension "tex") - (not (string-match (format "\\.%s\\'" source-file-extension) - inc-name)) - (setq inc-name (concat inc-name "." source-file-extension))) - (when (eq t (compare-strings - source-file-nondir nil nil - inc-name (- (length inc-name) - (length source-file-nondir)) nil)) - (flymake-log 3 "inc-name=%s" inc-name) - (when (flymake-check-include source-file-name inc-name - include-dirs) - (setq found t) - ;; replace-match is not used here as it fails in - ;; XEmacs with 'last match not a buffer' error as - ;; check-includes calls replace-in-string - (flymake-replace-region - match-beg match-end - (file-name-nondirectory patched-source-file-name)))) - (forward-line 1))) - (when found - (flymake-save-buffer-in-file patched-master-file-name))) - ;;+(flymake-log 3 "killing buffer %s" - ;; (buffer-name master-file-temp-buffer)) - (kill-buffer master-file-temp-buffer)) - ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found) - (when found - (flymake-log 2 "found master file %s" master-file-name)) - found)) - -;;; XXX: remove -(defun flymake-replace-region (beg end rep) - "Replace text in BUFFER in region (BEG END) with REP." - (save-excursion - (goto-char end) - ;; Insert before deleting, so as to better preserve markers's positions. - (insert rep) - (delete-region beg end))) - -(defun flymake-read-file-to-temp-buffer (file-name) - "Insert contents of FILE-NAME into newly created temp buffer." - (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name)))))) - (with-current-buffer temp-buffer - (insert-file-contents file-name)) - temp-buffer)) - -(defun flymake-copy-buffer-to-temp-buffer (buffer) - "Copy contents of BUFFER into newly created temp buffer." - (with-current-buffer - (get-buffer-create (generate-new-buffer-name - (concat "flymake:" (buffer-name buffer)))) - (insert-buffer-substring buffer) - (current-buffer))) - -(defun flymake-check-include (source-file-name inc-name include-dirs) - "Check if SOURCE-FILE-NAME can be found in include path. -Return t if it can be found via include path using INC-NAME." - (if (file-name-absolute-p inc-name) - (flymake-same-files source-file-name inc-name) - (while (and include-dirs - (not (flymake-same-files - source-file-name - (concat (file-name-directory source-file-name) - "/" (car include-dirs) - "/" inc-name)))) - (setq include-dirs (cdr include-dirs))) - include-dirs)) - -(defun flymake-find-buffer-for-file (file-name) - "Check if there exists a buffer visiting FILE-NAME. -Return t if so, nil if not." - (let ((buffer-name (get-file-buffer file-name))) - (if buffer-name - (get-buffer buffer-name)))) - -(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp) - "Save SOURCE-FILE-NAME with a different name. -Find master file, patch and save it." - (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks)) - (master-file-count (length possible-master-files)) - (idx 0) - (temp-buffer nil) - (master-file-name nil) - (patched-master-file-name nil) - (found nil)) - - (while (and (not found) (< idx master-file-count)) - (setq master-file-name (nth idx possible-master-files)) - (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master")) - (if (flymake-find-buffer-for-file master-file-name) - (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name))) - (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name))) - (setq found - (flymake-check-patch-master-file-buffer - temp-buffer - master-file-name - patched-master-file-name - source-file-name - patched-source-file-name - (funcall get-incl-dirs-f (file-name-directory master-file-name)) - include-regexp)) - (setq idx (1+ idx))) - (if found - (list master-file-name patched-master-file-name) - (progn - (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count - (file-name-nondirectory source-file-name)) - nil)))) - -(defun flymake-save-buffer-in-file (file-name) - "Save the entire buffer contents into file FILE-NAME. -Create parent directories as needed." - (make-directory (file-name-directory file-name) 1) - (write-region nil nil file-name nil 566) - (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name)) - -(defun flymake-process-filter (process output) - "Parse OUTPUT and highlight error lines. -It's flymake process filter." - (let ((source-buffer (process-buffer process))) - - (flymake-log 3 "received %d byte(s) of output from process %d" - (length output) (process-id process)) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (flymake-parse-output-and-residual output))))) - -(defun flymake-process-sentinel (process _event) - "Sentinel for syntax check buffers." - (when (memq (process-status process) '(signal exit)) - (let* ((exit-status (process-exit-status process)) - (command (process-command process)) - (source-buffer (process-buffer process)) - (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer)))) - - (flymake-log 2 "process %d exited with code %d" - (process-id process) exit-status) - (condition-case err - (progn - (flymake-log 3 "cleaning up using %s" cleanup-f) - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - (funcall cleanup-f))) - - (delete-process process) - (setq flymake-processes (delq process flymake-processes)) - - (when (buffer-live-p source-buffer) - (with-current-buffer source-buffer - - (flymake-parse-residual) - (flymake-post-syntax-check exit-status command) - (setq flymake-is-running nil)))) - (error - (let ((err-str (format "Error in process sentinel for buffer %s: %s" - source-buffer (error-message-string err)))) - (flymake-log 0 err-str) - (with-current-buffer source-buffer - (setq flymake-is-running nil)))))))) - -(defun flymake-post-syntax-check (exit-status command) - (save-restriction - (widen) - (setq flymake-err-info flymake-new-err-info) - (setq flymake-new-err-info nil) - (setq flymake-err-info - (flymake-fix-line-numbers - flymake-err-info 1 (count-lines (point-min) (point-max)))) - (flymake-delete-own-overlays) - (flymake-highlight-err-lines flymake-err-info) - (let (err-count warn-count) - (setq err-count (flymake-get-err-count flymake-err-info "e")) - (setq warn-count (flymake-get-err-count flymake-err-info "w")) - (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)" - (buffer-name) err-count warn-count - (- (float-time) flymake-check-start-time)) - (setq flymake-check-start-time nil) - - (if (and (equal 0 err-count) (equal 0 warn-count)) - (if (equal 0 exit-status) - (flymake-report-status "" "") ; PASSED - (if (not flymake-check-was-interrupted) - (flymake-report-fatal-status "CFGERR" - (format "Configuration error has occurred while running %s" command)) - (flymake-report-status nil ""))) ; "STOPPED" - (flymake-report-status (format "%d/%d" err-count warn-count) ""))))) - -(defun flymake-parse-output-and-residual (output) - "Split OUTPUT into lines, merge in residual if necessary." - (let* ((buffer-residual flymake-output-residual) - (total-output (if buffer-residual (concat buffer-residual output) output)) - (lines-and-residual (flymake-split-output total-output)) - (lines (nth 0 lines-and-residual)) - (new-residual (nth 1 lines-and-residual))) - (setq flymake-output-residual new-residual) - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info lines)))) - -(defun flymake-parse-residual () - "Parse residual if it's non empty." - (when flymake-output-residual - (setq flymake-new-err-info - (flymake-parse-err-lines - flymake-new-err-info - (list flymake-output-residual))) - (setq flymake-output-residual nil))) - -(defun flymake-er-make-er (line-no line-err-info-list) - (list line-no line-err-info-list)) - -(defun flymake-er-get-line (err-info) - (nth 0 err-info)) - -(defun flymake-er-get-line-err-info-list (err-info) - (nth 1 err-info)) - -(cl-defstruct (flymake-ler - (:constructor nil) - (:constructor flymake-ler-make-ler (file line type text &optional full-file))) - file line type text full-file) - -(defun flymake-ler-set-file (line-err-info file) - (flymake-ler-make-ler file - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-ler-set-full-file (line-err-info full-file) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - (flymake-ler-line line-err-info) - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - full-file)) - -(defun flymake-ler-set-line (line-err-info line) - (flymake-ler-make-ler (flymake-ler-file line-err-info) - line - (flymake-ler-type line-err-info) - (flymake-ler-text line-err-info) - (flymake-ler-full-file line-err-info))) - -(defun flymake-get-line-err-count (line-err-info-list type) - "Return number of errors of specified TYPE. -Value of TYPE is either \"e\" or \"w\"." - (let* ((idx 0) - (count (length line-err-info-list)) - (err-count 0)) - - (while (< idx count) - (when (equal type (flymake-ler-type (nth idx line-err-info-list))) - (setq err-count (1+ err-count))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-get-err-count (err-info-list type) - "Return number of errors of specified TYPE for ERR-INFO-LIST." - (let* ((idx 0) - (count (length err-info-list)) - (err-count 0)) - (while (< idx count) - (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type))) - (setq idx (1+ idx))) - err-count)) - -(defun flymake-fix-line-numbers (err-info-list min-line max-line) - "Replace line numbers with fixed value. -If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. -If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. -The reason for this fix is because some compilers might report -line number outside the file being compiled." - (let* ((count (length err-info-list)) - (err-info nil) - (line 0)) - (while (> count 0) - (setq err-info (nth (1- count) err-info-list)) - (setq line (flymake-er-get-line err-info)) - (when (or (< line min-line) (> line max-line)) - (setq line (if (< line min-line) min-line max-line)) - (setq err-info-list (flymake-set-at err-info-list (1- count) - (flymake-er-make-er line - (flymake-er-get-line-err-info-list err-info))))) - (setq count (1- count)))) - err-info-list) - -(defun flymake-highlight-err-lines (err-info-list) - "Highlight error lines in BUFFER using info from ERR-INFO-LIST." - (save-excursion - (dolist (err err-info-list) - (flymake-highlight-line (car err) (nth 1 err))))) - -(defun flymake-overlay-p (ov) - "Determine whether overlay OV was created by flymake." - (and (overlayp ov) (overlay-get ov 'flymake-overlay))) - -(defun flymake-make-overlay (beg end tooltip-text face bitmap) - "Allocate a flymake overlay in range BEG and END." - (when (not (flymake-region-has-flymake-overlays beg end)) - (let ((ov (make-overlay beg end nil t)) - (fringe (and flymake-fringe-indicator-position - (propertize "!" 'display - (cons flymake-fringe-indicator-position - (if (listp bitmap) - bitmap - (list bitmap))))))) - (overlay-put ov 'face face) - (overlay-put ov 'help-echo tooltip-text) - (overlay-put ov 'flymake-overlay t) - (overlay-put ov 'priority 100) - (overlay-put ov 'evaporate t) - (overlay-put ov 'before-string fringe) - ;;+(flymake-log 3 "created overlay %s" ov) - ov) - (flymake-log 3 "created an overlay at (%d-%d)" beg end))) - -(defun flymake-delete-own-overlays () - "Delete all flymake overlays in BUFFER." - (dolist (ol (overlays-in (point-min) (point-max))) - (when (flymake-overlay-p ol) - (delete-overlay ol) - ;;+(flymake-log 3 "deleted overlay %s" ol) - ))) - -(defun flymake-region-has-flymake-overlays (beg end) - "Check if region specified by BEG and END has overlay. -Return t if it has at least one flymake overlay, nil if no overlay." - (let ((ov (overlays-in beg end)) - (has-flymake-overlays nil)) - (while (consp ov) - (when (flymake-overlay-p (car ov)) - (setq has-flymake-overlays t)) - (setq ov (cdr ov))) - has-flymake-overlays)) - -(defface flymake-errline - '((((supports :underline (:style wave))) - :underline (:style wave :color "Red1")) - (t - :inherit error)) - "Face used for marking error lines." - :version "24.4" - :group 'flymake) - -(defface flymake-warnline - '((((supports :underline (:style wave))) - :underline (:style wave :color "DarkOrange")) - (t - :inherit warning)) - "Face used for marking warning lines." - :version "24.4" - :group 'flymake) - -(defun flymake-highlight-line (line-no line-err-info-list) - "Highlight line LINE-NO in current buffer. -Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting." - (goto-char (point-min)) - (forward-line (1- line-no)) - (pcase-let* ((beg (progn (back-to-indentation) (point))) - (end (progn - (end-of-line) - (skip-chars-backward " \t\f\t\n" beg) - (if (eq (point) beg) - (line-beginning-position 2) - (point)))) - (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n")) - (`(,face ,bitmap) - (if (> (flymake-get-line-err-count line-err-info-list "e") 0) - (list 'flymake-errline flymake-error-bitmap) - (list 'flymake-warnline flymake-warning-bitmap)))) - (flymake-make-overlay beg end tooltip-text face bitmap))) - -(defun flymake-parse-err-lines (err-info-list lines) - "Parse err LINES, store info in ERR-INFO-LIST." - (let* ((count (length lines)) - (idx 0) - (line-err-info nil) - (real-file-name nil) - (source-file-name buffer-file-name) - (get-real-file-name-f (flymake-get-real-file-name-function source-file-name))) - - (while (< idx count) - (setq line-err-info (flymake-parse-line (nth idx lines))) - (when line-err-info - (setq real-file-name (funcall get-real-file-name-f - (flymake-ler-file line-err-info))) - (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name)) - - (when (flymake-same-files real-file-name source-file-name) - (setq line-err-info (flymake-ler-set-file line-err-info nil)) - (setq err-info-list (flymake-add-err-info err-info-list line-err-info)))) - (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no")) - (setq idx (1+ idx))) - err-info-list)) - -(defun flymake-split-output (output) - "Split OUTPUT into lines. -Return last one as residual if it does not end with newline char. -Returns ((LINES) RESIDUAL)." - (when (and output (> (length output) 0)) - (let* ((lines (split-string output "[\n\r]+" t)) - (complete (equal "\n" (char-to-string (aref output (1- (length output)))))) - (residual nil)) - (when (not complete) - (setq residual (car (last lines))) - (setq lines (butlast lines))) - (list lines residual)))) - -(defun flymake-reformat-err-line-patterns-from-compile-el (original-list) - "Grab error line patterns from ORIGINAL-LIST in compile.el format. -Convert it to flymake internal format." - (let* ((converted-list '())) - (dolist (item original-list) - (setq item (cdr item)) - (let ((regexp (nth 0 item)) - (file (nth 1 item)) - (line (nth 2 item)) - (col (nth 3 item))) - (if (consp file) (setq file (car file))) - (if (consp line) (setq line (car line))) - (if (consp col) (setq col (car col))) - - (when (not (functionp line)) - (setq converted-list (cons (list regexp file line col) converted-list))))) - converted-list)) - -(require 'compile) - -(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text - (append - '( - ;; MS Visual C++ 6.0 - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; jikes - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; MS midl - ("midl[ ]*:[ ]*\\(command line error .*\\)" - nil nil nil 1) - ;; MS C# - ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)" - 1 3 nil 4) - ;; perl - ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1) - ;; PHP - ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1) - ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1) - ;; ant/javac. Note this also matches gcc warnings! - (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)" - 2 4 nil 5)) - ;; compilation-error-regexp-alist) - (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist)) - "Patterns for matching error/warning lines. Each pattern has the form -\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX). -Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns -from compile.el") - -(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4") -(defvar flymake-warning-predicate "^[wW]arning" - "Predicate matching against error text to detect a warning. -Takes a single argument, the error's text and should return non-nil -if it's a warning. -Instead of a function, it can also be a regular expression.") - -(defun flymake-parse-line (line) - "Parse LINE to see if it is an error or warning. -Return its components if so, nil otherwise." - (let ((raw-file-name nil) - (line-no 0) - (err-type "e") - (err-text nil) - (patterns flymake-err-line-patterns) - (matched nil)) - (while (and patterns (not matched)) - (when (string-match (car (car patterns)) line) - (let* ((file-idx (nth 1 (car patterns))) - (line-idx (nth 2 (car patterns)))) - - (setq raw-file-name (if file-idx (match-string file-idx line) nil)) - (setq line-no (if line-idx (string-to-number - (match-string line-idx line)) 0)) - (setq err-text (if (> (length (car patterns)) 4) - (match-string (nth 4 (car patterns)) line) - (flymake-patch-err-text - (substring line (match-end 0))))) - (if (null err-text) - (setq err-text "") - (when (cond ((stringp flymake-warning-predicate) - (string-match flymake-warning-predicate err-text)) - ((functionp flymake-warning-predicate) - (funcall flymake-warning-predicate err-text))) - (setq err-type "w"))) - (flymake-log - 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s" - file-idx line-idx raw-file-name line-no err-text) - (setq matched t))) - (setq patterns (cdr patterns))) - (if matched - (flymake-ler-make-ler raw-file-name line-no err-type err-text) - ()))) - -(defun flymake-find-err-info (err-info-list line-no) - "Find (line-err-info-list pos) for specified LINE-NO." - (if err-info-list - (let* ((line-err-info-list nil) - (pos 0) - (count (length err-info-list))) - - (while (and (< pos count) (< (car (nth pos err-info-list)) line-no)) - (setq pos (1+ pos))) - (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no)) - (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list)))) - (list line-err-info-list pos)) - '(nil 0))) - -(defun flymake-line-err-info-is-less-or-equal (line-one line-two) - (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (not (flymake-ler-file line-one)) (flymake-ler-file line-two)) - (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two)) - (or (and (flymake-ler-file line-one) (flymake-ler-file line-two)) - (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two))))))) - -(defun flymake-add-line-err-info (line-err-info-list line-err-info) - "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. -The new element is inserted in the proper position, according to -the predicate `flymake-line-err-info-is-less-or-equal'. -The updated value of LINE-ERR-INFO-LIST is returned." - (if (not line-err-info-list) - (list line-err-info) - (let* ((count (length line-err-info-list)) - (idx 0)) - (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info)) - (setq idx (1+ idx))) - (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list))) - (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info)))) - line-err-info-list))) - -(defun flymake-add-err-info (err-info-list line-err-info) - "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order. -Returns the updated value of ERR-INFO-LIST. -For the format of ERR-INFO-LIST, see `flymake-err-info'. -For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." - (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info))) - (info-and-pos (flymake-find-err-info err-info-list line-no)) - (exists (car info-and-pos)) - (pos (nth 1 info-and-pos)) - (line-err-info-list nil) - (err-info nil)) - - (if exists - (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list))))) - (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info)) - - (setq err-info (flymake-er-make-er line-no line-err-info-list)) - (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info))) - ((equal 0 pos) (setq err-info-list (cons err-info err-info-list))) - (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info)))) - err-info-list)) - -(defun flymake-get-project-include-dirs-imp (basedir) - "Include dirs for the project current file belongs to." - (if (flymake-get-project-include-dirs-from-cache basedir) - (progn - (flymake-get-project-include-dirs-from-cache basedir)) - ;;else - (let* ((command-line (concat "make -C " - (shell-quote-argument basedir) - " DUMPVARS=INCLUDE_DIRS dumpvars")) - (output (shell-command-to-string command-line)) - (lines (split-string output "\n" t)) - (count (length lines)) - (idx 0) - (inc-dirs nil)) - (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines)))) - (setq idx (1+ idx))) - (when (< idx count) - (let* ((inc-lines (split-string (nth idx lines) " *-I" t)) - (inc-count (length inc-lines))) - (while (> inc-count 0) - (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines))) - (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs)) - (setq inc-count (1- inc-count))))) - (flymake-add-project-include-dirs-to-cache basedir inc-dirs) - inc-dirs))) - -(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp - "Function used to get project include dirs, one parameter: basedir name.") - -(defun flymake-get-project-include-dirs (basedir) - (funcall flymake-get-project-include-dirs-function basedir)) - -(defun flymake-get-system-include-dirs () - "System include dirs - from the `INCLUDE' env setting." - (let* ((includes (getenv "INCLUDE"))) - (if includes (split-string includes path-separator t) nil))) - -(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal)) - -(defun flymake-get-project-include-dirs-from-cache (base-dir) - (gethash base-dir flymake-project-include-dirs-cache)) - -(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs) - (puthash base-dir include-dirs flymake-project-include-dirs-cache)) - -(defun flymake-clear-project-include-dirs-cache () - (clrhash flymake-project-include-dirs-cache)) - -(defun flymake-get-include-dirs (base-dir) - "Get dirs to use when resolving local file names." - (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs)))) - include-dirs)) - -;; (defun flymake-restore-formatting () -;; "Remove any formatting made by flymake." -;; ) - -;; (defun flymake-get-program-dir (buffer) -;; "Get dir to start program in." -;; (unless (bufferp buffer) -;; (error "Invalid buffer")) -;; (with-current-buffer buffer -;; default-directory)) - -(defun flymake-safe-delete-file (file-name) - (when (and file-name (file-exists-p file-name)) - (delete-file file-name) - (flymake-log 1 "deleted file %s" file-name))) - -(defun flymake-safe-delete-directory (dir-name) - (condition-case nil - (progn - (delete-directory dir-name) - (flymake-log 1 "deleted dir %s" dir-name)) - (error - (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name)))) - -(defun flymake-start-syntax-check () - "Start syntax checking for current buffer." - (interactive) - (flymake-log 3 "flymake is running: %s" flymake-is-running) - (when (and (not flymake-is-running) - (flymake-can-syntax-check-file buffer-file-name)) - (when (or (not flymake-compilation-prevents-syntax-check) - (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP") - (flymake-clear-buildfile-cache) - (flymake-clear-project-include-dirs-cache) - - (setq flymake-check-was-interrupted nil) - - (let* ((source-file-name buffer-file-name) - (init-f (flymake-get-init-function source-file-name)) - (cleanup-f (flymake-get-cleanup-function source-file-name)) - (cmd-and-args (funcall init-f)) - (cmd (nth 0 cmd-and-args)) - (args (nth 1 cmd-and-args)) - (dir (nth 2 cmd-and-args))) - (if (not cmd-and-args) - (progn - (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name) - (funcall cleanup-f)) - (progn - (setq flymake-last-change-time nil) - (flymake-start-syntax-check-process cmd args dir))))))) - -(defun flymake-start-syntax-check-process (cmd args dir) - "Start syntax check process." - (condition-case err - (let* ((process - (let ((default-directory (or dir default-directory))) - (when dir - (flymake-log 3 "starting process on dir %s" dir)) - (apply 'start-file-process - "flymake-proc" (current-buffer) cmd args)))) - (set-process-sentinel process 'flymake-process-sentinel) - (set-process-filter process 'flymake-process-filter) - (set-process-query-on-exit-flag process nil) - (push process flymake-processes) - - (setq flymake-is-running t) - (setq flymake-last-change-time nil) - (setq flymake-check-start-time (float-time)) - - (flymake-report-status nil "*") - (flymake-log 2 "started process %d, command=%s, dir=%s" - (process-id process) (process-command process) - default-directory) - process) - (error - (let* ((err-str - (format-message - "Failed to launch syntax check process `%s' with args %s: %s" - cmd args (error-message-string err))) - (source-file-name buffer-file-name) - (cleanup-f (flymake-get-cleanup-function source-file-name))) - (flymake-log 0 err-str) - (funcall cleanup-f) - (flymake-report-fatal-status "PROCERR" err-str))))) - -(defun flymake-kill-process (proc) - "Kill process PROC." - (kill-process proc) - (let* ((buf (process-buffer proc))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq flymake-check-was-interrupted t)))) - (flymake-log 1 "killed process %d" (process-id proc))) - -(defun flymake-stop-all-syntax-checks () - "Kill all syntax check processes." - (interactive) - (while flymake-processes - (flymake-kill-process (pop flymake-processes)))) - -(defun flymake-compilation-is-running () - (and (boundp 'compilation-in-progress) - compilation-in-progress)) - -(defun flymake-compile () - "Kill all flymake syntax checks, start compilation." - (interactive) - (flymake-stop-all-syntax-checks) - (call-interactively 'compile)) - -(defun flymake-on-timer-event (buffer) - "Start a syntax check for buffer BUFFER if necessary." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and (not flymake-is-running) - flymake-last-change-time - (> (- (float-time) flymake-last-change-time) - flymake-no-changes-timeout)) - - (setq flymake-last-change-time nil) - (flymake-log 3 "starting syntax check as more than 1 second passed since last change") - (flymake-start-syntax-check))))) - -(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line - 'flymake-popup-current-error-menu "24.4") - -(defun flymake-popup-current-error-menu (&optional event) - "Pop up a menu with errors/warnings for current line." - (interactive (list last-nonmenu-event)) - (let* ((line-no (line-number-at-pos)) - (errors (or (car (flymake-find-err-info flymake-err-info line-no)) - (user-error "No errors for current line"))) - (menu (mapcar (lambda (x) - (if (flymake-ler-file x) - (cons (format "%s - %s(%d)" - (flymake-ler-text x) - (flymake-ler-file x) - (flymake-ler-line x)) - x) - (list (flymake-ler-text x)))) - errors)) - (event (if (mouse-event-p event) - event - (list 'mouse-1 (posn-at-point)))) - (title (format "Line %d: %d error(s), %d warning(s)" - line-no - (flymake-get-line-err-count errors "e") - (flymake-get-line-err-count errors "w"))) - (choice (x-popup-menu event (list title (cons "" menu))))) - (flymake-log 3 "choice=%s" choice) - (when choice - (flymake-goto-file-and-line (flymake-ler-full-file choice) - (flymake-ler-line choice))))) - -(defun flymake-goto-file-and-line (file line) - "Try to get buffer for FILE and goto line LINE in it." - (if (not (file-exists-p file)) - (flymake-log 1 "File %s does not exist" file) - (find-file file) - (goto-char (point-min)) - (forward-line (1- line)))) - -;; flymake minor mode declarations -(defvar-local flymake-mode-line nil) -(defvar-local flymake-mode-line-e-w nil) -(defvar-local flymake-mode-line-status nil) - -(defun flymake-report-status (e-w &optional status) - "Show status in mode line." - (when e-w - (setq flymake-mode-line-e-w e-w)) - (when status - (setq flymake-mode-line-status status)) - (let* ((mode-line " Flymake")) - (when (> (length flymake-mode-line-e-w) 0) - (setq mode-line (concat mode-line ":" flymake-mode-line-e-w))) - (setq mode-line (concat mode-line flymake-mode-line-status)) - (setq flymake-mode-line mode-line) - (force-mode-line-update))) - -;; Nothing in flymake uses this at all any more, so this is just for -;; third-party compatibility. -(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1") - -(defun flymake-report-fatal-status (status warning) - "Display a warning and switch flymake mode off." - ;; This first message was always shown by default, and flymake-log - ;; does nothing by default, hence the use of message. - ;; Another option is display-warning. - (if (< flymake-log-level 0) - (message "Flymake: %s. Flymake will be switched OFF" warning)) - (flymake-mode 0) - (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s" - (buffer-name) status warning)) - -;;;###autoload -(define-minor-mode flymake-mode nil - :group 'flymake :lighter flymake-mode-line - (cond - - ;; Turning the mode ON. - (flymake-mode - (cond - ((not buffer-file-name) - (message "Flymake unable to run without a buffer file name")) - ((not (flymake-can-syntax-check-file buffer-file-name)) - (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name))) - (t - (add-hook 'after-change-functions 'flymake-after-change-function nil t) - (add-hook 'after-save-hook 'flymake-after-save-hook nil t) - (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) - ;;+(add-hook 'find-file-hook 'flymake-find-file-hook) - - (flymake-report-status "" "") - - (setq flymake-timer - (run-at-time nil 1 'flymake-on-timer-event (current-buffer))) - - (when (and flymake-start-syntax-check-on-find-file - ;; Since we write temp files in current dir, there's no point - ;; trying if the directory is read-only (bug#8954). - (file-writable-p (file-name-directory buffer-file-name))) - (with-demoted-errors - (flymake-start-syntax-check)))))) - - ;; Turning the mode OFF. - (t - (remove-hook 'after-change-functions 'flymake-after-change-function t) - (remove-hook 'after-save-hook 'flymake-after-save-hook t) - (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t) - ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t) - - (flymake-delete-own-overlays) - - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil)) - - (setq flymake-is-running nil)))) - -;;;###autoload -(defun flymake-mode-on () - "Turn flymake mode on." - (flymake-mode 1) - (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name))) - -;;;###autoload -(defun flymake-mode-off () - "Turn flymake mode off." - (flymake-mode 0) - (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name))) - -(defun flymake-after-change-function (start stop _len) - "Start syntax check for current buffer if it isn't already running." - ;;+(flymake-log 0 "setting change time to %s" (float-time)) - (let((new-text (buffer-substring start stop))) - (when (and flymake-start-syntax-check-on-newline (equal new-text "\n")) - (flymake-log 3 "starting syntax check as new-line has been seen") - (flymake-start-syntax-check)) - (setq flymake-last-change-time (float-time)))) - -(defun flymake-after-save-hook () - (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved? - (progn - (flymake-log 3 "starting syntax check as buffer was saved") - (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???) - -(defun flymake-kill-buffer-hook () - (when flymake-timer - (cancel-timer flymake-timer) - (setq flymake-timer nil))) - -;;;###autoload -(defun flymake-find-file-hook () - ;;+(when flymake-start-syntax-check-on-find-file - ;;+ (flymake-log 3 "starting syntax check on file open") - ;;+ (flymake-start-syntax-check) - ;;+) - (when (and (not (local-variable-p 'flymake-mode (current-buffer))) - (flymake-can-syntax-check-file buffer-file-name)) - (flymake-mode) - (flymake-log 3 "automatically turned ON flymake mode"))) - -(defun flymake-get-first-err-line-no (err-info-list) - "Return first line with error." - (when err-info-list - (flymake-er-get-line (car err-info-list)))) - -(defun flymake-get-last-err-line-no (err-info-list) - "Return last line with error." - (when err-info-list - (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list)))) - -(defun flymake-get-next-err-line-no (err-info-list line-no) - "Return next line with error." - (when err-info-list - (let* ((count (length err-info-list)) - (idx 0)) - (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list)))) - (setq idx (1+ idx))) - (if (< idx count) - (flymake-er-get-line (nth idx err-info-list)))))) - -(defun flymake-get-prev-err-line-no (err-info-list line-no) - "Return previous line with error." - (when err-info-list - (let* ((count (length err-info-list))) - (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list)))) - (setq count (1- count))) - (if (> count 0) - (flymake-er-get-line (nth (1- count) err-info-list)))))) - -(defun flymake-skip-whitespace () - "Move forward until non-whitespace is reached." - (while (looking-at "[ \t]") - (forward-char))) - -(defun flymake-goto-line (line-no) - "Go to line LINE-NO, then skip whitespace." - (goto-char (point-min)) - (forward-line (1- line-no)) - (flymake-skip-whitespace)) - -(defun flymake-goto-next-error () - "Go to next error in err ring." - (interactive) - (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-first-err-line-no flymake-err-info)) - (flymake-log 1 "passed end of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-goto-prev-error () - "Go to previous error in err ring." - (interactive) - (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos)))) - (when (not line-no) - (setq line-no (flymake-get-last-err-line-no flymake-err-info)) - (flymake-log 1 "passed beginning of file")) - (if line-no - (flymake-goto-line line-no) - (flymake-log 1 "no errors in current buffer")))) - -(defun flymake-patch-err-text (string) - (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string) - (match-string 1 string) - string)) - -;;;; general init-cleanup and helper routines -(defun flymake-create-temp-inplace (file-name prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - (or prefix - (setq prefix "flymake")) - (let* ((ext (file-name-extension file-name)) - (temp-name (file-truename - (concat (file-name-sans-extension file-name) - "_" prefix - (and ext (concat "." ext)))))) - (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name) - temp-name)) - -(defun flymake-create-temp-with-folder-structure (file-name _prefix) - (unless (stringp file-name) - (error "Invalid file-name")) - - (let* ((dir (file-name-directory file-name)) - ;; Not sure what this slash-pos is all about, but I guess it's just - ;; trying to remove the leading / of absolute file names. - (slash-pos (string-match "/" dir)) - (temp-dir (expand-file-name (substring dir (1+ slash-pos)) - temporary-file-directory))) - - (file-truename (expand-file-name (file-name-nondirectory file-name) - temp-dir)))) - -(defun flymake-delete-temp-directory (dir-name) - "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error." - (let* ((temp-dir temporary-file-directory) - (suffix (substring dir-name (1+ (length temp-dir))))) - - (while (> (length suffix) 0) - (setq suffix (directory-file-name suffix)) - ;;+(flymake-log 0 "suffix=%s" suffix) - (flymake-safe-delete-directory - (file-truename (expand-file-name suffix temp-dir))) - (setq suffix (file-name-directory suffix))))) - -(defvar-local flymake-temp-source-file-name nil) -(defvar-local flymake-master-file-name nil) -(defvar-local flymake-temp-master-file-name nil) -(defvar-local flymake-base-dir nil) - -(defun flymake-init-create-temp-buffer-copy (create-temp-f) - "Make a temporary copy of the current buffer, save its name in buffer data and return the name." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (funcall create-temp-f source-file-name "flymake"))) - - (flymake-save-buffer-in-file temp-source-file-name) - (setq flymake-temp-source-file-name temp-source-file-name) - temp-source-file-name)) - -(defun flymake-simple-cleanup () - "Do cleanup after `flymake-init-create-temp-buffer-copy'. -Delete temp file." - (flymake-safe-delete-file flymake-temp-source-file-name) - (setq flymake-last-change-time nil)) - -(defun flymake-get-real-file-name (file-name-from-err-msg) - "Translate file name from error message to \"real\" file name. -Return full-name. Names are real, not patched." - (let* ((real-name nil) - (source-file-name buffer-file-name) - (master-file-name flymake-master-file-name) - (temp-source-file-name flymake-temp-source-file-name) - (temp-master-file-name flymake-temp-master-file-name) - (base-dirs - (list flymake-base-dir - (file-name-directory source-file-name) - (if master-file-name (file-name-directory master-file-name)))) - (files (list (list source-file-name source-file-name) - (list temp-source-file-name source-file-name) - (list master-file-name master-file-name) - (list temp-master-file-name master-file-name)))) - - (when (equal 0 (length file-name-from-err-msg)) - (setq file-name-from-err-msg source-file-name)) - - (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files)) - ;; if real-name is nil, than file name from err msg is none of the files we've patched - (if (not real-name) - (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs))) - (if (not real-name) - (setq real-name file-name-from-err-msg)) - (setq real-name (flymake-fix-file-name real-name)) - (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name) - real-name)) - -(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files) - (let* ((base-dirs-count (length base-dirs)) - (file-count (length files)) - (real-name nil)) - - (while (and (not real-name) (> base-dirs-count 0)) - (setq file-count (length files)) - (while (and (not real-name) (> file-count 0)) - (let* ((this-dir (nth (1- base-dirs-count) base-dirs)) - (this-file (nth 0 (nth (1- file-count) files))) - (this-real-name (nth 1 (nth (1- file-count) files)))) - ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg) - (when (and this-dir this-file (flymake-same-files - (expand-file-name file-name-from-err-msg this-dir) - this-file)) - (setq real-name this-real-name))) - (setq file-count (1- file-count))) - (setq base-dirs-count (1- base-dirs-count))) - real-name)) - -(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs) - (let* ((real-name nil)) - (if (file-name-absolute-p file-name-from-err-msg) - (setq real-name file-name-from-err-msg) - (let* ((base-dirs-count (length base-dirs))) - (while (and (not real-name) (> base-dirs-count 0)) - (let* ((full-name (expand-file-name file-name-from-err-msg - (nth (1- base-dirs-count) base-dirs)))) - (if (file-exists-p full-name) - (setq real-name full-name)) - (setq base-dirs-count (1- base-dirs-count)))))) - real-name)) - -(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name) - "Find buildfile, store its dir in buffer data and return its dir, if found." - (let* ((buildfile-dir - (flymake-find-buildfile buildfile-name - (file-name-directory source-file-name)))) - (if buildfile-dir - (setq flymake-base-dir buildfile-dir) - (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name) - (flymake-report-fatal-status - "NOMK" (format "No buildfile (%s) found for %s" - buildfile-name source-file-name))))) - -(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp) - "Find master file (or buffer), create its copy along with a copy of the source file." - (let* ((source-file-name buffer-file-name) - (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)) - (master-and-temp-master (flymake-create-master-file - source-file-name temp-source-file-name - get-incl-dirs-f create-temp-f - master-file-masks include-regexp))) - - (if (not master-and-temp-master) - (progn - (flymake-log 1 "cannot find master file for %s" source-file-name) - (flymake-report-status "!" "") ; NOMASTER - nil) - (setq flymake-master-file-name (nth 0 master-and-temp-master)) - (setq flymake-temp-master-file-name (nth 1 master-and-temp-master))))) - -(defun flymake-master-cleanup () - (flymake-simple-cleanup) - (flymake-safe-delete-file flymake-temp-master-file-name)) - -;;;; make-specific init-cleanup routines -(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f) - "Create a command line for syntax check using GET-CMD-LINE-F." - (funcall get-cmd-line-f - (if use-relative-source - (file-relative-name source-file-name base-dir) - source-file-name) - (if use-relative-base-dir - (file-relative-name base-dir - (file-name-directory source-file-name)) - base-dir))) - -(defun flymake-get-make-cmdline (source base-dir) - (list "make" - (list "-s" - "-C" - base-dir - (concat "CHK_SOURCES=" source) - "SYNTAX_CHECK_MODE=1" - "check-syntax"))) - -(defun flymake-get-ant-cmdline (source base-dir) - (list "ant" - (list "-buildfile" - (concat base-dir "/" "build.xml") - (concat "-DCHK_SOURCES=" source) - "check-syntax"))) - -(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f) - "Create syntax check command line for a directly checked source file. -Use CREATE-TEMP-F for creating temp copy." - (let* ((args nil) - (source-file-name buffer-file-name) - (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name))) - (if buildfile-dir - (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))) - (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir - use-relative-base-dir use-relative-source - get-cmdline-f)))) - args)) - -(defun flymake-simple-make-init () - (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp) - "Create make command line for a source file checked via master file compilation." - (let* ((make-args nil) - (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - get-incl-dirs-f 'flymake-create-temp-inplace - master-file-masks include-regexp))) - (when temp-master-file-name - (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile"))) - (if buildfile-dir - (setq make-args (flymake-get-syntax-check-program-args - temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline))))) - make-args)) - -(defun flymake-find-make-buildfile (source-dir) - (flymake-find-buildfile "Makefile" source-dir)) - -;;;; .h/make specific -(defun flymake-master-make-header-init () - (flymake-master-make-init - 'flymake-get-include-dirs - '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'") - "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\"")) - -;;;; .java/make specific -(defun flymake-simple-make-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline)) - -(defun flymake-simple-ant-java-init () - (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline)) - -(defun flymake-simple-java-cleanup () - "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs." - (flymake-safe-delete-file flymake-temp-source-file-name) - (when flymake-temp-source-file-name - (flymake-delete-temp-directory - (file-name-directory flymake-temp-source-file-name)))) - -;;;; perl-specific init-cleanup routines -(defun flymake-perl-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "perl" (list "-wc " local-file)))) - -;;;; php-specific init-cleanup routines -(defun flymake-php-init () - (let* ((temp-file (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)) - (local-file (file-relative-name - temp-file - (file-name-directory buffer-file-name)))) - (list "php" (list "-f" local-file "-l")))) - -;;;; tex-specific init-cleanup routines -(defun flymake-get-tex-args (file-name) - ;;(list "latex" (list "-c-style-errors" file-name)) - (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name))) - -(defun flymake-simple-tex-init () - (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace))) - -;; Perhaps there should be a buffer-local variable flymake-master-file -;; that people can set to override this stuff. Could inherit from -;; the similar AUCTeX variable. -(defun flymake-master-tex-init () - (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy - 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace - '("\\.tex\\'") - "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}"))) - (when temp-master-file-name - (flymake-get-tex-args temp-master-file-name)))) - -(defun flymake-get-include-dirs-dot (_base-dir) - '(".")) - -;;;; xml-specific init-cleanup routines -(defun flymake-xml-init () - (list flymake-xml-program - (list "val" (flymake-init-create-temp-buffer-copy - 'flymake-create-temp-inplace)))) +(require 'flymake-ui) +(require 'flymake-proc) (provide 'flymake) ;;; flymake.el ends here commit ddda5ae547d4c814482984cad3d350f65db082e3 Author: Michael Albinus Date: Thu Aug 17 11:35:41 2017 +0200 Set `default-directory' for watchdog in tramp-test.el * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests): Set `default-directory' for watchdog. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 45cf95fcfe..9d2598ac03 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3821,7 +3821,9 @@ process sentinels. They shall not disturb each other." (with-timeout (300 (tramp--test-timeout-handler)) (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0) - (let* ((watchdog + (let* (;; For the watchdog. + (default-directory (expand-file-name temporary-file-directory)) + (watchdog (start-process "*watchdog*" nil shell-file-name shell-command-switch (format "sleep 300; kill -USR1 %d" (emacs-pid)))) commit 10a5a52f1d3d58297d926dc0b1f20bc0e423e408 Author: Andreas Schwab Date: Thu Aug 17 11:13:04 2017 +0200 * lisp/term/konsole.el: New file. diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el new file mode 100644 index 0000000000..45c701f33b --- /dev/null +++ b/lisp/term/konsole.el @@ -0,0 +1,12 @@ +;;; konsole.el --- terminal initialization for konsole +;; Copyright (C) 2017 Free Software Foundation, Inc. + +(require 'term/xterm) + +(defun terminal-init-konsole () + "Terminal initialization function for konsole." + (tty-run-terminal-initialization (selected-frame) "xterm")) + +(provide 'term/konsole) + +;; konsole.el ends here commit 3f938e1aea7e592de8c3ddb87508bf9d6ed8b3b5 Author: Noam Postavsky Date: Thu Jun 29 21:51:04 2017 -0400 * lisp/woman.el (woman-push, woman-pop): Remove. (Bug#27962) (woman2-RS): Use plain `push' instead of `woman-push'. (woman2-RE): Conditionally `pop' instead of `woman-pop'. diff --git a/lisp/woman.el b/lisp/woman.el index aa856c3957..6620ce4a2b 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -4261,22 +4261,11 @@ Delete line from point and eol unless LEAVE-EOL is non-nil." (if (> i 0) (setq woman-prevailing-indent i)))) woman-prevailing-indent) -(defmacro woman-push (value stack) - "Push VALUE onto STACK." - `(setq ,stack (cons ,value ,stack))) - -(defmacro woman-pop (variable stack) - "Pop into VARIABLE the value at the top of STACK. -Allow for mismatched requests!" - `(if ,stack - (setq ,variable (car ,stack) - ,stack (cdr ,stack)))) - (defun woman2-RS (to) ".RS i -- Start relative indent, move left margin in distance i. Set prevailing indent to 5 for nested indents. Format paragraphs upto TO." - (woman-push woman-left-margin woman-RS-left-margin) - (woman-push woman-prevailing-indent woman-RS-prevailing-indent) + (push woman-left-margin woman-RS-left-margin) + (push woman-prevailing-indent woman-RS-prevailing-indent) (setq woman-left-margin (+ woman-left-margin (woman2-get-prevailing-indent)) woman-prevailing-indent woman-default-indent) @@ -4285,8 +4274,10 @@ Set prevailing indent to 5 for nested indents. Format paragraphs upto TO." (defun woman2-RE (to) ".RE -- End of relative indent. Format paragraphs upto TO. Set prevailing indent to amount of starting .RS." - (woman-pop woman-left-margin woman-RS-left-margin) - (woman-pop woman-prevailing-indent woman-RS-prevailing-indent) + (when woman-RS-left-margin + (setq woman-left-margin (pop woman-RS-left-margin))) + (when woman-RS-prevailing-indent + (setq woman-prevailing-indent (pop woman-RS-prevailing-indent))) (woman-delete-line 1) ; ignore any arguments (woman2-format-paragraphs to woman-left-margin)) commit 794c3cd3a2dfcedc829ccb5dc413c99fb670f4a1 Author: Paul Eggert Date: Wed Aug 16 13:55:46 2017 -0700 Merge from Gnulib; use ‘open’ for O_CLOEXEC This incorporates: 2017-08-15 renameat: ensure declaration in on NetBSD 2017-08-15 extensions: enable NetBSD specific extensions 2017-08-14 open: support O_CLOEXEC 2017-08-13 reallocarray: new module * admin/merge-gnulib (AVOIDED_MODULES): Remove ‘open’, since it now supports O_CLOEXEC and this simplifies Emacs. * build-aux/config.guess, lib/fcntl.in.h, lib/stdio.in.h: * lib/stdlib.in.h, m4/extensions.m4, m4/stdlib_h.m4: Copy from Gnulib. * lib/cloexec.c, lib/cloexec.h, lib/open.c: * m4/mode_t.m4, m4/open-cloexec.m4, m4/open.m4: New files, copied from Gnulib. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib-src/etags.c (O_CLOEXEC) [WINDOWSNT]: Remove, as Gnulib does this for us. * src/filelock.c (create_lock_file): * src/sysdep.c (emacs_open, emacs_pipe): Don’t worry about O_CLOEXEC == 0, as Gnulib no longer sets it to 0. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 7eca64305d..e7b304a264 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -48,7 +48,7 @@ GNULIB_MODULES=' AVOIDED_MODULES=' close dup fchdir fstat malloc-posix msvc-inval msvc-nothrow - open openat-die opendir raise + openat-die opendir raise save-cwd select setenv sigprocmask stat stdarg stdbool threadlib tzset unsetenv utime utime-h ' diff --git a/build-aux/config.guess b/build-aux/config.guess index 07785f5451..a744844274 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-07-19' +timestamp='2017-08-08' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -259,6 +259,9 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in *:Sortix:*:*) echo ${UNAME_MACHINE}-unknown-sortix exit ;; + *:Redox:*:*) + echo ${UNAME_MACHINE}-unknown-redox + exit ;; alpha:OSF1:*:*) case $UNAME_RELEASE in *4.0) diff --git a/lib-src/etags.c b/lib-src/etags.c index 7b1a7fc185..bec61a8a23 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -111,7 +111,6 @@ char pot_etags_version[] = "@(#) pot revision number is 17.38.1.4"; # undef HAVE_NTGUI # undef DOS_NT # define DOS_NT -# define O_CLOEXEC O_NOINHERIT #endif /* WINDOWSNT */ #include diff --git a/lib/cloexec.c b/lib/cloexec.c new file mode 100644 index 0000000000..e34aef8797 --- /dev/null +++ b/lib/cloexec.c @@ -0,0 +1,83 @@ +/* cloexec.c - set or clear the close-on-exec descriptor flag + + Copyright (C) 1991, 2004-2006, 2009-2017 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . + + The code is taken from glibc/manual/llio.texi */ + +#include + +#include "cloexec.h" + +#include +#include +#include + +/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true, + or clear the flag if VALUE is false. + Return 0 on success, or -1 on error with 'errno' set. + + Note that on MingW, this function does NOT protect DESC from being + inherited into spawned children. Instead, either use dup_cloexec + followed by closing the original DESC, or use interfaces such as + open or pipe2 that accept flags like O_CLOEXEC to create DESC + non-inheritable in the first place. */ + +int +set_cloexec_flag (int desc, bool value) +{ +#ifdef F_SETFD + + int flags = fcntl (desc, F_GETFD, 0); + + if (0 <= flags) + { + int newflags = (value ? flags | FD_CLOEXEC : flags & ~FD_CLOEXEC); + + if (flags == newflags + || fcntl (desc, F_SETFD, newflags) != -1) + return 0; + } + + return -1; + +#else /* !F_SETFD */ + + /* Use dup2 to reject invalid file descriptors; the cloexec flag + will be unaffected. */ + if (desc < 0) + { + errno = EBADF; + return -1; + } + if (dup2 (desc, desc) < 0) + /* errno is EBADF here. */ + return -1; + + /* There is nothing we can do on this kind of platform. Punt. */ + return 0; +#endif /* !F_SETFD */ +} + + +/* Duplicates a file handle FD, while marking the copy to be closed + prior to exec or spawn. Returns -1 and sets errno if FD could not + be duplicated. */ + +int +dup_cloexec (int fd) +{ + return fcntl (fd, F_DUPFD_CLOEXEC, 0); +} diff --git a/lib/cloexec.h b/lib/cloexec.h new file mode 100644 index 0000000000..cdaf422226 --- /dev/null +++ b/lib/cloexec.h @@ -0,0 +1,38 @@ +/* cloexec.c - set or clear the close-on-exec descriptor flag + + Copyright (C) 2004, 2009-2017 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . + +*/ + +#include + +/* Set the 'FD_CLOEXEC' flag of DESC if VALUE is true, + or clear the flag if VALUE is false. + Return 0 on success, or -1 on error with 'errno' set. + + Note that on MingW, this function does NOT protect DESC from being + inherited into spawned children. Instead, either use dup_cloexec + followed by closing the original DESC, or use interfaces such as + open or pipe2 that accept flags like O_CLOEXEC to create DESC + non-inheritable in the first place. */ + +int set_cloexec_flag (int desc, bool value); + +/* Duplicates a file handle FD, while marking the copy to be closed + prior to exec or spawn. Returns -1 and sets errno if FD could not + be duplicated. */ + +int dup_cloexec (int fd); diff --git a/lib/fcntl.in.h b/lib/fcntl.in.h index 4a1d40af6d..076d1ac34a 100644 --- a/lib/fcntl.in.h +++ b/lib/fcntl.in.h @@ -213,7 +213,10 @@ _GL_WARN_ON_USE (openat, "openat is not portable - " #endif #ifndef O_CLOEXEC -# define O_CLOEXEC 0 +# define O_CLOEXEC 0x40000000 /* Try to not collide with system O_* flags. */ +# define GNULIB_defined_O_CLOEXEC 1 +#else +# define GNULIB_defined_O_CLOEXEC 0 #endif #ifndef O_DIRECT diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 30986b4ed7..b6eb0f6953 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump @@ -255,6 +255,7 @@ GNULIB_READ = @GNULIB_READ@ GNULIB_READDIR = @GNULIB_READDIR@ GNULIB_READLINK = @GNULIB_READLINK@ GNULIB_READLINKAT = @GNULIB_READLINKAT@ +GNULIB_REALLOCARRAY = @GNULIB_REALLOCARRAY@ GNULIB_REALLOC_POSIX = @GNULIB_REALLOC_POSIX@ GNULIB_REALPATH = @GNULIB_REALPATH@ GNULIB_REMOVE = @GNULIB_REMOVE@ @@ -465,6 +466,7 @@ HAVE_RAWMEMCHR = @HAVE_RAWMEMCHR@ HAVE_READDIR = @HAVE_READDIR@ HAVE_READLINK = @HAVE_READLINK@ HAVE_READLINKAT = @HAVE_READLINKAT@ +HAVE_REALLOCARRAY = @HAVE_REALLOCARRAY@ HAVE_REALPATH = @HAVE_REALPATH@ HAVE_RENAMEAT = @HAVE_RENAMEAT@ HAVE_REWINDDIR = @HAVE_REWINDDIR@ @@ -898,11 +900,13 @@ gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e973 gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec = @gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec@ gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1 = @gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1@ gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36 = @gl_GNULIB_ENABLED_be453cec5eecf5731a274f2de7f2db36@ +gl_GNULIB_ENABLED_cloexec = @gl_GNULIB_ENABLED_cloexec@ gl_GNULIB_ENABLED_dirfd = @gl_GNULIB_ENABLED_dirfd@ gl_GNULIB_ENABLED_dosname = @gl_GNULIB_ENABLED_dosname@ gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@ gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@ gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@ +gl_GNULIB_ENABLED_open = @gl_GNULIB_ENABLED_open@ gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@ gl_LIBOBJS = @gl_LIBOBJS@ gl_LTLIBOBJS = @gl_LTLIBOBJS@ @@ -1085,6 +1089,18 @@ EXTRA_DIST += careadlinkat.h endif ## end gnulib module careadlinkat +## begin gnulib module cloexec +ifeq (,$(OMIT_GNULIB_MODULE_cloexec)) + +ifneq (,$(gl_GNULIB_ENABLED_cloexec)) +libgnu_a_SOURCES += cloexec.c + +endif +EXTRA_DIST += cloexec.h + +endif +## end gnulib module cloexec + ## begin gnulib module close-stream ifeq (,$(OMIT_GNULIB_MODULE_close-stream)) @@ -1817,6 +1833,19 @@ EXTRA_DIST += strftime.h endif ## end gnulib module nstrftime +## begin gnulib module open +ifeq (,$(OMIT_GNULIB_MODULE_open)) + +ifneq (,$(gl_GNULIB_ENABLED_open)) + +endif +EXTRA_DIST += open.c + +EXTRA_libgnu_a_SOURCES += open.c + +endif +## end gnulib module open + ## begin gnulib module openat-h ifeq (,$(OMIT_GNULIB_MODULE_openat-h)) @@ -2311,6 +2340,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's/@''GNULIB_RANDOM''@/$(GNULIB_RANDOM)/g' \ -e 's/@''GNULIB_RANDOM_R''@/$(GNULIB_RANDOM_R)/g' \ -e 's/@''GNULIB_REALLOC_POSIX''@/$(GNULIB_REALLOC_POSIX)/g' \ + -e 's/@''GNULIB_REALLOCARRAY''@/$(GNULIB_REALLOCARRAY)/g' \ -e 's/@''GNULIB_REALPATH''@/$(GNULIB_REALPATH)/g' \ -e 's/@''GNULIB_RPMATCH''@/$(GNULIB_RPMATCH)/g' \ -e 's/@''GNULIB_SECURE_GETENV''@/$(GNULIB_SECURE_GETENV)/g' \ @@ -2341,6 +2371,7 @@ stdlib.h: stdlib.in.h $(top_builddir)/config.status $(CXXDEFS_H) \ -e 's|@''HAVE_RANDOM''@|$(HAVE_RANDOM)|g' \ -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ + -e 's|@''HAVE_REALLOCARRAY''@|$(HAVE_REALLOCARRAY)|g' \ -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ -e 's|@''HAVE_SECURE_GETENV''@|$(HAVE_SECURE_GETENV)|g' \ diff --git a/lib/open.c b/lib/open.c new file mode 100644 index 0000000000..c62f02b145 --- /dev/null +++ b/lib/open.c @@ -0,0 +1,208 @@ +/* Open a descriptor to a file. + Copyright (C) 2007-2017 Free Software Foundation, Inc. + + This program 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. + + This program 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 this program. If not, see . */ + +/* Written by Bruno Haible , 2007. */ + +/* If the user's config.h happens to include , let it include only + the system's here, so that orig_open doesn't recurse to + rpl_open. */ +#define __need_system_fcntl_h +#include + +/* Get the original definition of open. It might be defined as a macro. */ +#include +#include +#undef __need_system_fcntl_h + +static int +orig_open (const char *filename, int flags, mode_t mode) +{ + return open (filename, flags, mode); +} + +/* Specification. */ +/* Write "fcntl.h" here, not , otherwise OSF/1 5.1 DTK cc eliminates + this include because of the preliminary #include above. */ +#include "fcntl.h" + +#include "cloexec.h" + +#include +#include +#include +#include +#include +#include + +#ifndef REPLACE_OPEN_DIRECTORY +# define REPLACE_OPEN_DIRECTORY 0 +#endif + +int +open (const char *filename, int flags, ...) +{ + /* 0 = unknown, 1 = yes, -1 = no. */ +#if GNULIB_defined_O_CLOEXEC + int have_cloexec = -1; +#else + static int have_cloexec; +#endif + + mode_t mode; + int fd; + + mode = 0; + if (flags & O_CREAT) + { + va_list arg; + va_start (arg, flags); + + /* We have to use PROMOTED_MODE_T instead of mode_t, otherwise GCC 4 + creates crashing code when 'mode_t' is smaller than 'int'. */ + mode = va_arg (arg, PROMOTED_MODE_T); + + va_end (arg); + } + +#if GNULIB_defined_O_NONBLOCK + /* The only known platform that lacks O_NONBLOCK is mingw, but it + also lacks named pipes and Unix sockets, which are the only two + file types that require non-blocking handling in open(). + Therefore, it is safe to ignore O_NONBLOCK here. It is handy + that mingw also lacks openat(), so that is also covered here. */ + flags &= ~O_NONBLOCK; +#endif + +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + if (strcmp (filename, "/dev/null") == 0) + filename = "NUL"; +#endif + +#if OPEN_TRAILING_SLASH_BUG + /* If the filename ends in a slash and one of O_CREAT, O_WRONLY, O_RDWR + is specified, then fail. + Rationale: POSIX + says that + "A pathname that contains at least one non-slash character and that + ends with one or more trailing slashes shall be resolved as if a + single dot character ( '.' ) were appended to the pathname." + and + "The special filename dot shall refer to the directory specified by + its predecessor." + If the named file already exists as a directory, then + - if O_CREAT is specified, open() must fail because of the semantics + of O_CREAT, + - if O_WRONLY or O_RDWR is specified, open() must fail because POSIX + says that it + fails with errno = EISDIR in this case. + If the named file does not exist or does not name a directory, then + - if O_CREAT is specified, open() must fail since open() cannot create + directories, + - if O_WRONLY or O_RDWR is specified, open() must fail because the + file does not contain a '.' directory. */ + if (flags & (O_CREAT | O_WRONLY | O_RDWR)) + { + size_t len = strlen (filename); + if (len > 0 && filename[len - 1] == '/') + { + errno = EISDIR; + return -1; + } + } +#endif + + fd = orig_open (filename, + flags & ~(have_cloexec <= 0 ? O_CLOEXEC : 0), mode); + + if (flags & O_CLOEXEC) + { + if (! have_cloexec) + { + if (0 <= fd) + have_cloexec = 1; + else if (errno == EINVAL) + { + fd = orig_open (filename, flags & ~O_CLOEXEC, mode); + have_cloexec = -1; + } + } + if (have_cloexec < 0 && 0 <= fd) + set_cloexec_flag (fd, true); + } + + +#if REPLACE_FCHDIR + /* Implementing fchdir and fdopendir requires the ability to open a + directory file descriptor. If open doesn't support that (as on + mingw), we use a dummy file that behaves the same as directories + on Linux (ie. always reports EOF on attempts to read()), and + override fstat() in fchdir.c to hide the fact that we have a + dummy. */ + if (REPLACE_OPEN_DIRECTORY && fd < 0 && errno == EACCES + && ((flags & O_ACCMODE) == O_RDONLY + || (O_SEARCH != O_RDONLY && (flags & O_ACCMODE) == O_SEARCH))) + { + struct stat statbuf; + if (stat (filename, &statbuf) == 0 && S_ISDIR (statbuf.st_mode)) + { + /* Maximum recursion depth of 1. */ + fd = open ("/dev/null", flags, mode); + if (0 <= fd) + fd = _gl_register_fd (fd, filename); + } + else + errno = EACCES; + } +#endif + +#if OPEN_TRAILING_SLASH_BUG + /* If the filename ends in a slash and fd does not refer to a directory, + then fail. + Rationale: POSIX + says that + "A pathname that contains at least one non-slash character and that + ends with one or more trailing slashes shall be resolved as if a + single dot character ( '.' ) were appended to the pathname." + and + "The special filename dot shall refer to the directory specified by + its predecessor." + If the named file without the slash is not a directory, open() must fail + with ENOTDIR. */ + if (fd >= 0) + { + /* We know len is positive, since open did not fail with ENOENT. */ + size_t len = strlen (filename); + if (filename[len - 1] == '/') + { + struct stat statbuf; + + if (fstat (fd, &statbuf) >= 0 && !S_ISDIR (statbuf.st_mode)) + { + close (fd); + errno = ENOTDIR; + return -1; + } + } + } +#endif + +#if REPLACE_FCHDIR + if (!REPLACE_OPEN_DIRECTORY && 0 <= fd) + fd = _gl_register_fd (fd, filename); +#endif + + return fd; +} diff --git a/lib/stdio.in.h b/lib/stdio.in.h index d706377f98..b714c54a54 100644 --- a/lib/stdio.in.h +++ b/lib/stdio.in.h @@ -111,9 +111,9 @@ #define _GL_ATTRIBUTE_FORMAT_SCANF_SYSTEM(formatstring_parameter, first_argument) \ _GL_ATTRIBUTE_FORMAT ((__scanf__, formatstring_parameter, first_argument)) -/* Solaris 10 declares renameat in , not in . */ +/* Solaris 10 and NetBSD 7.0 declare renameat in , not in . */ /* But in any case avoid namespace pollution on glibc systems. */ -#if (@GNULIB_RENAMEAT@ || defined GNULIB_POSIXCHECK) && defined __sun \ +#if (@GNULIB_RENAMEAT@ || defined GNULIB_POSIXCHECK) && (defined __sun || defined __NetBSD__) \ && ! defined __GLIBC__ # include #endif diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h index b5cf9d3695..c6e68fddc4 100644 --- a/lib/stdlib.in.h +++ b/lib/stdlib.in.h @@ -765,6 +765,23 @@ _GL_WARN_ON_USE (realloc, "realloc is not POSIX compliant everywhere - " "use gnulib module realloc-posix for portability"); #endif + +#if @GNULIB_REALLOCARRAY@ +# if ! @HAVE_REALLOCARRAY@ +_GL_FUNCDECL_SYS (reallocarray, void *, + (void *ptr, size_t nmemb, size_t size)); +# endif +_GL_CXXALIAS_SYS (reallocarray, void *, + (void *ptr, size_t nmemb, size_t size)); +_GL_CXXALIASWARN (reallocarray); +#elif defined GNULIB_POSIXCHECK +# undef reallocarray +# if HAVE_RAW_DECL_REALLOCARRAY +_GL_WARN_ON_USE (reallocarray, "reallocarray is not portable - " + "use gnulib module reallocarray for portability"); +# endif +#endif + #if @GNULIB_REALPATH@ # if @REPLACE_REALPATH@ # if !(defined __cplusplus && defined GNULIB_NAMESPACE) diff --git a/m4/extensions.m4 b/m4/extensions.m4 index 0c16bb832f..f854338679 100644 --- a/m4/extensions.m4 +++ b/m4/extensions.m4 @@ -1,4 +1,4 @@ -# serial 16 -*- Autoconf -*- +# serial 17 -*- Autoconf -*- # Enable extensions on systems that normally disable them. # Copyright (C) 2003, 2006-2017 Free Software Foundation, Inc. @@ -68,6 +68,10 @@ dnl configure.ac when using autoheader 2.62. #ifndef _GNU_SOURCE # undef _GNU_SOURCE #endif +/* Enable NetBSD extensions on NetBSD. */ +#ifndef _NETBSD_SOURCE +# undef _NETBSD_SOURCE +#endif /* Enable OpenBSD extensions on NetBSD. */ #ifndef _OPENBSD_SOURCE # undef _OPENBSD_SOURCE @@ -132,6 +136,7 @@ dnl configure.ac when using autoheader 2.62. AC_DEFINE([_ALL_SOURCE]) AC_DEFINE([_DARWIN_C_SOURCE]) AC_DEFINE([_GNU_SOURCE]) + AC_DEFINE([_NETBSD_SOURCE]) AC_DEFINE([_OPENBSD_SOURCE]) AC_DEFINE([_POSIX_PTHREAD_SEMANTICS]) AC_DEFINE([__STDC_WANT_IEC_60559_ATTRIBS_EXT__]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index d1089860e1..13504a8ca2 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -53,6 +53,7 @@ AC_DEFUN([gl_EARLY], # Code from module c-strcase: # Code from module careadlinkat: # Code from module clock-time: + # Code from module cloexec: # Code from module close-stream: # Code from module count-leading-zeros: # Code from module count-one-bits: @@ -115,6 +116,7 @@ AC_DEFUN([gl_EARLY], # Code from module multiarch: # Code from module nocrash: # Code from module nstrftime: + # Code from module open: # Code from module openat-h: # Code from module pipe2: # Code from module pselect: @@ -413,6 +415,7 @@ AC_DEFUN([gl_INIT], gl_UTIMENS AC_C_VARARRAYS gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=false + gl_gnulib_enabled_cloexec=false gl_gnulib_enabled_dirfd=false gl_gnulib_enabled_dosname=false gl_gnulib_enabled_euidaccess=false @@ -422,6 +425,7 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1=false gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9=false gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false + gl_gnulib_enabled_open=false gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_strtoll=false @@ -431,6 +435,14 @@ AC_DEFUN([gl_INIT], if ! $gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b; then AC_LIBOBJ([openat-proc]) gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b=true + func_gl_gnulib_m4code_open + fi + } + func_gl_gnulib_m4code_cloexec () + { + if ! $gl_gnulib_enabled_cloexec; then + gl_MODULE_INDICATOR_FOR_TESTS([cloexec]) + gl_gnulib_enabled_cloexec=true fi } func_gl_gnulib_m4code_dirfd () @@ -536,6 +548,21 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=true fi } + func_gl_gnulib_m4code_open () + { + if ! $gl_gnulib_enabled_open; then + gl_FUNC_OPEN + if test $REPLACE_OPEN = 1; then + AC_LIBOBJ([open]) + gl_PREREQ_OPEN + fi + gl_FCNTL_MODULE_INDICATOR([open]) + gl_gnulib_enabled_open=true + if test $REPLACE_OPEN = 1; then + func_gl_gnulib_m4code_cloexec + fi + fi + } func_gl_gnulib_m4code_03e0aaad4cb89ca757653bd367a6ccb7 () { if ! $gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7; then @@ -622,6 +649,7 @@ AC_DEFUN([gl_INIT], fi m4_pattern_allow([^gl_GNULIB_ENABLED_]) AM_CONDITIONAL([gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b], [$gl_gnulib_enabled_260941c0e5dc67ec9e87d1fb321c300b]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_cloexec], [$gl_gnulib_enabled_cloexec]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dirfd], [$gl_gnulib_enabled_dirfd]) AM_CONDITIONAL([gl_GNULIB_ENABLED_dosname], [$gl_gnulib_enabled_dosname]) AM_CONDITIONAL([gl_GNULIB_ENABLED_euidaccess], [$gl_gnulib_enabled_euidaccess]) @@ -631,6 +659,7 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_a9786850e999ae65a836a6041e8e5ed1], [$gl_gnulib_enabled_a9786850e999ae65a836a6041e8e5ed1]) AM_CONDITIONAL([gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9], [$gl_gnulib_enabled_2049e887c7e5308faad27b3f894bb8c9]) AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31]) + AM_CONDITIONAL([gl_GNULIB_ENABLED_open], [$gl_gnulib_enabled_open]) AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) @@ -800,6 +829,8 @@ AC_DEFUN([gl_FILE_LIST], [ lib/c-strncasecmp.c lib/careadlinkat.c lib/careadlinkat.h + lib/cloexec.c + lib/cloexec.h lib/close-stream.c lib/close-stream.h lib/count-leading-zeros.c @@ -869,6 +900,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/mktime-internal.h lib/mktime.c lib/nstrftime.c + lib/open.c lib/openat-priv.h lib/openat-proc.c lib/openat.h @@ -987,10 +1019,13 @@ AC_DEFUN([gl_FILE_LIST], [ m4/minmax.m4 m4/mkostemp.m4 m4/mktime.m4 + m4/mode_t.m4 m4/multiarch.m4 m4/nocrash.m4 m4/nstrftime.m4 m4/off_t.m4 + m4/open-cloexec.m4 + m4/open.m4 m4/pipe2.m4 m4/pselect.m4 m4/pthread_sigmask.m4 diff --git a/m4/mode_t.m4 b/m4/mode_t.m4 new file mode 100644 index 0000000000..75d372a4a8 --- /dev/null +++ b/m4/mode_t.m4 @@ -0,0 +1,26 @@ +# mode_t.m4 serial 2 +dnl Copyright (C) 2009-2017 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# For using mode_t, it's sufficient to use AC_TYPE_MODE_T and +# include . + +# Define PROMOTED_MODE_T to the type that is the result of "default argument +# promotion" (ISO C 6.5.2.2.(6)) of the type mode_t. +AC_DEFUN([gl_PROMOTED_TYPE_MODE_T], +[ + AC_REQUIRE([AC_TYPE_MODE_T]) + AC_CACHE_CHECK([for promoted mode_t type], [gl_cv_promoted_mode_t], [ + dnl Assume mode_t promotes to 'int' if and only if it is smaller than 'int', + dnl and to itself otherwise. This assumption is not guaranteed by the ISO C + dnl standard, but we don't know of any real-world counterexamples. + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[typedef int array[2 * (sizeof (mode_t) < sizeof (int)) - 1];]])], + [gl_cv_promoted_mode_t='int'], + [gl_cv_promoted_mode_t='mode_t']) + ]) + AC_DEFINE_UNQUOTED([PROMOTED_MODE_T], [$gl_cv_promoted_mode_t], + [Define to the type that is the result of default argument promotions of type mode_t.]) +]) diff --git a/m4/open-cloexec.m4 b/m4/open-cloexec.m4 new file mode 100644 index 0000000000..897af66910 --- /dev/null +++ b/m4/open-cloexec.m4 @@ -0,0 +1,21 @@ +# Test whether O_CLOEXEC is defined. + +dnl Copyright 2017 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_PREPROC_O_CLOEXEC], +[ + AC_CACHE_CHECK([for O_CLOEXEC], + [gl_cv_macro_O_CLOEXEC], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[#include + #ifndef O_CLOEXEC + choke me; + #endif + ]], + [[return O_CLOEXEC;]])], + [gl_cv_macro_O_CLOEXEC=yes], + [gl_cv_macro_O_CLOEXEC=no])]) +]) diff --git a/m4/open.m4 b/m4/open.m4 new file mode 100644 index 0000000000..68253e15ff --- /dev/null +++ b/m4/open.m4 @@ -0,0 +1,95 @@ +# open.m4 serial 15 +dnl Copyright (C) 2007-2017 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_OPEN], +[ + AC_REQUIRE([AC_CANONICAL_HOST]) + AC_REQUIRE([gl_PREPROC_O_CLOEXEC]) + case "$host_os" in + mingw* | pw*) + REPLACE_OPEN=1 + ;; + *) + dnl open("foo/") should not create a file when the file name has a + dnl trailing slash. FreeBSD only has the problem on symlinks. + AC_CHECK_FUNCS_ONCE([lstat]) + if test "$gl_cv_macro_O_CLOEXEC" != yes; then + REPLACE_OPEN=1 + fi + AC_CACHE_CHECK([whether open recognizes a trailing slash], + [gl_cv_func_open_slash], + [# Assume that if we have lstat, we can also check symlinks. + if test $ac_cv_func_lstat = yes; then + touch conftest.tmp + ln -s conftest.tmp conftest.lnk + fi + AC_RUN_IFELSE( + [AC_LANG_SOURCE([[ +#include +#if HAVE_UNISTD_H +# include +#endif +int main () +{ + int result = 0; +#if HAVE_LSTAT + if (open ("conftest.lnk/", O_RDONLY) != -1) + result |= 1; +#endif + if (open ("conftest.sl/", O_CREAT, 0600) >= 0) + result |= 2; + return result; +}]])], + [gl_cv_func_open_slash=yes], + [gl_cv_func_open_slash=no], + [ +changequote(,)dnl + case "$host_os" in + freebsd* | aix* | hpux* | solaris2.[0-9] | solaris2.[0-9].*) + gl_cv_func_open_slash="guessing no" ;; + *) + gl_cv_func_open_slash="guessing yes" ;; + esac +changequote([,])dnl + ]) + rm -f conftest.sl conftest.tmp conftest.lnk + ]) + case "$gl_cv_func_open_slash" in + *no) + AC_DEFINE([OPEN_TRAILING_SLASH_BUG], [1], + [Define to 1 if open() fails to recognize a trailing slash.]) + REPLACE_OPEN=1 + ;; + esac + ;; + esac + dnl Replace open() for supporting the gnulib-defined fchdir() function, + dnl to keep fchdir's bookkeeping up-to-date. + m4_ifdef([gl_FUNC_FCHDIR], [ + if test $REPLACE_OPEN = 0; then + gl_TEST_FCHDIR + if test $HAVE_FCHDIR = 0; then + REPLACE_OPEN=1 + fi + fi + ]) + dnl Replace open() for supporting the gnulib-defined O_NONBLOCK flag. + m4_ifdef([gl_NONBLOCKING_IO], [ + if test $REPLACE_OPEN = 0; then + gl_NONBLOCKING_IO + if test $gl_cv_have_open_O_NONBLOCK != yes; then + REPLACE_OPEN=1 + fi + fi + ]) +]) + +# Prerequisites of lib/open.c. +AC_DEFUN([gl_PREREQ_OPEN], +[ + AC_REQUIRE([gl_PROMOTED_TYPE_MODE_T]) + : +]) diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 index 110fe2d1a9..ec4a058154 100644 --- a/m4/stdlib_h.m4 +++ b/m4/stdlib_h.m4 @@ -21,9 +21,9 @@ AC_DEFUN([gl_STDLIB_H], #endif ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt initstate initstate_r mkdtemp mkostemp mkostemps mkstemp mkstemps - posix_openpt ptsname ptsname_r qsort_r random random_r realpath rpmatch - secure_getenv setenv setstate setstate_r srandom srandom_r - strtod strtoll strtoull unlockpt unsetenv]) + posix_openpt ptsname ptsname_r qsort_r random random_r reallocarray + realpath rpmatch secure_getenv setenv setstate setstate_r srandom + srandom_r strtod strtoll strtoull unlockpt unsetenv]) ]) AC_DEFUN([gl_STDLIB_MODULE_INDICATOR], @@ -58,6 +58,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], GNULIB_QSORT_R=0; AC_SUBST([GNULIB_QSORT_R]) GNULIB_RANDOM=0; AC_SUBST([GNULIB_RANDOM]) GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R]) + GNULIB_REALLOCARRAY=0; AC_SUBST([GNULIB_REALLOCARRAY]) GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX]) GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH]) GNULIB_RPMATCH=0; AC_SUBST([GNULIB_RPMATCH]) @@ -89,6 +90,7 @@ AC_DEFUN([gl_STDLIB_H_DEFAULTS], HAVE_RANDOM=1; AC_SUBST([HAVE_RANDOM]) HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H]) HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R]) + HAVE_REALLOCARRAY=1; AC_SUBST([HAVE_REALLOCARRAY]) HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH]) HAVE_RPMATCH=1; AC_SUBST([HAVE_RPMATCH]) HAVE_SECURE_GETENV=1; AC_SUBST([HAVE_SECURE_GETENV]) diff --git a/src/filelock.c b/src/filelock.c index 3d6941695a..fec9bc044a 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -403,8 +403,6 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) else { ptrdiff_t lock_info_len; - if (! O_CLOEXEC) - fcntl (fd, F_SETFD, FD_CLOEXEC); lock_info_len = strlen (lock_info_str); err = 0; if (emacs_write (fd, lock_info_str, lock_info_len) != lock_info_len diff --git a/src/sysdep.c b/src/sysdep.c index 2e18a419e3..12e9c83ee9 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2393,8 +2393,6 @@ emacs_open (const char *file, int oflags, int mode) oflags |= O_CLOEXEC; while ((fd = open (file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); - if (! O_CLOEXEC && 0 <= fd) - fcntl (fd, F_SETFD, FD_CLOEXEC); return fd; } @@ -2436,13 +2434,7 @@ emacs_pipe (int fd[2]) #ifdef MSDOS return pipe (fd); #else /* !MSDOS */ - int result = pipe2 (fd, O_BINARY | O_CLOEXEC); - if (! O_CLOEXEC && result == 0) - { - fcntl (fd[0], F_SETFD, FD_CLOEXEC); - fcntl (fd[1], F_SETFD, FD_CLOEXEC); - } - return result; + return pipe2 (fd, O_BINARY | O_CLOEXEC); #endif /* !MSDOS */ } commit 69f2b755f44a5e447b3ad482ce0b409764fa10e6 Author: Alan Third Date: Thu Jul 6 23:10:49 2017 +0100 Allow use of run-time OS version checks on macOS (bug#27810) * src/nsterm.h (NSWindowTabbingMode): Define in pre-Sierra macOS. (MAC_OS_X_VERSION_10_6, MAC_OS_X_VERSION_10_7, MAC_OS_X_VERSION_10_8, MAC_OS_X_VERSION_10_9, MAC_OS_X_VERSION_10_12, HAVE_NATIVE_FS): Remove defines. (NSWindowStyleMaskFullScreen, NSWindowCollectionBehaviorFullScreenPrimary, NSApplicationPresentationFullScreen, NSApplicationPresentationAutoHideToolbar): Define in macOS 10.6. * src/nsterm.m (colorForEmacsRed, colorUsingDefaultColorSpace, check_native_fs, ns_read_socket, ns_select, runAlertPanel, initFrameFromEmacs, windowDidMiniaturize, windowDidEnterFullScreen, windowDidExitFullScreen, isFullscreen, updateCollectionBehavior, toggleFullScreen, constrainFrameRect, scrollerWidth, syms_of_nsterm): Allow use of run-time checks and replace version check macros. * src/nsfns.m (ns_screen_name): Use run-time OS version checks. * src/macfont.m (macfont_draw): Use run-time OS version checks. * src/nsmenu.m (menuWillOpen): Use run-time OS version checks. Co-authored-by: Charles A. Roelli diff --git a/src/macfont.m b/src/macfont.m index 4d310e47ae..19145f92c0 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -2869,11 +2869,19 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no and synthetic bold looks thinner on such environments. Apple says there are no plans to address this issue (rdar://11644870) currently. So we add a workaround. */ -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 - CGContextSetLineWidth (context, synthetic_bold_factor * font_size - * [[FRAME_NS_VIEW(f) window] backingScaleFactor]); -#else - CGContextSetLineWidth (context, synthetic_bold_factor * font_size); +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[FRAME_NS_VIEW(f) window] respondsToSelector: + @selector(backingScaleFactor)]) +#endif + CGContextSetLineWidth (context, synthetic_bold_factor * font_size + * [[FRAME_NS_VIEW(f) window] backingScaleFactor]); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + else +#endif +#endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + CGContextSetLineWidth (context, synthetic_bold_factor * font_size); #endif CG_SET_STROKE_COLOR_WITH_FACE_FOREGROUND (context, face, f); } diff --git a/src/nsfns.m b/src/nsfns.m index 36748cebb8..e19e4e2641 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1592,7 +1592,7 @@ Frames are listed from topmost (first) to bottommost (last). */) } #ifdef NS_IMPL_COCOA -#if MAC_OS_X_VERSION_MAX_ALLOWED > MAC_OS_X_VERSION_10_9 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 #define MODAL_OK_RESPONSE NSModalResponseOK #endif #endif @@ -2512,52 +2512,61 @@ and GNUstep implementations ("distributor-specific release { char *name = NULL; -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9 - mach_port_t masterPort; - io_iterator_t it; - io_object_t obj; +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + if (CGDisplayIOServicePort == NULL) +#endif + { + mach_port_t masterPort; + io_iterator_t it; + io_object_t obj; - // CGDisplayIOServicePort is deprecated. Do it another (harder) way. + /* CGDisplayIOServicePort is deprecated. Do it another (harder) way. - if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess - || IOServiceGetMatchingServices (masterPort, - IOServiceMatching ("IONDRVDevice"), - &it) != kIOReturnSuccess) - return name; + Is this code OK for macOS < 10.9, and GNUstep? I suspect it is, + in which case is it worth keeping the other method in here? */ - /* Must loop until we find a name. Many devices can have the same unit - number (represents different GPU parts), but only one has a name. */ - while (! name && (obj = IOIteratorNext (it))) - { - CFMutableDictionaryRef props; - const void *val; - - if (IORegistryEntryCreateCFProperties (obj, - &props, - kCFAllocatorDefault, - kNilOptions) == kIOReturnSuccess - && props != nil - && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex"))) + if (IOMasterPort (MACH_PORT_NULL, &masterPort) != kIOReturnSuccess + || IOServiceGetMatchingServices (masterPort, + IOServiceMatching ("IONDRVDevice"), + &it) != kIOReturnSuccess) + return name; + + /* Must loop until we find a name. Many devices can have the same unit + number (represents different GPU parts), but only one has a name. */ + while (! name && (obj = IOIteratorNext (it))) { - unsigned nr = [(NSNumber *)val unsignedIntegerValue]; - if (nr == CGDisplayUnitNumber (did)) - name = ns_get_name_from_ioreg (obj); + CFMutableDictionaryRef props; + const void *val; + + if (IORegistryEntryCreateCFProperties (obj, + &props, + kCFAllocatorDefault, + kNilOptions) == kIOReturnSuccess + && props != nil + && (val = CFDictionaryGetValue(props, @"IOFBDependentIndex"))) + { + unsigned nr = [(NSNumber *)val unsignedIntegerValue]; + if (nr == CGDisplayUnitNumber (did)) + name = ns_get_name_from_ioreg (obj); + } + + CFRelease (props); + IOObjectRelease (obj); } - CFRelease (props); - IOObjectRelease (obj); + IOObjectRelease (it); } - - IOObjectRelease (it); - -#else - - name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did)); - +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + else +#endif +#endif /* #if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + name = ns_get_name_from_ioreg (CGDisplayIOServicePort (did)); #endif return name; } -#endif +#endif /* NS_IMPL_COCOA */ static Lisp_Object ns_make_monitor_attribute_list (struct MonitorInfo *monitors, diff --git a/src/nsmenu.m b/src/nsmenu.m index 37a1a62d6d..93e06707c0 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -532,9 +532,14 @@ - (void)menuWillOpen:(NSMenu *)menu { ++trackingMenu; -#if MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 // On 10.6 we get repeated calls, only the one for NSSystemDefined is "real". - if ([[NSApp currentEvent] type] != NSSystemDefined) return; + if ( +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + NSAppKitVersionNumber < NSAppKitVersionNumber10_7 && +#endif + [[NSApp currentEvent] type] != NSEventTypeSystemDefined) + return; #endif /* When dragging from one menu to another, we get willOpen followed by didClose, diff --git a/src/nsterm.h b/src/nsterm.h index 67c0d42ac1..0ac8043e26 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -25,30 +25,6 @@ along with GNU Emacs. If not, see . */ #include "sysselect.h" #ifdef HAVE_NS - -#ifdef NS_IMPL_COCOA -#ifndef MAC_OS_X_VERSION_10_6 -#define MAC_OS_X_VERSION_10_6 1060 -#endif -#ifndef MAC_OS_X_VERSION_10_7 -#define MAC_OS_X_VERSION_10_7 1070 -#endif -#ifndef MAC_OS_X_VERSION_10_8 -#define MAC_OS_X_VERSION_10_8 1080 -#endif -#ifndef MAC_OS_X_VERSION_10_9 -#define MAC_OS_X_VERSION_10_9 1090 -#endif -#ifndef MAC_OS_X_VERSION_10_12 -#define MAC_OS_X_VERSION_10_12 101200 -#endif - -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 -#define HAVE_NATIVE_FS -#endif - -#endif /* NS_IMPL_COCOA */ - #ifdef __OBJC__ /* CGFloat on GNUstep may be 4 or 8 byte, but functions expect float* for some @@ -471,7 +447,7 @@ typedef id instancetype; - (void) toggleFullScreen: (id) sender; - (BOOL) fsIsNative; - (BOOL) isFullscreen; -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - (void) updateCollectionBehavior; #endif @@ -1277,9 +1253,17 @@ extern char gnustep_base_version[]; /* version tracking */ ? (min) : (((x)>(max)) ? (max) : (x))) #define SCREENMAXBOUND(x) (IN_BOUND (-SCREENMAX, x, SCREENMAX)) +/* macOS 10.7 introduces some new constants. */ +#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_7) +#define NSFullScreenWindowMask (1 << 14) +#define NSWindowCollectionBehaviorFullScreenPrimary (1 << 7) +#define NSApplicationPresentationFullScreen (1 << 10) +#define NSApplicationPresentationAutoHideToolbar (1 << 11) +#define NSAppKitVersionNumber10_7 1138 +#endif /* !defined (MAC_OS_X_VERSION_10_7) */ + /* macOS 10.12 deprecates a bunch of constants. */ -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_12 +#if !defined (NS_IMPL_COCOA) || !defined (MAC_OS_X_VERSION_10_12) #define NSEventModifierFlagCommand NSCommandKeyMask #define NSEventModifierFlagControl NSControlKeyMask #define NSEventModifierFlagHelp NSHelpKeyMask @@ -1305,6 +1289,7 @@ extern char gnustep_base_version[]; /* version tracking */ #define NSEventTypeKeyUp NSKeyUp #define NSEventTypeFlagsChanged NSFlagsChanged #define NSEventMaskAny NSAnyEventMask +#define NSEventTypeSystemDefined NSSystemDefined #define NSWindowStyleMaskBorderless NSBorderlessWindowMask #define NSWindowStyleMaskClosable NSClosableWindowMask #define NSWindowStyleMaskFullScreen NSFullScreenWindowMask @@ -1319,6 +1304,13 @@ extern char gnustep_base_version[]; /* version tracking */ #ifdef __OBJC__ typedef NSUInteger NSWindowStyleMask; #endif -#endif +/* Window tabbing mode enums are new too. */ +enum NSWindowTabbingMode + { + NSWindowTabbingModeAutomatic, + NSWindowTabbingModePreferred, + NSWindowTabbingModeDisallowed + }; +#endif #endif /* HAVE_NS */ diff --git a/src/nsterm.m b/src/nsterm.m index 36d906a7ce..95092b29c8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -136,14 +136,18 @@ @implementation NSColor (EmacsColor) + (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green blue:(CGFloat)blue alpha:(CGFloat)alpha { -#ifdef NS_IMPL_COCOA -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 - if (ns_use_srgb_colorspace) - return [NSColor colorWithSRGBRed: red - green: green - blue: blue - alpha: alpha]; +#if defined (NS_IMPL_COCOA) \ + && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + if (ns_use_srgb_colorspace +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + && [NSColor respondsToSelector: + @selector(colorWithSRGBRed:green:blue:alpha:)] #endif + ) + return [NSColor colorWithSRGBRed: red + green: green + blue: blue + alpha: alpha]; #endif return [NSColor colorWithCalibratedRed: red green: green @@ -153,11 +157,18 @@ + (NSColor *)colorForEmacsRed:(CGFloat)red green:(CGFloat)green - (NSColor *)colorUsingDefaultColorSpace { -#ifdef NS_IMPL_COCOA -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 - if (ns_use_srgb_colorspace) - return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; + /* FIXMES: We're checking for colorWithSRGBRed here so this will + only work in the same place as in the method above. It should + really be a check whether we're on macOS 10.7 or above. */ +#if defined (NS_IMPL_COCOA) \ + && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 + if (ns_use_srgb_colorspace +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + && [NSColor respondsToSelector: + @selector(colorWithSRGBRed:green:blue:alpha:)] #endif + ) + return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; #endif return [self colorUsingColorSpaceName: NSCalibratedRGBColorSpace]; } @@ -4140,7 +4151,7 @@ in certain situations (rapid incoming events). } } -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 static void check_native_fs () { @@ -4242,7 +4253,7 @@ in certain situations (rapid incoming events). NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_read_socket"); -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 check_native_fs (); #endif @@ -4324,7 +4335,7 @@ in certain situations (rapid incoming events). NSTRACE_WHEN (NSTRACE_GROUP_EVENTS, "ns_select"); -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 check_native_fs (); #endif @@ -5563,8 +5574,7 @@ - (void) terminate: (id)sender NSString *defaultButton, NSString *alternateButton) { -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9 +#ifdef NS_IMPL_GNUSTEP return NSRunAlertPanel(title, msgFormat, defaultButton, alternateButton, nil) == NSAlertDefaultReturn; #else @@ -6325,14 +6335,27 @@ - (NSRect)firstRectForCharacterRange: (NSRange)theRange +FRAME_LINE_HEIGHT (emacsframe)); pt = [self convertPoint: pt toView: nil]; -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7 - pt = [[self window] convertBaseToScreen: pt]; - rect.origin = pt; -#else - rect.origin = pt; - rect = [[self window] convertRectToScreen: rect]; + +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[self window] respondsToSelector: @selector(convertRectToScreen:)]) + { #endif + rect.origin = pt; + rect = [(EmacsWindow *) [self window] convertRectToScreen: rect]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + } + else +#endif +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 \ + || defined (NS_IMPL_GNUSTEP) + { + pt = [[self window] convertBaseToScreen: pt]; + rect.origin = pt; + } +#endif + return rect; } @@ -6988,11 +7011,15 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f scrollbarsNeedingUpdate = 0; fs_state = FULLSCREEN_NONE; fs_before_fs = next_maximized = -1; -#ifdef HAVE_NATIVE_FS - fs_is_native = ns_use_native_fullscreen; -#else + fs_is_native = NO; +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) #endif + fs_is_native = ns_use_native_fullscreen; +#endif + maximized_width = maximized_height = -1; nonfs_window = nil; @@ -7023,7 +7050,10 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f backing: NSBackingStoreBuffered defer: YES]; -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) +#endif [win setCollectionBehavior:NSWindowCollectionBehaviorFullScreenPrimary]; #endif @@ -7032,9 +7062,11 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f [win setAcceptsMouseMovedEvents: YES]; [win setDelegate: self]; -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9 - [win useOptimizedDrawing: YES]; +#if !defined (NS_IMPL_COCOA) || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 + if ([win respondsToSelector: @selector(useOptimizedDrawing:)]) +#endif + [win useOptimizedDrawing: YES]; #endif [[win contentView] addSubview: self]; @@ -7094,9 +7126,12 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f if ([col alphaComponent] != (EmacsCGFloat) 1.0) [win setOpaque: NO]; -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9 - [self allocateGState]; +#if !defined (NS_IMPL_COCOA) \ + || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 + if ([self respondsToSelector: @selector(allocateGState)]) +#endif + [self allocateGState]; #endif [NSApp registerServicesMenuSendTypes: ns_send_types returnTypes: [NSArray array]]; @@ -7104,9 +7139,12 @@ - (instancetype) initFrameFromEmacs: (struct frame *)f /* macOS Sierra automatically enables tabbed windows. We can't allow this to be enabled until it's available on a Free system. Currently it only happens by accident and is buggy anyway. */ -#if defined (NS_IMPL_COCOA) && \ - MAC_OS_X_VERSION_MIN_REQUIRED >= MAC_OS_X_VERSION_10_12 - [win setTabbingMode: NSWindowTabbingModeDisallowed]; +#if defined (NS_IMPL_COCOA) \ + && MAC_OS_X_VERSION_MAX_ALLOWED >= 101200 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 101200 + if ([win respondsToSelector: @selector(setTabbingMode:)]) +#endif + [win setTabbingMode: NSWindowTabbingModeDisallowed]; #endif ns_window_num++; @@ -7323,7 +7361,7 @@ - (void)windowDidMiniaturize: sender } } -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - (NSApplicationPresentationOptions)window:(NSWindow *)window willUseFullScreenPresentationOptions: (NSApplicationPresentationOptions)proposedOptions @@ -7361,8 +7399,8 @@ - (void)windowDidEnterFullScreen /* provided for direct calls */ else { BOOL tbar_visible = FRAME_EXTERNAL_TOOL_BAR (emacsframe) ? YES : NO; -#ifdef NS_IMPL_COCOA -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_7 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 \ + && MAC_OS_X_VERSION_MIN_REQUIRED <= 1070 unsigned val = (unsigned)[NSApp presentationOptions]; // Mac OS X 10.7 bug fix, the menu won't appear without this. @@ -7377,7 +7415,6 @@ - (void)windowDidEnterFullScreen /* provided for direct calls */ [NSApp setPresentationOptions: options]; } -#endif #endif [toolbar setVisible:tbar_visible]; } @@ -7417,7 +7454,7 @@ - (void)windowDidExitFullScreen /* provided for direct calls */ } [self setFSValue: fs_before_fs]; fs_before_fs = -1; -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 [self updateCollectionBehavior]; #endif if (FRAME_EXTERNAL_TOOL_BAR (emacsframe)) @@ -7449,7 +7486,7 @@ - (BOOL)isFullscreen } else { -#ifdef HAVE_NATIVE_FS +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 res = (([[self window] styleMask] & NSWindowStyleMaskFullScreen) != 0); #else res = NO; @@ -7462,7 +7499,7 @@ - (BOOL)isFullscreen return res; } -#ifdef HAVE_NATIVE_FS +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 - (void)updateCollectionBehavior { NSTRACE ("[EmacsView updateCollectionBehavior]"); @@ -7477,7 +7514,10 @@ - (void)updateCollectionBehavior b &= ~NSWindowCollectionBehaviorFullScreenPrimary; [win setCollectionBehavior: b]; - fs_is_native = ns_use_native_fullscreen; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if (NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) +#endif + fs_is_native = ns_use_native_fullscreen; } } #endif @@ -7494,8 +7534,11 @@ - (void)toggleFullScreen: (id)sender if (fs_is_native) { -#ifdef HAVE_NATIVE_FS - [[self window] toggleFullScreen:sender]; +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[self window] respondsToSelector: @selector(toggleFullScreen:)]) +#endif + [[self window] toggleFullScreen:sender]; #endif return; } @@ -7512,10 +7555,13 @@ - (void)toggleFullScreen: (id)sender { NSScreen *screen = [w screen]; -#if defined (NS_IMPL_COCOA) && \ - MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9 +#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 /* Hide ghost menu bar on secondary monitor? */ - if (! onFirstScreen) + if (! onFirstScreen +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + && [NSScreen respondsToSelector: @selector(screensHaveSeparateSpaces)] +#endif + ) onFirstScreen = [NSScreen screensHaveSeparateSpaces]; #endif /* Hide dock and menubar if we are on the primary screen. */ @@ -7543,9 +7589,12 @@ - (void)toggleFullScreen: (id)sender [fw setTitle:[w title]]; [fw setDelegate:self]; [fw setAcceptsMouseMovedEvents: YES]; -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED <= MAC_OS_X_VERSION_10_9 - [fw useOptimizedDrawing: YES]; +#if !defined (NS_IMPL_COCOA) \ + || MAC_OS_X_VERSION_MIN_REQUIRED <= 1090 +#if MAC_OS_X_VERSION_MAX_ALLOWED > 1090 + if ([fw respondsToSelector: @selector(useOptimizedDrawing:)]) +#endif + [fw useOptimizedDrawing: YES]; #endif [fw setBackgroundColor: col]; if ([col alphaComponent] != (EmacsCGFloat) 1.0) @@ -8106,10 +8155,14 @@ - (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen NSTRACE_ARG_RECT (frameRect)); #ifdef NS_IMPL_COCOA -#if MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9 +#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 // If separate spaces is on, it is like each screen is independent. There is // no spanning of frames across screens. - if ([NSScreen screensHaveSeparateSpaces]) + if ( +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + [NSScreen respondsToSelector: @selector(screensHaveSeparateSpaces)] && +#endif + [NSScreen screensHaveSeparateSpaces]) { NSTRACE_MSG ("Screens have separate spaces"); frameRect = [super constrainFrameRect:frameRect toScreen:screen]; @@ -8117,7 +8170,8 @@ - (NSRect)constrainFrameRect:(NSRect)frameRect toScreen:(NSScreen *)screen return frameRect; } else -#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= MAC_OS_X_VERSION_10_9 */ +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1090 */ + // Check that the proposed frameRect is visible in at least one // screen. If it is not, ask the system to reposition it (only // for non-child windows). @@ -8323,12 +8377,21 @@ + (CGFloat) scrollerWidth /* TODO: if we want to allow variable widths, this is the place to do it, however neither GNUstep nor Cocoa support it very well */ CGFloat r; -#if !defined (NS_IMPL_COCOA) || \ - MAC_OS_X_VERSION_MAX_ALLOWED < MAC_OS_X_VERSION_10_7 - r = [NSScroller scrollerWidth]; -#else - r = [NSScroller scrollerWidthForControlSize: NSControlSizeRegular - scrollerStyle: NSScrollerStyleLegacy]; +#if defined (NS_IMPL_COCOA) \ + && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([NSScroller respondsToSelector: + @selector(scrollerWidthForControlSize:scrollerStyle:)]) +#endif + r = [NSScroller scrollerWidthForControlSize: NSControlSizeRegular + scrollerStyle: NSScrollerStyleLegacy]; +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + else +#endif +#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */ +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 \ + || defined (NS_IMPL_GNUSTEP) + r = [NSScroller scrollerWidth]; #endif return r; } @@ -9015,12 +9078,8 @@ Convert an X font name (XLFD) to an NS font name. doc: /*Non-nil means to use native fullscreen on Mac OS X 10.7 and later. Nil means use fullscreen the old (< 10.7) way. The old way works better with multiple monitors, but lacks tool bar. This variable is ignored on -Mac OS X < 10.7. Default is t for 10.7 and later, nil otherwise. */); -#ifdef HAVE_NATIVE_FS +Mac OS X < 10.7. Default is t. */); ns_use_native_fullscreen = YES; -#else - ns_use_native_fullscreen = NO; -#endif ns_last_use_native_fullscreen = ns_use_native_fullscreen; DEFVAR_BOOL ("ns-use-fullscreen-animation", ns_use_fullscreen_animation, commit 3505b77ad7b54e5208685b6e229c76387120d5a1 Author: Alan Third Date: Sun Aug 13 01:47:05 2017 +0100 Add multiframe image support to NS port (bug#21714) * src/nsimage.m (ns_load_image): Handle multiple frames. (EmacsImage::getMetadata, EmacsImage::setFrame): New functions. * src/nsterm.h (EmacsImage::getMetadata, EmacsImage::setFrame): New function prototypes. diff --git a/src/nsimage.m b/src/nsimage.m index fb2322afc3..94b24a3912 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -76,9 +76,16 @@ Updated by Christian Limpach (chris@nice.ch) { EmacsImage *eImg = nil; NSSize size; + Lisp_Object lisp_index; + unsigned int index; NSTRACE ("ns_load_image"); + eassert (valid_image_p (img->spec)); + + lisp_index = Fplist_get (XCDR (img->spec), QCindex); + index = INTEGERP (lisp_index) ? XFASTINT (lisp_index) : 0; + if (STRINGP (spec_file)) { eImg = [EmacsImage allocInitFromFile: spec_file]; @@ -99,12 +106,20 @@ Updated by Christian Limpach (chris@nice.ch) return 0; } + if (index < 0 || ![eImg setFrame: index]) + { + add_to_log ("Unable to set index %d for image %s", index, img->spec); + return 0; + } + size = [eImg size]; img->width = size.width; img->height = size.height; /* 4) set img->pixmap = emacsimage */ img->pixmap = eImg; + + img->lisp_data = [eImg getMetadata]; return 1; } @@ -435,4 +450,49 @@ - (NSColor *)stippleMask return stippleMask; } +/* If the image has multiple frames, get a count of them and the + animation delay, if available. */ +- (Lisp_Object)getMetadata +{ + Lisp_Object metadata = Qnil; + + for (NSImageRep * r in [self representations]) + { + if ([r isKindOfClass:[NSBitmapImageRep class]]) + { + NSBitmapImageRep * bm = (NSBitmapImageRep *)r; + int frames = [[bm valueForProperty: NSImageFrameCount] intValue]; + float delay = [[bm valueForProperty: NSImageCurrentFrameDuration] + floatValue]; + + if (frames > 1) + metadata = Fcons (Qcount, Fcons (make_number (frames), metadata)); + if (delay > 0) + metadata = Fcons (Qdelay, Fcons (make_float (delay), metadata)); + break; + } + } + return metadata; +} + +/* Attempt to set the animation frame to be displayed. */ +- (BOOL)setFrame: (unsigned int) index +{ + for (NSImageRep * r in [self representations]) + { + if ([r isKindOfClass:[NSBitmapImageRep class]]) + { + NSBitmapImageRep * bm = (NSBitmapImageRep *)r; + if ([[bm valueForProperty: NSImageFrameCount] intValue] <= index) + continue; + + [bm setProperty: NSImageCurrentFrame + withValue: [NSNumber numberWithUnsignedInt: index]]; + return YES; + } + } + + return NO; +} + @end diff --git a/src/nsterm.h b/src/nsterm.h index 0f1b36db7b..67c0d42ac1 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -668,6 +668,8 @@ typedef id instancetype; alpha:(unsigned char)a; - (void)setAlphaAtX: (int)x Y: (int)y to: (unsigned char)a; - (NSColor *)stippleMask; +- (Lisp_Object)getMetadata; +- (BOOL)setFrame: (unsigned int) index; @end commit 400934b694087f4fe94755d78cbd1569efdb1fa8 Author: Tino Calancha Date: Wed Aug 16 20:14:48 2017 +0900 files-tests.el: Remove unused lexical variable * test/lisp/files-tests.el (file-test--do-local-variables-test); Remove unused var 'files-test-queried'. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 4a17e0d469..a2f2b74312 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -129,8 +129,7 @@ form.") (let ((enable-local-variables (nth 0 test-settings)) (enable-local-eval (nth 1 test-settings)) ;; Prevent any dir-locals file interfering with the tests. - (enable-dir-local-variables nil) - (files-test-queried nil)) + (enable-dir-local-variables nil)) (hack-local-variables) (eval (nth 2 test-settings))))) commit 3b8446439b9e8ec875c9d1b2899d87aa66837a7a Author: Michael Albinus Date: Wed Aug 16 12:11:37 2017 +0200 * doc/emacs/files.texi (Copying and Naming): Mention restrictions to add-name-to-file and make-symbolic-link on remote systems. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 7bca988a45..9d6e62b5f3 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -1598,8 +1598,8 @@ rename-file}. @xref{VC Delete/Rename}. file without removing the old name. The new name is created as a hard link to the existing file. The new name must belong on the same file system that the file is on. On MS-Windows, this command works only if -the file resides in an NTFS file system. On MS-DOS, it works by -copying the file. +the file resides in an NTFS file system. On MS-DOS, and some remote +system types, it works by copying the file. @findex make-symbolic-link @cindex symbolic links (creation) @@ -1610,7 +1610,8 @@ attempts to open file @var{new} will refer to whatever file is named the name @var{target} is nonexistent at that time. This command does not expand the argument @var{target}, so that it allows you to specify a relative name as the target of the link. On MS-Windows, this -command works only on MS Windows Vista and later. +command works only on MS Windows Vista and later. On remote systems, +it works depending on the system type. @node Misc File Ops @section Miscellaneous File Operations commit 142397e3a7f3c0164150f0bd9216c5722b272ce8 Author: Michael Albinus Date: Wed Aug 16 11:52:12 2017 +0200 * lisp/net/ange-ftp.el (ange-ftp-skip-msgs): Further support ftp-ssl. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 0fbf82577a..80b84765a0 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -689,11 +689,17 @@ parenthesized expressions in REGEXP for the components (in that order)." ;; authentication methods (typically) at connection establishment. Non ;; security-aware FTP servers should respond to this with a 500 code, ;; which we ignore. + +;; Further messages are needed to support ftp-ssl. (defcustom ange-ftp-skip-msgs (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" "^Data connection \\|" + "^200 PBSZ\\|" "^200 Protection set to Private\\|" + "^234 AUTH TLS successful\\|" "^SSL not available\\|" + "^\\[SSL Cipher .+\\]\\|" + "^\\[Encrypted data transfer\\.\\]\\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|" "^500 .*AUTH\\|^KERBEROS\\|" "^500 This security scheme is not implemented\\|" @@ -703,7 +709,7 @@ parenthesized expressions in REGEXP for the components (in that order)." "^22[789] .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT\\|^500 .*EPSV") "Regular expression matching FTP messages that can be ignored." :group 'ange-ftp - :version "24.4" ; add EPSV + :version "26.1" :type 'regexp) (defcustom ange-ftp-fatal-msgs commit 3305dec5387021791eb09a93df5ab784b2297dc8 Author: Noam Postavsky Date: Wed Jul 19 22:06:02 2017 -0400 Add tests for previous commit * test/lisp/progmodes/elisp-mode-tests.el (elisp-mode-tests--face-propertized-string): New function. (elisp--highlight-function-argument-indexed) (elisp--highlight-function-argument-keyed-1) (elisp--highlight-function-argument-keyed-2): New tests. diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index ee0837f2c4..675aa31a79 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -24,6 +24,7 @@ (require 'ert) (require 'xref) +(eval-when-compile (require 'cl-lib)) ;;; Completion @@ -180,6 +181,61 @@ (call-interactively #'eval-last-sexp) (should (equal (current-message) "66 (#o102, #x42, ?B)")))))) +;;; eldoc + +(defun elisp-mode-tests--face-propertized-string (string) + "Return substring of STRING with a non-nil `face' property." + (let* ((start (next-single-property-change 0 'face string)) + (end (and start (next-single-property-change start 'face string)))) + (and end + (substring string start end)))) + +(ert-deftest elisp--highlight-function-argument-indexed () + (dotimes (i 3) + (should + (equal (elisp-mode-tests--face-propertized-string + (elisp--highlight-function-argument 'foo "(A B C)" (1+ i) "foo: ")) + (propertize (nth i '("A" "B" "C")) + 'face 'eldoc-highlight-function-argument))))) + +(ert-deftest elisp--highlight-function-argument-keyed-1 () + (with-temp-buffer + (emacs-lisp-mode) + (insert "(foo prompt bar :b 2)") + (goto-char (1+ (point-min))) + (cl-flet ((bold-arg (i) + (elisp-mode-tests--face-propertized-string + (elisp--highlight-function-argument + 'foo "(PROMPT LST &key A B C)" i "foo: ")))) + (should-not (bold-arg 0)) + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 1) "PROMPT")) + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 2) "LST")) + ;; Both `:b' and `2' should highlight the `B' arg. + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 3) "B")) + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 4) "B"))))) + +(ert-deftest elisp--highlight-function-argument-keyed-2 () + (with-temp-buffer + (emacs-lisp-mode) + (insert "(foo :b :a 1)") + (goto-char (1+ (point-min))) + (cl-flet ((bold-arg (i) + (elisp-mode-tests--face-propertized-string + (elisp--highlight-function-argument + 'foo "(X &key A B C)" i "foo: ")))) + (should-not (bold-arg 0)) + ;; The `:b' specifies positional arg `X'. + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 1) "X")) + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 2) "A")) + (progn (forward-sexp) (forward-char)) + (should (equal (bold-arg 3) "A"))))) + ;;; xref (defun xref-elisp-test-descr-to-target (xref) commit 55c9238189795448075e2d4af93a7b29a505f23c Author: Thierry Volpiatto Date: Thu Jun 15 05:26:05 2017 +0200 Fix eldoc highlighting for &key args (Bug#27272) * lisp/progmodes/elisp-mode.el (elisp--highlight-function-argument): Only switch to keyword-based searching if INDEX point beyond `&key' in the argument list. All arguments prior to the `&key' are position based. Additionally, be more strict about what is a keyword when searching for the current keyword. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index b3f452ca5b..47739f5957 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1394,13 +1394,14 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ;; FIXME: This should probably work on the list representation of `args' ;; rather than its string representation. ;; FIXME: This function is much too long, we need to split it up! - (let ((start nil) - (end 0) - (argument-face 'eldoc-highlight-function-argument) - (args-lst (mapcar (lambda (x) - (replace-regexp-in-string - "\\`[(]\\|[)]\\'" "" x)) - (split-string args)))) + (let* ((start nil) + (end 0) + (argument-face 'eldoc-highlight-function-argument) + (args-lst (mapcar (lambda (x) + (replace-regexp-in-string + "\\`[(]\\|[)]\\'" "" x)) + (split-string args))) + (args-lst-ak (cdr (member "&key" args-lst)))) ;; Find the current argument in the argument string. We need to ;; handle `&rest' and informal `...' properly. ;; @@ -1412,12 +1413,12 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." ;; When `&key' is used finding position based on `index' ;; would be wrong, so find the arg at point and determine ;; position in ARGS based on this current arg. - (when (string-match "&key" args) + (when (and args-lst-ak + (>= index (- (length args-lst) (length args-lst-ak)))) (let* (case-fold-search key-have-value (sym-name (symbol-name sym)) - (cur-w (current-word)) - (args-lst-ak (cdr (member "&key" args-lst))) + (cur-w (current-word t)) (limit (save-excursion (when (re-search-backward sym-name nil t) (match-end 0)))) @@ -1425,7 +1426,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." (substring cur-w 1) (save-excursion (let (split) - (when (re-search-backward ":\\([^()\n]*\\)" limit t) + (when (re-search-backward ":\\([^ ()\n]*\\)" limit t) (setq split (split-string (match-string 1) " " t)) (prog1 (car split) (when (cdr split) @@ -1437,7 +1438,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'." args-lst-ak (not (member (upcase cur-a) args-lst-ak)) (upcase (car (last args-lst-ak)))))) - (unless (string= cur-w sym-name) + (unless (or (null cur-w) (string= cur-w sym-name)) ;; The last keyword have already a value ;; i.e :foo a b and cursor is at b. ;; If signature have also `&rest' commit e97aebd8fed255507fd17ef37a06b042ebed7e77 Author: Paul Eggert Date: Tue Aug 15 13:31:03 2017 -0700 Do not assume regular Git .git/hooks dir Apparently Gitlab doesn’t create .git/hooks, like regular Git does. Problem reported by Ted Zlatanov in: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00380.html * autogen.sh (git_sample_hook_src): New function. Use it to work even if .git/hooks or its samples do not exist. diff --git a/autogen.sh b/autogen.sh index 70f9cbd245..d454e41ea7 100755 --- a/autogen.sh +++ b/autogen.sh @@ -327,8 +327,21 @@ for hook in commit-msg pre-commit; do cmp -- build-aux/git-hooks/$hook "$hooks/$hook" >/dev/null 2>&1 || tailored_hooks="$tailored_hooks $hook" done + +git_sample_hook_src () +{ + hook=$1 + src=$hooks/$hook.sample + if test ! -r "$src"; then + case $hook in + applypatch-msg) src=build-aux/git-hooks/commit-msg;; + pre-applypatch) src=build-aux/git-hooks/pre-commit;; + esac + fi +} for hook in applypatch-msg pre-applypatch; do - cmp -- "$hooks/$hook.sample" "$hooks/$hook" >/dev/null 2>&1 || + git_sample_hook_src $hook + cmp -- "$src" "$hooks/$hook" >/dev/null 2>&1 || sample_hooks="$sample_hooks $hook" done @@ -336,6 +349,11 @@ if test -n "$tailored_hooks$sample_hooks"; then if $do_git; then echo "Installing git hooks..." + if test ! -d "$hooks"; then + printf "mkdir -p -- '%s'\\n" "$hooks" + mkdir -p -- "$hooks" || exit + fi + if test -n "$tailored_hooks"; then for hook in $tailored_hooks; do dst=$hooks/$hook @@ -346,8 +364,9 @@ if test -n "$tailored_hooks$sample_hooks"; then if test -n "$sample_hooks"; then for hook in $sample_hooks; do + git_sample_hook_src $hook dst=$hooks/$hook - cp $cp_options -- "$dst.sample" "$dst" || exit + cp $cp_options -- "$src" "$dst" || exit chmod -- a-w "$dst" || exit done fi commit 5c3d0ce3e09bf070bb3c89caa9d88f25d4a39283 Author: Paul Eggert Date: Tue Aug 15 10:06:44 2017 -0700 New manual section "Copying and Naming" * doc/emacs/files.texi (Copying and Naming): New section, split off from Misc File Ops and containing the operations that copy, name or rename files. This fixes some confusion caused by the incorrect phrase "The same rule applies to all the remaining commands in this section" in the old manual. This change does not affect the confusion about directories (see Bug#27986 for ongoing discussion). diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 1c9c14a962..824fb6ede2 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1710,7 +1710,7 @@ and mouse events: specify the key sequence. Using a string is simpler, but only works for @acronym{ASCII} characters and Meta-modified @acronym{ASCII} characters. For example, here's how to bind @kbd{C-x M-l} to -@code{make-symbolic-link} (@pxref{Misc File Ops}): +@code{make-symbolic-link} (@pxref{Copying and Naming}): @example (global-set-key "\C-x\M-l" 'make-symbolic-link) diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index a3eb4225a7..f3e6c94e27 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -453,6 +453,7 @@ File Handling * Directories:: Creating, deleting, and listing file directories. * Comparing Files:: Finding where two files differ. * Diff Mode:: Mode for editing file differences. +* Copying and Naming:: Copying, naming and renaming files. * Misc File Ops:: Other things you can do on files. * Compressed Files:: Accessing compressed files. * File Archives:: Operating on tar, zip, jar etc. archive files. diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 0b4e8eda2a..7bca988a45 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi @@ -33,6 +33,7 @@ on file directories. * Directories:: Creating, deleting, and listing file directories. * Comparing Files:: Finding where two files differ. * Diff Mode:: Mode for editing file differences. +* Copying and Naming:: Copying, naming and renaming files. * Misc File Ops:: Other things you can do on files. * Compressed Files:: Accessing compressed files. * File Archives:: Operating on tar, zip, jar etc. archive files. @@ -1545,6 +1546,72 @@ decide whether to save the changes (the list of modified files is displayed in the echo area). With a prefix argument, it tries to modify the original source files rather than the patched source files. +@node Copying and Naming +@section Copying, Naming and Renaming Files + + Emacs has several commands for copying, naming, and renaming files. +All of them read two file names @var{old} and @var{new} using the +minibuffer, and then copy or adjust a file's name accordingly; they do +not accept wildcard file names. + +In all these commands, if the argument @var{new} is just a directory +name, the real new name is in that directory, with the same +non-directory component as @var{old}. For example, @kbd{M-x +rename-file @key{RET} ~/foo @key{RET} +@c FIXME: This part of the example should be '/tmp/' not '/tmp', +@c because '/tmp' is not "just a directory name". +/tmp +@c +@key{RET}} renames @file{~/foo} to @file{/tmp/foo}. All these +commands ask for confirmation when the new file name already exists, +too. + +@findex copy-file +@cindex copying files + @kbd{M-x copy-file} copies the contents of the file @var{old} to the +file @var{new}. + +@findex copy-directory + @kbd{M-x copy-directory} copies directories, similar to the +@command{cp -r} shell command. If @var{new} is an existing directory, +it creates a copy of the @var{old} directory and puts it in @var{new}. +If @var{new} is not an existing directory, it copies all the contents +of @var{old} into a new directory named @var{new}. + +@cindex renaming files +@findex rename-file + @kbd{M-x rename-file} renames file @var{old} as @var{new}. If the +file name @var{new} already exists, you must confirm with @kbd{yes} or +renaming is not done; this is because renaming causes the old meaning +of the name @var{new} to be lost. If @var{old} and @var{new} are on +different file systems, the file @var{old} is copied and deleted. + +@ifnottex + If a file is under version control (@pxref{Version Control}), you +should rename it using @kbd{M-x vc-rename-file} instead of @kbd{M-x +rename-file}. @xref{VC Delete/Rename}. +@end ifnottex + +@findex add-name-to-file +@cindex hard links (creation) + @kbd{M-x add-name-to-file} adds an additional name to an existing +file without removing the old name. The new name is created as a hard +link to the existing file. The new name must belong on the same file +system that the file is on. On MS-Windows, this command works only if +the file resides in an NTFS file system. On MS-DOS, it works by +copying the file. + +@findex make-symbolic-link +@cindex symbolic links (creation) + @kbd{M-x make-symbolic-link} creates a symbolic link named +@var{new}, which points at @var{target}. The effect is that future +attempts to open file @var{new} will refer to whatever file is named +@var{target} at the time the opening is done, or will get an error if +the name @var{target} is nonexistent at that time. This command does +not expand the argument @var{target}, so that it allows you to specify +a relative name as the target of the link. On MS-Windows, this +command works only on MS Windows Vista and later. + @node Misc File Ops @section Miscellaneous File Operations @@ -1581,62 +1648,6 @@ should delete it using @kbd{M-x vc-delete-file} instead of @kbd{M-x delete-file}. @xref{VC Delete/Rename}. @end ifnottex -@findex copy-file -@cindex copying files - @kbd{M-x copy-file} copies the contents of the file @var{old} to the -file @var{new}. - -@findex copy-directory - @kbd{M-x copy-directory} copies directories, similar to the -@command{cp -r} shell command. It prompts for a directory @var{old} -and a destination @var{new}. If @var{new} is an existing directory, -it creates a copy of the @var{old} directory and puts it in @var{new}. -If @var{new} is not an existing directory, it copies all the contents -of @var{old} into a new directory named @var{new}. - -@cindex renaming files -@findex rename-file - @kbd{M-x rename-file} reads two file names @var{old} and @var{new} -using the minibuffer, then renames file @var{old} as @var{new}. If -the file name @var{new} already exists, you must confirm with -@kbd{yes} or renaming is not done; this is because renaming causes the -old meaning of the name @var{new} to be lost. If @var{old} and -@var{new} are on different file systems, the file @var{old} is copied -and deleted. If the argument @var{new} is just a directory name, the -real new name is in that directory, with the same non-directory -component as @var{old}. For example, @kbd{M-x rename-file @key{RET} -~/foo @key{RET} /tmp @key{RET}} renames @file{~/foo} to -@file{/tmp/foo}. The same rule applies to all the remaining commands -in this section. All of them ask for confirmation when the new file -name already exists, too. - -@ifnottex - If a file is under version control (@pxref{Version Control}), you -should rename it using @kbd{M-x vc-rename-file} instead of @kbd{M-x -rename-file}. @xref{VC Delete/Rename}. -@end ifnottex - -@findex add-name-to-file -@cindex hard links (creation) - @kbd{M-x add-name-to-file} adds an additional name to an existing -file without removing its old name. The new name is created as a -hard link to the existing file. The new name must belong on the -same file system that the file is on. On MS-Windows, this command -works only if the file resides in an NTFS file system. On MS-DOS, it -works by copying the file. - -@findex make-symbolic-link -@cindex symbolic links (creation) - @kbd{M-x make-symbolic-link} reads two file names @var{target} and -@var{linkname}, then creates a symbolic link named @var{linkname}, -which points at @var{target}. The effect is that future attempts to -open file @var{linkname} will refer to whatever file is named -@var{target} at the time the opening is done, or will get an error if -the name @var{target} is nonexistent at that time. This command does -not expand the argument @var{target}, so that it allows you to specify -a relative name as the target of the link. On MS-Windows, this -command works only on MS Windows Vista and later. - @kindex C-x i @findex insert-file @kbd{M-x insert-file} (also @kbd{C-x i}) inserts a copy of the commit 63daecda016a6d8f1241c07d7a06b154e31bfcb4 Author: Eli Zaretskii Date: Tue Aug 15 19:17:41 2017 +0300 Fix the MS-Windows build * src/fileio.c (Frename_file): Don't use ENOTSUP if it is equal to ENOSYS. (Bug#28097) (Bug#27986) diff --git a/src/fileio.c b/src/fileio.c index e557483ac4..1b832be344 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2297,7 +2297,10 @@ This is what happens in interactive use with M-x. */) rename_errno = errno; switch (rename_errno) { - case EEXIST: case EINVAL: case ENOSYS: case ENOTSUP: + case EEXIST: case EINVAL: case ENOSYS: +#if ENOSYS != ENOTSUP + case ENOTSUP: +#endif barf_or_query_if_file_exists (newname, rename_errno == EEXIST, "rename to it", INTEGERP (ok_if_already_exists), commit 7f8e50fb2acb368fd1d5edabb48a9f2b1cd9a51c Author: Ted Zlatanov Date: Tue Aug 15 10:07:42 2017 -0400 * .gitlab-ci.yml: run "autogen.sh autoconf" to avoid Git. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index fc1e26d41c..91ed6f974f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -28,7 +28,7 @@ image: debian:stretch before_script: - apt update -qq - - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev git + - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev stages: - test @@ -36,6 +36,6 @@ stages: test: stage: test script: - - ./autogen.sh + - ./autogen.sh autoconf - ./configure --without-makeinfo - make check commit b95efd359cd5471d4daa9cce357e3490947994df Author: Ted Zlatanov Date: Tue Aug 15 09:59:45 2017 -0400 * .gitlab-ci.yml: add Git to the installed packages. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0b1e8b5d9f..fc1e26d41c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -28,7 +28,7 @@ image: debian:stretch before_script: - apt update -qq - - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev + - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev git stages: - test commit 141cc78aa4552e99bf14c13d9e64357ccafe171b Author: Simen Heggestøyl Date: Tue Aug 15 12:39:42 2017 +0200 Support indentation of detached Less CSS rulesets * lisp/textmodes/css-mode.el (css-smie-rules): Provide better support for indentation of detached rulesets passed to Less mixins. * test/manual/indent/less-css-mode.less: New file. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 19cb7b4fea..1e49ca81fc 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1205,9 +1205,12 @@ for determining whether point is within a selector." (`(:before . "{") (when (or (smie-rule-hanging-p) (smie-rule-bolp)) (smie-backward-sexp ";") - (smie-indent-virtual))) - (`(:before . ,(or "{" "(")) - (if (smie-rule-hanging-p) (smie-rule-parent 0))) + (unless (eq (char-after) ?\{) + (smie-indent-virtual)))) + (`(:before . "(") + (cond + ((smie-rule-hanging-p) (smie-rule-parent 0)) + ((not (smie-rule-bolp)) 0))) (`(:after . ":-property") (when (smie-rule-hanging-p) css-indent-offset)))) diff --git a/test/manual/indent/less-css-mode.less b/test/manual/indent/less-css-mode.less new file mode 100644 index 0000000000..36c037450c --- /dev/null +++ b/test/manual/indent/less-css-mode.less @@ -0,0 +1,29 @@ +.desktop-and-old-ie(@rules) { + @media screen and (min-width: 1200) { @rules(); } + html.lt-ie9 & { @rules(); } +} + +header { + background-color: blue; + + .desktop-and-old-ie({ + background-color: red; + }); +} + +.e(@name, @rules) { + &__@{name} { @rules(); } +} + +.m(@name, @rules) { + &--@{name} { @rules(); } +} + +.btn { + .e(span, { // .btn__span + display: inline-block; + }); + .m(primary, { // .btn--primary + background: blue; + }); +} commit 85a9f42b6ca7711c64cbd3e4e261fae308eab9d3 Author: Simen Heggestøyl Date: Tue Aug 1 20:23:21 2017 +0200 Fixes and tweaks for the new Less CSS mode * etc/NEWS: Add an entry for the new mode. * lisp/textmodes/less-css-mode.el (less-css): Tweak docstring. (less-css-lessc-command): Tweak docstring. Don't mark it as safe. Don't autoload. (less-css-compile-at-save, less-css-lessc-options) (less-css-output-directory): Tweak docstrings. Don't autoload. (less-css-output-file-name): Tweak docstring. Don't mark it as safe. (less-css-input-file-name): Tweak docstring. Don't autoload. (less-css-compile-maybe): Use `when' for one-armed `if'. (less-css--output-path): Tweak docstring. (less-css--maybe-shell-quote-command): Remove function. (less-css-compile): Don't autoload. Tweak docstring and message. Fix compiler warning. Use `string-join' instead of `mapconcat'. (less-css-font-lock-keywords): Use `font-lock-variable-name-face' for variables. (less-css-mode-syntax-table, less-css-mode-map): New variables. (less-css-mode): Change status line mode name from "LESS" to "Less". Tweak docstring. Move syntax table definitions to `less-css-mode-syntax-table'. (less-css-indent-line): Remove function. diff --git a/etc/NEWS b/etc/NEWS index 3f38153048..9e86af5775 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1106,6 +1106,9 @@ fontification, and commenting for embedded JavaScript and CSS. ** New minor mode 'pixel-scroll-mode' provides smooth pixel-level scrolling. +** New major mode 'less-css-mode' (a minor variant of 'css-mode') for +editing Less files. + * Incompatible Lisp Changes in Emacs 26.1 diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el index 8a981d67b9..b38f259429 100644 --- a/lisp/textmodes/less-css-mode.el +++ b/lisp/textmodes/less-css-mode.el @@ -1,36 +1,41 @@ -;;; less-css-mode.el --- Major mode for editing LESS CSS files (lesscss.org) -;; -;; Copyright (C) 2011-2014 Steve Purcell -;; +;;; less-css-mode.el --- Major mode for editing Less CSS files -*- lexical-binding: t; -*- + +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. + ;; Author: Steve Purcell -;; URL: https://github.com/purcell/less-css-mode -;; Keywords: less css mode -;; Version: DEV -;; -;; This program 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 2 of -;; the License, or (at your option) any later version. -;; -;; This program 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. -;; +;; Maintainer: Simen Heggestøyl +;; Keywords: hypermedia + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + ;;; Commentary: -;; -;; This mode provides syntax highlighting for LESS CSS files, plus -;; optional support for compilation of .less files to .css files at -;; the time they are saved: use `less-css-compile-at-save' to enable -;; this. + +;; This mode provides syntax highlighting for Less CSS files +;; (http://lesscss.org/), plus optional support for compilation of +;; .less files to .css files at the time they are saved: use +;; `less-css-compile-at-save' to enable this. ;; ;; Command line utility "lessc" is required if setting ;; `less-css-compile-at-save' to t. To install "lessc" using the -;; Node.js package manager, run "npm install less" +;; Node.js package manager, run "npm install less". ;; ;; Also make sure the "lessc" executable is in Emacs' PATH, example: -;; (setq exec-path (cons (expand-file-name "~/.gem/ruby/1.8/bin") exec-path)) -;; or customize `less-css-lessc-command' to point to your "lessc" executable. +;; (push (expand-file-name "~/.gem/ruby/1.8/bin") exec-path) +;; or customize `less-css-lessc-command' to point to your "lessc" +;; executable. ;; ;; We target lessc >= 1.4.0, and thus use the `--no-color' flag by ;; default. You may want to adjust `less-css-lessc-options' for @@ -56,148 +61,122 @@ ;; ;; If you don't need CSS output but would like to be warned of any ;; syntax errors in your .less source, consider using `flymake-less': -;; https://github.com/purcell/flymake-less -;; +;; https://github.com/purcell/flymake-less. + ;;; Credits -;; + ;; The original code for this mode was, in large part, written using ;; Anton Johansson's scss-mode as a template -- thanks Anton! ;; https://github.com/antonj -;; + ;;; Code: -(require 'derived) (require 'compile) - -;; There are at least three css-mode.el implementations, but we need -;; the right one in order to work as expected, not the versions by -;; Landström or Garshol - (require 'css-mode) -(unless (or (boundp 'css-navigation-syntax-table) - (functionp 'css-smie-rules)) - (error "Wrong css-mode.el: please use the version by Stefan Monnier, bundled with Emacs >= 23")) +(require 'derived) +(eval-when-compile (require 'subr-x)) (defgroup less-css nil - "Less-css mode" + "Less CSS mode." :prefix "less-css-" :group 'css) -;;;###autoload (defcustom less-css-lessc-command "lessc" - "Command used to compile LESS files. -Should be lessc or the complete path to your lessc executable, - e.g.: \"~/.gem/ruby/1.8/bin/lessc\"" - :type 'file - :group 'less-css - :safe 'stringp) + "Command used to compile Less files. +Should be \"lessc\" or the complete path to your lessc +executable, e.g.: \"~/.gem/ruby/1.8/bin/lessc\"." + :type 'file) -;;;###autoload (defcustom less-css-compile-at-save nil - "If non-nil, the LESS buffers will be compiled to CSS after each save." - :type 'boolean - :group 'less-css - :safe 'booleanp) - + "If non-nil, Less buffers are compiled to CSS after each save." + :type 'boolean) ;;;###autoload -(defcustom less-css-lessc-options '("--no-color") - "Command line options for less executable. +(put 'less-css-compile-at-save 'safe-local-variable 'booleanp) +(defcustom less-css-lessc-options '("--no-color") + "Command line options for Less executable. Use \"-x\" to minify output." - :type '(repeat string) - :group 'less-css - :safe t) - + :type '(repeat string)) ;;;###autoload -(defcustom less-css-output-directory nil - "Directory in which to save CSS, or nil to use the LESS file's directory. +(put 'less-css-lessc-options 'safe-local-variable t) -This path is expanded relative to the directory of the LESS file +(defcustom less-css-output-directory nil + "Directory in which to save CSS, or nil to use the Less file's directory. +This path is expanded relative to the directory of the Less file using `expand-file-name', so both relative and absolute paths will work as expected." - :type 'directory - :group 'less-css - :safe 'stringp) - + :type 'directory) ;;;###autoload +(put 'less-css-output-directory 'safe-local-variable 'stringp) + (defcustom less-css-output-file-name nil "File name in which to save CSS, or nil to use .css for .less. - This can be also be set to a full path, or a relative path. If the path is relative, it will be relative to the value of `less-css-output-dir', if set, or the current directory by default." - :type 'file - :group 'less-css - :safe 'stringp) + :type 'file) (make-variable-buffer-local 'less-css-output-file-name) -;;;###autoload (defcustom less-css-input-file-name nil "File name which will be compiled to CSS. - When the current buffer is saved `less-css-input-file-name' file -will be compiled to css instead of the current file. +will be compiled to CSS instead of the current file. Set this in order to trigger compilation of a \"master\" .less file which includes the current file. The best way to set this variable in most cases is likely to be via directory local variables. -This can be also be set to a full path, or a relative path. If -the path is relative, it will be relative to the the current directory by -default." - :type 'file - :group 'less-css - :safe 'stringp) +This can be also be set to a full path, or a relative path. If +the path is relative, it will be relative to the the current +directory by default." + :type 'file) +;;;###autoload +(put 'less-css-input-file-name 'safe-local-variable 'stringp) (make-variable-buffer-local 'less-css-input-file-name) (defconst less-css-default-error-regex "^\\(?:\e\\[31m\\)?\\([^\e\n]*\\|FileError:.*\n\\)\\(?:\e\\[39m\e\\[31m\\)? in \\(?:\e\\[39m\\)?\\([^ \r\n\t\e]+\\)\\(?:\e\\[90m\\)?\\(?::\\| on line \\)\\([0-9]+\\)\\(?::\\|, column \\)\\([0-9]+\\):?\\(?:\e\\[39m\\)?") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Compilation to CSS -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Compilation to CSS (add-to-list 'compilation-error-regexp-alist-alist (list 'less-css less-css-default-error-regex 2 3 4 nil 1)) (add-to-list 'compilation-error-regexp-alist 'less-css) - (defun less-css-compile-maybe () "Run `less-css-compile' if `less-css-compile-at-save' is non-nil." - (if less-css-compile-at-save - (less-css-compile))) + (when less-css-compile-at-save + (less-css-compile))) (defun less-css--output-path () - "Calculate the path for the compiled CSS file created by `less-css-compile'." - (expand-file-name (or less-css-output-file-name - (concat (file-name-nondirectory (file-name-sans-extension buffer-file-name)) ".css")) - (or less-css-output-directory default-directory))) + "Return the path to use for the compiled CSS file." + (expand-file-name + (or less-css-output-file-name + (concat + (file-name-nondirectory + (file-name-sans-extension buffer-file-name)) + ".css")) + (or less-css-output-directory default-directory))) -(defun less-css--maybe-shell-quote-command (command) - "Selectively shell-quote COMMAND appropriately for `system-type'." - (funcall (if (eq system-type 'windows-nt) - 'identity - 'shell-quote-argument) command)) - -;;;###autoload (defun less-css-compile () - "Compiles the current buffer to css using `less-css-lessc-command'." + "Compile the current buffer to CSS using `less-css-lessc-command'." (interactive) - (message "Compiling less to css") - (let ((compilation-buffer-name-function (lambda (mode-name) "*less-css-compilation*"))) + (message "Compiling Less to CSS") + (let ((compilation-buffer-name-function + (lambda (_) "*less-css-compilation*"))) (save-window-excursion (with-current-buffer (compile - (mapconcat 'identity - (append (list (less-css--maybe-shell-quote-command less-css-lessc-command)) - (mapcar 'shell-quote-argument less-css-lessc-options) - (list (shell-quote-argument - (or less-css-input-file-name buffer-file-name)) - (shell-quote-argument (less-css--output-path)))) - " ")) + (string-join + (append + (list less-css-lessc-command) + (mapcar #'shell-quote-argument less-css-lessc-options) + (list (shell-quote-argument + (or less-css-input-file-name buffer-file-name)) + (shell-quote-argument (less-css--output-path)))) + " ")) (add-hook 'compilation-finish-functions (lambda (buf msg) (unless (string-match-p "^finished" msg) @@ -205,54 +184,49 @@ default." nil t))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Minor mode -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Major mode -;; TODO: interpolation ("@{val}"), escaped values (~"..."), JS eval (~`...`), custom faces +;; TODO: +;; - interpolation ("@{val}") +;; - escaped values (~"...") +;; - JS eval (~`...`) +;; - custom faces. (defconst less-css-font-lock-keywords '(;; Variables - ("@[a-z_-][a-z-_0-9]*" . font-lock-constant-face) + ("@[a-z_-][a-z-_0-9]*" . font-lock-variable-name-face) ("&" . font-lock-preprocessor-face) ;; Mixins - ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z-_0-9]*\\)[ \t]*;" . (1 font-lock-keyword-face))) - ) - + ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z-_0-9]*\\)[ \t]*;" . + (1 font-lock-keyword-face)))) + +(defvar less-css-mode-syntax-table + (let ((st (make-syntax-table css-mode-syntax-table))) + ;; C++-style comments. + (modify-syntax-entry ?/ ". 124b" st) + (modify-syntax-entry ?* ". 23" st) + (modify-syntax-entry ?\n "> b" st) + ;; Special chars that sometimes come at the beginning of words. + (modify-syntax-entry ?. "'" st) + st)) + +(defvar less-css-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'less-css-compile) + map)) + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode)) ;;;###autoload -(define-derived-mode less-css-mode css-mode "LESS" - "Major mode for editing LESS files, http://lesscss.org/ +(define-derived-mode less-css-mode css-mode "Less" + "Major mode for editing Less files (http://lesscss.org/). Special commands: \\{less-css-mode-map}" (font-lock-add-keywords nil less-css-font-lock-keywords) - ;; cpp-style comments - (modify-syntax-entry ?/ ". 124b" less-css-mode-syntax-table) - (modify-syntax-entry ?* ". 23" less-css-mode-syntax-table) - (modify-syntax-entry ?\n "> b" less-css-mode-syntax-table) - ;; Special chars that sometimes come at the beginning of words. - (modify-syntax-entry ?. "'" less-css-mode-syntax-table) - - (set (make-local-variable 'comment-start) "//") - (set (make-local-variable 'comment-end) "") - (set (make-local-variable 'indent-line-function) 'less-css-indent-line) - (when (functionp 'css-smie-rules) - (smie-setup css-smie-grammar #'css-smie-rules - :forward-token #'css-smie--forward-token - :backward-token #'css-smie--backward-token)) - + (setq-local comment-start "//") + (setq-local comment-end "") + (setq-local comment-continue " *") + (setq-local comment-start-skip "/[*/]+[ \t]*") + (setq-local comment-end-skip "[ \t]*\\(?:\n\\|\\*+/\\)") (add-hook 'after-save-hook 'less-css-compile-maybe nil t)) -(define-key less-css-mode-map "\C-c\C-c" 'less-css-compile) - -(defun less-css-indent-line () - "Indent current line according to LESS CSS indentation rules." - (let ((css-navigation-syntax-table less-css-mode-syntax-table)) - (if (fboundp 'css-indent-line) - (css-indent-line) - (smie-indent-line)))) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode)) - - (provide 'less-css-mode) ;;; less-css-mode.el ends here commit 3f887812e708123eca2f85cfbf5004e405aff914 Author: Steve Purcell Date: Tue Aug 1 20:15:45 2017 +0200 New major mode: Less CSS mode * lisp/textmodes/less-css-mode.el: New file. diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el new file mode 100644 index 0000000000..8a981d67b9 --- /dev/null +++ b/lisp/textmodes/less-css-mode.el @@ -0,0 +1,258 @@ +;;; less-css-mode.el --- Major mode for editing LESS CSS files (lesscss.org) +;; +;; Copyright (C) 2011-2014 Steve Purcell +;; +;; Author: Steve Purcell +;; URL: https://github.com/purcell/less-css-mode +;; Keywords: less css mode +;; Version: DEV +;; +;; This program 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 2 of +;; the License, or (at your option) any later version. +;; +;; This program 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. +;; +;;; Commentary: +;; +;; This mode provides syntax highlighting for LESS CSS files, plus +;; optional support for compilation of .less files to .css files at +;; the time they are saved: use `less-css-compile-at-save' to enable +;; this. +;; +;; Command line utility "lessc" is required if setting +;; `less-css-compile-at-save' to t. To install "lessc" using the +;; Node.js package manager, run "npm install less" +;; +;; Also make sure the "lessc" executable is in Emacs' PATH, example: +;; (setq exec-path (cons (expand-file-name "~/.gem/ruby/1.8/bin") exec-path)) +;; or customize `less-css-lessc-command' to point to your "lessc" executable. +;; +;; We target lessc >= 1.4.0, and thus use the `--no-color' flag by +;; default. You may want to adjust `less-css-lessc-options' for +;; compatibility with older versions. +;; +;; `less-css-mode' is derived from `css-mode', and indentation of +;; nested blocks may not work correctly with versions of `css-mode' +;; other than that bundled with recent Emacs. +;; +;; You can specify per-file values for `less-css-compile-at-save', +;; `less-css-output-file-name' or `less-css-output-directory' using a +;; variables header at the top of your .less file, e.g.: +;; +;; // -*- less-css-compile-at-save: t; less-css-output-directory: "../css" -*- +;; +;; Alternatively, you can use directory local variables to set the +;; default value of `less-css-output-directory' for your project. +;; +;; In the case of files which are included in other .less files, you +;; may want to trigger the compilation of a "master" .less file on +;; save: you can accomplish this with `less-css-input-file-name', +;; which is probably best set using directory local variables. +;; +;; If you don't need CSS output but would like to be warned of any +;; syntax errors in your .less source, consider using `flymake-less': +;; https://github.com/purcell/flymake-less +;; +;;; Credits +;; +;; The original code for this mode was, in large part, written using +;; Anton Johansson's scss-mode as a template -- thanks Anton! +;; https://github.com/antonj +;; +;;; Code: + +(require 'derived) +(require 'compile) + +;; There are at least three css-mode.el implementations, but we need +;; the right one in order to work as expected, not the versions by +;; Landström or Garshol + +(require 'css-mode) +(unless (or (boundp 'css-navigation-syntax-table) + (functionp 'css-smie-rules)) + (error "Wrong css-mode.el: please use the version by Stefan Monnier, bundled with Emacs >= 23")) + +(defgroup less-css nil + "Less-css mode" + :prefix "less-css-" + :group 'css) + +;;;###autoload +(defcustom less-css-lessc-command "lessc" + "Command used to compile LESS files. +Should be lessc or the complete path to your lessc executable, + e.g.: \"~/.gem/ruby/1.8/bin/lessc\"" + :type 'file + :group 'less-css + :safe 'stringp) + +;;;###autoload +(defcustom less-css-compile-at-save nil + "If non-nil, the LESS buffers will be compiled to CSS after each save." + :type 'boolean + :group 'less-css + :safe 'booleanp) + +;;;###autoload +(defcustom less-css-lessc-options '("--no-color") + "Command line options for less executable. + +Use \"-x\" to minify output." + :type '(repeat string) + :group 'less-css + :safe t) + +;;;###autoload +(defcustom less-css-output-directory nil + "Directory in which to save CSS, or nil to use the LESS file's directory. + +This path is expanded relative to the directory of the LESS file +using `expand-file-name', so both relative and absolute paths +will work as expected." + :type 'directory + :group 'less-css + :safe 'stringp) + +;;;###autoload +(defcustom less-css-output-file-name nil + "File name in which to save CSS, or nil to use .css for .less. + +This can be also be set to a full path, or a relative path. If +the path is relative, it will be relative to the value of +`less-css-output-dir', if set, or the current directory by +default." + :type 'file + :group 'less-css + :safe 'stringp) +(make-variable-buffer-local 'less-css-output-file-name) + +;;;###autoload +(defcustom less-css-input-file-name nil + "File name which will be compiled to CSS. + +When the current buffer is saved `less-css-input-file-name' file +will be compiled to css instead of the current file. + +Set this in order to trigger compilation of a \"master\" .less +file which includes the current file. The best way to set this +variable in most cases is likely to be via directory local +variables. + +This can be also be set to a full path, or a relative path. If +the path is relative, it will be relative to the the current directory by +default." + :type 'file + :group 'less-css + :safe 'stringp) +(make-variable-buffer-local 'less-css-input-file-name) + +(defconst less-css-default-error-regex + "^\\(?:\e\\[31m\\)?\\([^\e\n]*\\|FileError:.*\n\\)\\(?:\e\\[39m\e\\[31m\\)? in \\(?:\e\\[39m\\)?\\([^ \r\n\t\e]+\\)\\(?:\e\\[90m\\)?\\(?::\\| on line \\)\\([0-9]+\\)\\(?::\\|, column \\)\\([0-9]+\\):?\\(?:\e\\[39m\\)?") + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Compilation to CSS +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(add-to-list 'compilation-error-regexp-alist-alist + (list 'less-css less-css-default-error-regex 2 3 4 nil 1)) +(add-to-list 'compilation-error-regexp-alist 'less-css) + + +(defun less-css-compile-maybe () + "Run `less-css-compile' if `less-css-compile-at-save' is non-nil." + (if less-css-compile-at-save + (less-css-compile))) + +(defun less-css--output-path () + "Calculate the path for the compiled CSS file created by `less-css-compile'." + (expand-file-name (or less-css-output-file-name + (concat (file-name-nondirectory (file-name-sans-extension buffer-file-name)) ".css")) + (or less-css-output-directory default-directory))) + +(defun less-css--maybe-shell-quote-command (command) + "Selectively shell-quote COMMAND appropriately for `system-type'." + (funcall (if (eq system-type 'windows-nt) + 'identity + 'shell-quote-argument) command)) + +;;;###autoload +(defun less-css-compile () + "Compiles the current buffer to css using `less-css-lessc-command'." + (interactive) + (message "Compiling less to css") + (let ((compilation-buffer-name-function (lambda (mode-name) "*less-css-compilation*"))) + (save-window-excursion + (with-current-buffer + (compile + (mapconcat 'identity + (append (list (less-css--maybe-shell-quote-command less-css-lessc-command)) + (mapcar 'shell-quote-argument less-css-lessc-options) + (list (shell-quote-argument + (or less-css-input-file-name buffer-file-name)) + (shell-quote-argument (less-css--output-path)))) + " ")) + (add-hook 'compilation-finish-functions + (lambda (buf msg) + (unless (string-match-p "^finished" msg) + (display-buffer buf))) + nil + t))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Minor mode +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; TODO: interpolation ("@{val}"), escaped values (~"..."), JS eval (~`...`), custom faces +(defconst less-css-font-lock-keywords + '(;; Variables + ("@[a-z_-][a-z-_0-9]*" . font-lock-constant-face) + ("&" . font-lock-preprocessor-face) + ;; Mixins + ("\\(?:[ \t{;]\\|^\\)\\(\\.[a-z_-][a-z-_0-9]*\\)[ \t]*;" . (1 font-lock-keyword-face))) + ) + +;;;###autoload +(define-derived-mode less-css-mode css-mode "LESS" + "Major mode for editing LESS files, http://lesscss.org/ +Special commands: +\\{less-css-mode-map}" + (font-lock-add-keywords nil less-css-font-lock-keywords) + ;; cpp-style comments + (modify-syntax-entry ?/ ". 124b" less-css-mode-syntax-table) + (modify-syntax-entry ?* ". 23" less-css-mode-syntax-table) + (modify-syntax-entry ?\n "> b" less-css-mode-syntax-table) + ;; Special chars that sometimes come at the beginning of words. + (modify-syntax-entry ?. "'" less-css-mode-syntax-table) + + (set (make-local-variable 'comment-start) "//") + (set (make-local-variable 'comment-end) "") + (set (make-local-variable 'indent-line-function) 'less-css-indent-line) + (when (functionp 'css-smie-rules) + (smie-setup css-smie-grammar #'css-smie-rules + :forward-token #'css-smie--forward-token + :backward-token #'css-smie--backward-token)) + + (add-hook 'after-save-hook 'less-css-compile-maybe nil t)) + +(define-key less-css-mode-map "\C-c\C-c" 'less-css-compile) + +(defun less-css-indent-line () + "Indent current line according to LESS CSS indentation rules." + (let ((css-navigation-syntax-table less-css-mode-syntax-table)) + (if (fboundp 'css-indent-line) + (css-indent-line) + (smie-indent-line)))) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.less\\'" . less-css-mode)) + + +(provide 'less-css-mode) +;;; less-css-mode.el ends here commit 7abb5c39601a420bf74db41e2d70f8e36d07e349 Author: Alan Third Date: Tue Aug 15 09:58:33 2017 +0100 Fix ns-win.el on GNUstep * lisp/term/ns-win.el: Appkit version check only works on macOS, so don't try it when not using Cocoa. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index bc211ea958..16633792e4 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -741,18 +741,20 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") ;; FIXME: This doesn't look right. Is there a better way to do this ;; that keeps customize happy? -(let ((appkit-version (progn - (string-match "^appkit-\\([^\s-]*\\)" ns-version-string) - (string-to-number (match-string 1 ns-version-string))))) - ;; Appkit 1138 ~= macOS 10.7. - (when (and (featurep 'cocoa) (>= appkit-version 1138)) - (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control)))) - (put 'mouse-wheel-scroll-amount 'customized-value - (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount)))) - - (setq mouse-wheel-progressive-speed nil) - (put 'mouse-wheel-progressive-speed 'customized-value - (list (custom-quote (symbol-value 'mouse-wheel-progressive-speed)))))) +(when (featurep 'cocoa) + (let ((appkit-version + (progn (string-match "^appkit-\\([^\s-]*\\)" ns-version-string) + (string-to-number (match-string 1 ns-version-string))))) + ;; Appkit 1138 ~= macOS 10.7. + (when (>= appkit-version 1138) + (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control)))) + (put 'mouse-wheel-scroll-amount 'customized-value + (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount)))) + + (setq mouse-wheel-progressive-speed nil) + (put 'mouse-wheel-progressive-speed 'customized-value + (list (custom-quote + (symbol-value 'mouse-wheel-progressive-speed))))))) ;;;; Color support. commit 07ea5ef99a509622981a8ca69aadff15cbc0ef10 Author: Martin Rudalics Date: Sun Oct 1 10:30:33 2017 +0200 Fix reference style in org.texi * doc/misc/org.texi (A Texinfo example): Fix reference style. diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 37f2ba551a..b6a4fa2355 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -14034,7 +14034,7 @@ A somewhat obsessive function. @node A Texinfo example @subsection A Texinfo example -Here is a more detailed example Org file. @xref{GNU Sample +Here is a more detailed example Org file. See @ref{GNU Sample Texts,,,texinfo,GNU Texinfo Manual} for an equivalent example using Texinfo code. commit b03b4f6d79f1736f2455574aced92f89ed032d79 Author: Martin Rudalics Date: Sun Oct 1 10:17:17 2017 +0200 Improve handling of iconification of child frames (Bug#28611) * src/frame.c (Ficonify_frame): Handle `iconify-child-frame' option. (syms_of_frame): New symbols Qiconify_top_level and Qmake_invisible. (iconify_child_frame): New option. * lisp/cus-start.el (iconify-child-frame): Add customization properties. * doc/lispref/frames.texi (Child Frames): Describe new option `iconify-child-frame'. Don't index "top-level frame" twice. diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index f66ecee8e8..07a8b82502 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -3076,15 +3076,14 @@ as long as the parameter is not changed or reset. Technically, this makes the child frame's window-system window a child window of the parent frame's window-system window. -@cindex top-level frame @cindex reparent frame @cindex nest frame The @code{parent-frame} parameter can be changed at any time. Setting it to another frame @dfn{reparents} the child frame. Setting it to another child frame makes the frame a @dfn{nested} child frame. Setting -it to @code{nil} restores the frame's status as a @dfn{top-level -frame}---a frame whose window-system window is a child of its display's -root window. +it to @code{nil} restores the frame's status as a top-level frame---a +frame whose window-system window is a child of its display's root +window. Since child frames can be arbitrarily nested, a frame can be both a child and a parent frame. Also, the relative roles of child and parent @@ -3203,7 +3202,11 @@ a number of other ways as well. Here we sketch a few of them: @item The semantics of maximizing and iconifying child frames is highly window-system dependent. As a rule, applications should never invoke -these operations for child frames. +these operations for on frames. By default, invoking +@code{iconify-frame} on a child frame will try to iconify the top-level +frame corresponding to that child frame instead. To obtain a different +behavior, users may customize the option @code{iconify-child-frame} +described below. @item Raising, lowering and restacking child frames (@pxref{Raising and @@ -3259,6 +3262,23 @@ frame in the largest empty area of an existing window. This can be useful to avoid that a child frame obscures any text shown in that window. +Customizing the following option can be useful to tweak the behavior of +@code{iconify-frame} for child frames. + +@defvar iconify-child-frame +This option tells Emacs how to proceed when it is asked to iconify a +child frame. If it is @code{nil}, @code{iconify-frame} will do nothing +when invoked on a child frame. If it is @code{iconify-top-level}, Emacs +will try to iconify the top-level frame that is the ancestor of this +child frame instead. If it is @code{make-invisible}, Emacs will try to +make this child frame invisible instead of iconifying it. + +Any other value means to try iconifying the child frame. Since such an +attempt may not be honored by all window managers and can even lead to +making the child frame unresponsive to user actions, the default is to +iconify the top level frame instead. +@end defvar + @node Mouse Tracking @section Mouse Tracking diff --git a/lisp/cus-start.el b/lisp/cus-start.el index b197f2f1de..fd015b70ca 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -319,6 +319,13 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (const :tag "Always" t) (repeat (symbol :tag "Parameter"))) "25.1") + (iconify-child-frame frames + (choice + (const :tag "Do nothing" nil) + (const :tag "Iconify top level frame instead" iconify-top-level) + (const :tag "Make frame invisible instead" make-invisible) + (const :tag "Iconify" t)) + "26.1") (tooltip-reuse-hidden-frame tooltip boolean "26.1") ;; fringe.c (overflow-newline-into-fringe fringe boolean) diff --git a/src/frame.c b/src/frame.c index 39e5cc9c85..4ec54fa347 100644 --- a/src/frame.c +++ b/src/frame.c @@ -2535,10 +2535,33 @@ displayed in the terminal. */) DEFUN ("iconify-frame", Ficonify_frame, Siconify_frame, 0, 1, "", doc: /* Make the frame FRAME into an icon. -If omitted, FRAME defaults to the currently selected frame. */) +If omitted, FRAME defaults to the currently selected frame. + +If FRAME is a child frame, consult the variable `iconify-child-frame' +for how to proceed. */) (Lisp_Object frame) { struct frame *f = decode_live_frame (frame); + Lisp_Object parent = f->parent_frame; + + if (!NILP (parent)) + { + if (NILP (iconify_child_frame)) + /* Do nothing. */ + return Qnil; + else if (EQ (iconify_child_frame, Qiconify_top_level)) + { + /* Iconify top level frame instead (the default). */ + Ficonify_frame (parent); + return Qnil; + } + else if (EQ (iconify_child_frame, Qmake_invisible)) + { + /* Make frame invisible instead. */ + Fmake_frame_invisible (frame, Qnil); + return Qnil; + } + } /* Don't allow minibuf_window to remain on an iconified frame. */ check_minibuf_window (frame, EQ (minibuf_window, selected_window)); @@ -5713,6 +5736,8 @@ syms_of_frame (void) DEFSYM (Qheight_only, "height-only"); DEFSYM (Qleft_only, "left-only"); DEFSYM (Qtop_only, "top-only"); + DEFSYM (Qiconify_top_level, "iconify-top-level"); + DEFSYM (Qmake_invisible, "make-invisible"); { int i; @@ -6016,6 +6041,21 @@ This variable is effective only with the X toolkit (and there only when Gtk+ tooltips are not used) and on Windows. */); tooltip_reuse_hidden_frame = false; + DEFVAR_LISP ("iconify-child-frame", iconify_child_frame, + doc: /* How to handle iconification of child frames. +This variable tells Emacs how to proceed when it is asked to iconify a +child frame. If it is nil, `iconify-frame' will do nothing when invoked +on a child frame. If it is `iconify-top-level', Emacs will try to +iconify the top level frame associated with this child frame instead. +If it is `make-invisible', Emacs will try to make this child frame +invisible instead. + +Any other value means to try iconifying the child frame. Since such an +attempt is not honored by all window managers and may even lead to +making the child frame unresponsive to user actions, the default is to +iconify the top level frame instead. */); + iconify_child_frame = Qiconify_top_level; + staticpro (&Vframe_list); defsubr (&Sframep); commit ba9139c501ed8220980e898f127e293e8f263ea1 Author: Noam Postavsky Date: Fri Sep 29 21:00:10 2017 -0400 Revert "Don't lose arguments to eshell aliases (Bug#27954)" It broke the established argument handling methods provided by eshell aliases (Bug#28568). * doc/misc/eshell.texi (Aliases): Fix example, call out use of arguments in aliases. * lisp/eshell/em-alias.el (eshell-maybe-replace-by-alias): Ignore ARGS. diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 8963826c4c..8a607ef770 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -431,13 +431,20 @@ would in an Elisp program. Eshell provides a command version of Aliases are commands that expand to a longer input line. For example, @command{ll} is a common alias for @code{ls -l}, and would be defined -with the command invocation @samp{alias ll ls -l}; with this defined, +with the command invocation @kbd{alias ll 'ls -l $*'}; with this defined, running @samp{ll foo} in Eshell will actually run @samp{ls -l foo}. Aliases defined (or deleted) by the @command{alias} command are automatically written to the file named by @code{eshell-aliases-file}, which you can also edit directly (although you will have to manually reload it). +Note that unlike aliases in Bash, arguments must be handled +explicitly. Typically the alias definition would end in @samp{$*} to +pass all arguments along. More selective use of arguments via +@samp{$1}, @samp{$2}, etc., is also possible. For example, +@kbd{alias mcd 'mkdir $1 && cd $1'} would cause @kbd{mcd foo} to +create and switch to a directory called @samp{foo}. + @node History @section History @cmindex history diff --git a/lisp/eshell/em-alias.el b/lisp/eshell/em-alias.el index f951efa65d..742234574f 100644 --- a/lisp/eshell/em-alias.el +++ b/lisp/eshell/em-alias.el @@ -214,8 +214,8 @@ file named by `eshell-aliases-file'.") (defvar eshell-prevent-alias-expansion nil) -(defun eshell-maybe-replace-by-alias (command args) - "If COMMAND has an alias definition, call that instead using ARGS." +(defun eshell-maybe-replace-by-alias (command _args) + "Call COMMAND's alias definition, if it exists." (unless (and eshell-prevent-alias-expansion (member command eshell-prevent-alias-expansion)) (let ((alias (eshell-lookup-alias command))) @@ -225,7 +225,7 @@ file named by `eshell-aliases-file'.") (eshell-command-arguments ',eshell-last-arguments) (eshell-prevent-alias-expansion ',(cons command eshell-prevent-alias-expansion))) - ,(eshell-parse-command (nth 1 alias) args))))))) + ,(eshell-parse-command (nth 1 alias)))))))) (defun eshell-alias-completions (name) "Find all possible completions for NAME. commit 43fac3beae75a38cf758ec94039c0d7a4edc9399 Author: Noam Postavsky Date: Sun Aug 27 23:09:32 2017 -0400 Make "unsafe directory" error message more informative (Bug#865) * lisp/server.el (server-ensure-safe-dir): Produce a description for each "unsafe" condition. diff --git a/lisp/server.el b/lisp/server.el index 8aafa1c257..33800a9868 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -525,30 +525,35 @@ Creates the directory if necessary and makes sure: ;; Check that it's safe for use. (let* ((uid (nth 2 attrs)) (w32 (eq system-type 'windows-nt)) - (safe (cond - ((not (eq t (car attrs))) nil) ; is a dir? - ((and w32 (zerop uid)) ; on FAT32? - (display-warning - 'server - (format-message "\ + (unsafe (cond + ((not (eq t (car attrs))) + (format "it is a %s" (if (stringp (car attrs)) + "symlink" "file"))) + ((and w32 (zerop uid)) ; on FAT32? + (display-warning + 'server + (format-message "\ Using `%s' to store Emacs-server authentication files. Directories on FAT32 filesystems are NOT secure against tampering. See variable `server-auth-dir' for details." - (file-name-as-directory dir)) - :warning) - t) - ((and (/= uid (user-uid)) ; is the dir ours? - (or (not w32) - ;; Files created on Windows by Administrator - ;; (RID=500) have the Administrators (RID=544) - ;; group recorded as the owner. - (/= uid 544) (/= (user-uid) 500))) - nil) - (w32 t) ; on NTFS? - (t ; else, check permissions - (zerop (logand ?\077 (file-modes dir))))))) - (unless safe - (error "The directory `%s' is unsafe" dir))))) + (file-name-as-directory dir)) + :warning) + nil) + ((and (/= uid (user-uid)) ; is the dir ours? + (or (not w32) + ;; Files created on Windows by Administrator + ;; (RID=500) have the Administrators (RID=544) + ;; group recorded as the owner. + (/= uid 544) (/= (user-uid) 500))) + (format "it is not owned by you (owner = %s (%d))" + (user-full-name (user-uid)) (user-uid))) + (w32 nil) ; on NTFS? + ((/= 0 (logand ?\077 (file-modes dir))) + (format "it is accessible by others (%03o)" + (file-modes dir))) + (t nil)))) + (when unsafe + (error "`%s' is not a safe directory because %s" dir unsafe))))) (defun server-generate-key () "Generate and return a random authentication key. commit c59ddb212055609ec0c402708a2514ee6a30e836 Author: Eric Abrahamsen Date: Sat Sep 30 10:57:52 2017 -0700 Fix slot typecheck in eieio-persistent * lisp/emacs-lisp/eieio-base.el (eieio-persistent-slot-type-is-class-p): An `or' form can specify multiple potential classes (or null) as valid types for a slot, but previously only the final element of the `or' was actually checked. Now returns all valid classes in the `or' form. (eieio-persistent-validate/fix-slot-value): Check if proposed value matches any of the valid classes. * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el (eieio-test-multiple-class-slot): Test this behavior. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 6b39b4f262..e3501be6c1 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -31,6 +31,7 @@ ;;; Code: (require 'eieio) +(require 'seq) (eval-when-compile (require 'cl-lib)) ;;; eieio-instance-inheritor @@ -308,14 +309,6 @@ Second, any text properties will be stripped from strings." (= (length proposed-value) 1)) nil) - ;; We have a slot with a single object that can be - ;; saved here. Recurse and evaluate that - ;; sub-object. - ((and classtype (class-p classtype) - (child-of-class-p (car proposed-value) classtype)) - (eieio-persistent-convert-list-to-object - proposed-value)) - ;; List of object constructors. ((and (eq (car proposed-value) 'list) ;; 2nd item is a list. @@ -346,6 +339,16 @@ Second, any text properties will be stripped from strings." objlist)) ;; return the list of objects ... reversed. (nreverse objlist))) + ;; We have a slot with a single object that can be + ;; saved here. Recurse and evaluate that + ;; sub-object. + ((and classtype + (seq-some + (lambda (elt) + (child-of-class-p (car proposed-value) elt)) + classtype)) + (eieio-persistent-convert-list-to-object + proposed-value)) (t proposed-value)))) @@ -402,13 +405,9 @@ If no class is referenced there, then return nil." type)) ((eq (car-safe type) 'or) - ;; If type is a list, and is an or, it is possibly something - ;; like (or null myclass), so check for that. - (let ((ans nil)) - (dolist (subtype (cdr type)) - (setq ans (eieio-persistent-slot-type-is-class-p - subtype))) - ans)) + ;; If type is a list, and is an `or', return all valid class + ;; types within the `or' statement. + (seq-filter #'eieio-persistent-slot-type-is-class-p (cdr type))) (t ;; No match, not a class. diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index e2cff3fbca..738711c9c8 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el @@ -195,6 +195,28 @@ persistent class.") (persist-test-save-and-compare persist-woss) (delete-file (oref persist-woss file)))) +;; A slot that can contain one of two different classes, to exercise +;; the `or' slot type. + +(defclass persistent-random-class () + ()) + +(defclass persistent-multiclass-slot (eieio-persistent) + ((slot1 :initarg :slot1 + :type (or persistent-random-class null persist-not-persistent)) + (slot2 :initarg :slot2 + :type (or persist-not-persistent persist-random-class null)))) + +(ert-deftest eieio-test-multiple-class-slot () + (let ((persist + (persistent-multiclass-slot "random string" + :slot1 (persistent-random-class) + :slot2 (persist-not-persistent) + :file (concat default-directory "test-ps5.pt")))) + (unwind-protect + (persist-test-save-and-compare persist) + (ignore-errors (delete-file (oref persist file)))))) + ;;; Slot with a list of Objects ;; ;; A slot that contains another object that isn't persistent commit 8b2ab5014b2c1641bb62efa63b9ee54b4c056b5a Author: Dmitry Gutov Date: Sat Sep 30 16:17:02 2017 +0200 Fix semantic-ia-fast-jump * lisp/cedet/semantic/ia.el (semantic-ia--fast-jump-helper): Use `pop-to-buffer-same-window' (bug#28645). diff --git a/lisp/cedet/semantic/ia.el b/lisp/cedet/semantic/ia.el index d4201fcf51..625c3ae975 100644 --- a/lisp/cedet/semantic/ia.el +++ b/lisp/cedet/semantic/ia.el @@ -322,7 +322,7 @@ This helper manages the mark, buffer switching, and pulsing." (semantic-go-to-tag dest) ;; 3) go-to-tag doesn't switch the buffer in the current window, ;; so it is like find-file-noselect. Bring it forward. - (switch-to-buffer (current-buffer)) + (pop-to-buffer-same-window (current-buffer)) ;; 4) Fancy pulsing. (pulse-momentary-highlight-one-line (point)) ) commit 5b45e7e1c337ddcc357b91755500d3771459be94 Author: Kaushal Modi Date: Fri Sep 29 12:38:56 2017 -0400 Bind vc-region-history * lisp/vc/vc-hooks.el (vc-prefix-map): Bind `vc-region-history' to 'C-x v h', which was earlier bound to `vc-insert-headers' (Bug#27644). * doc/emacs/maintaining.texi (VC Change Log): Mention the new binding. * doc/emacs/vc1-xtra.texi (Version Headers): Remove the association of 'C-x v h' with `vc-insert-headers'. (http://lists.gnu.org/archive/html/emacs-devel/2017-09/msg00957.html) diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 7f91991daa..dc0a71511f 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1050,13 +1050,14 @@ increase the number of revisions shown in an existing entries} or @samp{Show unlimited entries} buttons at the end of the buffer. However, RCS, SCCS, and CVS do not support this feature. +@kindex C-x v h @findex vc-region-history A useful variant of examining changes is provided by the command -@kbd{vc-region-history}, which shows a @file{*VC-history*} buffer with -the history of changes to the region of the current file between point -and the mark (@pxref{Mark}). The history of changes includes the -commit log messages and also the changes themselves in the Diff -format. +@kbd{vc-region-history} (by default bound to @kbd{C-x v h}), which shows +a @file{*VC-history*} buffer with the history of changes to the region +of the current file between point and the mark (@pxref{Mark}). The +history of changes includes the commit log messages and also the +changes themselves in the Diff format. Invoke this command after marking the region of the current file in whose changes you are interested. In the @file{*VC-history*} buffer diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index 58e4de027c..00498399c7 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -238,20 +238,19 @@ is one, to determine the file version, since it is often more reliable than the RCS master file. To inhibit using the version header this way, change the variable @code{vc-consult-headers} to @code{nil}. -@kindex C-x v h @findex vc-insert-headers @vindex vc-@var{backend}-header - To insert a suitable header string into the current buffer, type -@kbd{C-x v h} (@code{vc-insert-headers}). This command works only on + To insert a suitable header string into the current buffer, use the +command @kbd{M-x vc-insert-headers}. This command works only on Subversion, CVS, RCS, and SCCS@. The variable @code{vc-@var{backend}-header} contains the list of keywords to insert into the version header; for instance, CVS uses @code{vc-cvs-header}, whose default value is @code{'("\$Id\$")}. (The extra backslashes prevent the string constant from being interpreted as a header, if the Emacs Lisp file defining it is maintained with version control.) The -@kbd{C-x v h} command inserts each keyword in the list on a new line -at point, surrounded by tabs, and inside comment delimiters if -necessary. +@code{vc-insert-headers} command inserts each keyword in the list on a +new line at point, surrounded by tabs, and inside comment delimiters +if necessary. @vindex vc-static-header-alist The variable @code{vc-static-header-alist} specifies further strings diff --git a/etc/NEWS b/etc/NEWS index adeee9e6ef..2216cfc18e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1115,6 +1115,10 @@ See the 'vc-faces' customization group. *** 'vc-dir-mode' now binds 'vc-log-outgoing' to 'O'; and has various branch-related commands on a keymap bound to 'B'. +--- +*** 'vc-region-history' is now bound to 'C-x v h', replacing the older +'vc-insert-headers' binding. + ** CC mode --- diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index 4c94280faf..99c8211ad5 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -882,7 +882,7 @@ In the latter case, VC mode is deactivated for this buffer." (define-key map "d" 'vc-dir) (define-key map "g" 'vc-annotate) (define-key map "G" 'vc-ignore) - (define-key map "h" 'vc-insert-headers) + (define-key map "h" 'vc-region-history) (define-key map "i" 'vc-register) (define-key map "l" 'vc-print-log) (define-key map "L" 'vc-print-root-log) commit f17289459527da254d02e516e944c89d3c505377 Author: Allen Li Date: Sat Sep 30 16:46:48 2017 +0300 Exit macro definition on undefined keys * lisp/subr.el (undefined): Error out of kmacro definition, if any. (Bug#28008) Copyright-paperwork-exempt: yes diff --git a/lisp/subr.el b/lisp/subr.el index cf15ec287f..64479a4b5b 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -785,8 +785,9 @@ This is the same format used for saving keyboard macros (see "Beep to tell the user this binding is undefined." (interactive) (ding) - (message "%s is undefined" (key-description (this-single-command-keys))) - (setq defining-kbd-macro nil) + (if defining-kbd-macro + (error "%s is undefined" (key-description (this-single-command-keys))) + (message "%s is undefined" (key-description (this-single-command-keys)))) (force-mode-line-update) ;; If this is a down-mouse event, don't reset prefix-arg; ;; pass it to the command run by the up event. commit 289fe6c0d1173051a04692948cd87aea2ae929c5 Author: Tim Landscheidt Date: Sat Sep 30 16:39:36 2017 +0300 Reset bidi-paragraph-direction on article rendering * lisp/gnus/gnus-art.el (gnus-request-article-this-buffer): Reset bidi-paragraph-direction on article rendering. (Bug#28454) Copyright-paperwork-exempt: yes diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 986bb47337..c130dc1b6c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -6984,6 +6984,7 @@ If given a prefix, show the hidden text instead." (save-excursion (erase-buffer) (gnus-kill-all-overlays) + (setq bidi-paragraph-direction nil) (setq group (or group gnus-newsgroup-name)) ;; Using `gnus-request-article' directly will insert the article into @@ -7091,6 +7092,7 @@ If given a prefix, show the hidden text instead." (while (not result) (erase-buffer) (gnus-kill-all-overlays) + (setq bidi-paragraph-direction nil) (let ((gnus-newsgroup-name group)) (gnus-check-group-server)) (cond commit a4f75188173e7ce1ab4b3c11ba091f20af69d995 Author: Eli Zaretskii Date: Sat Sep 30 16:33:30 2017 +0300 Fix url-http use of url-current-object * lisp/url/url-http.el (url-http): Bind url-current-object before calling url-http-find-free-connection. (Bug#28515) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 9e8c58b1cd..51f158e5c2 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1249,6 +1249,9 @@ The return value of this function is the retrieval buffer." (nsm-noninteractive (or url-request-noninteractive (and (boundp 'url-http-noninteractive) url-http-noninteractive))) + ;; The following binding is needed in url-open-stream, which + ;; is called from url-http-find-free-connection. + (url-current-object url) (connection (url-http-find-free-connection (url-host url) (url-port url) gateway-method)) commit 4a755ed42158b6a165bfd689e2d974d0ccda7530 Author: Andy Moreton Date: Sat Sep 30 16:21:39 2017 +0300 Avoid assertions in vc-hg.el on MS-Windows * lisp/vc/vc-hg.el (vc-hg--pcre-to-elisp-re) (vc-hg--slurp-hgignore, vc-hg--read-repo-requirements) (vc-hg-state-fast): Use file-name-absolute-p and directory-name-p instead of relying on Unix file-name syntax. This avoids assertion violations on MS-Windows. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 7a04a54377..99c8869ae0 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -687,7 +687,8 @@ PREFIX is the directory name of the directory against which these patterns are rooted. We understand only a subset of PCRE syntax; if we don't understand a construct, we signal `vc-hg-unsupported-syntax'." - (cl-assert (string-match "^/\\(.*/\\)?$" prefix)) + (cl-assert (and (file-name-absolute-p prefix) + (directory-name-p prefix))) (let ((parts nil) (i 0) (anchored nil) @@ -875,7 +876,8 @@ if we don't understand a construct, we signal (defun vc-hg--slurp-hgignore (repo) "Read hg ignore patterns from REPO. REPO must be the directory name of an hg repository." - (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (cl-assert (and (file-name-absolute-p repo) + (directory-name-p repo))) (let* ((hgignore (concat repo ".hgignore")) (vc-hg--hgignore-patterns nil) (vc-hg--hgignore-filenames nil)) @@ -930,7 +932,8 @@ FILENAME must be the file's true absolute name." (concat repo repo-relative-filename)))) (defun vc-hg--read-repo-requirements (repo) - (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (cl-assert (and (file-name-absolute-p repo) + (directory-name-p repo))) (let* ((requires-filename (concat repo ".hg/requires"))) (and (file-exists-p requires-filename) (with-temp-buffer @@ -1001,7 +1004,8 @@ hg binary." ;; dirstate must exist (not (progn (setf repo (expand-file-name repo)) - (cl-assert (string-match "^/\\(.*/\\)?$" repo)) + (cl-assert (and (file-name-absolute-p repo) + (directory-name-p repo))) (setf dirstate (concat repo ".hg/dirstate")) (setf dirstate-attr (file-attributes dirstate)))) ;; Repository must be in an understood format commit cb93a6ce72c5d238c6f120192aaba1554363dfe9 Author: Eli Zaretskii Date: Sat Sep 30 16:01:00 2017 +0300 Improve documentation of 'copy-sequence' * src/fns.c (Fcopy_sequence): * doc/lispref/sequences.texi (Sequence Functions): Mention the exception when copying an empty sequence. (Bug#28627) diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi index c7cf9f5e1a..5ae1567c12 100644 --- a/doc/lispref/sequences.texi +++ b/doc/lispref/sequences.texi @@ -155,7 +155,10 @@ This function generalizes @code{aref} (@pxref{Array Functions}) and @cindex copying sequences This function returns a copy of @var{seqr}, which should be either a sequence or a record. The copy is the same type of object as the -original, and it has the same elements in the same order. +original, and it has the same elements in the same order. However, if +@var{seqr} is empty, like a string or a vector of zero length, the +value returned by this function might not be a copy, but an empty +object of the same type and identical to @var{seqr}. Storing a new element into the copy does not affect the original @var{seqr}, and vice versa. However, the elements of the copy diff --git a/src/fns.c b/src/fns.c index 4524ff9b26..2311a6e041 100644 --- a/src/fns.c +++ b/src/fns.c @@ -482,7 +482,9 @@ usage: (vconcat &rest SEQUENCES) */) DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0, doc: /* Return a copy of a list, vector, string, char-table or record. The elements of a list, vector or record are not copied; they are -shared with the original. */) +shared with the original. +If the original sequence is empty, this function may return +the same empty object instead of its copy. */) (Lisp_Object arg) { if (NILP (arg)) return arg; commit 200ef6f7213bdd1db314ae3cf66fab6d5caaf1e6 Author: Eli Zaretskii Date: Sat Sep 30 15:29:28 2017 +0300 Minor update of ack.texi * doc/emacs/ack.texi (Acknowledgments): Update Eli Zaretskii's contributions. diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index 733106b740..7d8549c918 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -1418,8 +1418,8 @@ zone out in front of Emacs. Eli Zaretskii made many standard Emacs features work on MS-DOS and Microsoft Windows. He also wrote @file{tty-colors.el}, which implements transparent mapping of X colors to tty colors; and -@file{rxvt.el}. He implemented support for bidirectional text, -and also menus on text-mode terminals. +@file{rxvt.el}. He implemented support for bidirectional text, menus +on text-mode terminals, and built-in display of line numbers. @item Jamie Zawinski wrote much of the support for faces and X selections. commit cb407d3e8792220227139ccb794ef0ae5ac03fe2 Author: N. Jackson Date: Sat Sep 30 15:28:06 2017 +0300 * doc/emacs/emacs.texi (Acknowledgments): Add more contributors. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index 1b9a8b39a4..ef70d58643 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -1401,8 +1401,8 @@ Thomas Bellman, Scott Bender, Boaz Ben-Zvi, Sergey Berezin, Stephen Berman, Karl Berry, Anna M. Bigatti, Ray Blaak, Martin Blais, Jim Blandy, Johan Bockgård, Jan Böcker, Joel Boehland, Lennart Borgman, Per Bothner, Terrence Brannon, Frank Bresz, Peter Breton, Emmanuel Briot, Kevin -Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Stefan Bruda, -Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl, +Broadey, Vincent Broman, Michael Brouwer, David M. Brown, Ken Brown, Stefan Bruda, +Georges Brun-Cottan, Joe Buehler, Scott Byer, Włodek Bzyl, Tino Calancha, Bill Carpenter, Per Cederqvist, Hans Chalupsky, Chris Chase, Bob Chassell, Andrew Choi, Chong Yidong, Sacha Chua, Stewart Clamen, James Clark, Mike Clarkson, Glynn Clements, Andrew Cohen, Daniel Colascione, @@ -1444,7 +1444,7 @@ Limpach, Lars Lindberg, Chris Lindblad, Anders Lindgren, Thomas Link, Juri Linkov, Francis Litterio, Sergey Litvinov, Leo Liu, Emilio C. Lopes, Martin Lorentzon, Dave Love, Eric Ludlam, Károly Lőrentey, Sascha Lüdecke, Greg McGary, Roland McGrath, Michael McNamara, Alan Mackenzie, -Christopher J. Madsen, Neil M. Mager, Ken Manheimer, Bill Mann, +Christopher J. Madsen, Neil M. Mager, Artur Malabarba, Ken Manheimer, Bill Mann, Brian Marick, Simon Marshall, Bengt Martensson, Charlie Martin, Yukihiro Matsumoto, Tomohiro Matsuyama, David Maus, Thomas May, Will Mengarini, David Megginson, Stefan Merten, Ben A. Mesander, Wayne Mesard, Brad @@ -1455,11 +1455,11 @@ Gergely Nagy, Nobuyoshi Nakada, Thomas Neumann, Mike Newton, Thien-Thi Nguyen, Jurgen Nickelsen, Dan Nicolaescu, Hrvoje Nikšić, Jeff Norden, Andrew Norman, Theresa O'Connor, Kentaro Ohkouchi, Christian Ohler, Kenichi Okada, Alexandre Oliva, Bob Olson, Michael Olson, Takaaki Ota, -Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar, +Mark Oteiza, Pieter E. J. Pareit, Ross Patterson, David Pearson, Juan Pechiar, Jeff Peck, Damon Anton Permezel, Tom Perrine, William M. Perry, Per -Persson, Jens Petersen, Daniel Pfeiffer, Justus Piater, Richard L. +Persson, Jens Petersen, Nicolas Petton, Daniel Pfeiffer, Justus Piater, Richard L. Pieri, Fred Pierresteguy, François Pinard, Daniel Pittman, Christian -Plaunt, Alexander Pohoyda, David Ponce, Francesco A. Potortì, +Plaunt, Alexander Pohoyda, David Ponce, Noam Postavsky, Francesco A. Potortì, Michael D. Prange, Mukesh Prasad, Ken Raeburn, Marko Rahamaa, Ashwin Ram, Eric S. Raymond, Paul Reilly, Edward M. Reingold, David Reitter, Alex Rezinsky, Rob Riepel, Lara Rios, Adrian Robert, Nick @@ -1476,7 +1476,7 @@ Stanislav Shalunov, Marc Shapiro, Richard Sharman, Olin Shivers, Tibor Šimko, Espen Skoglund, Rick Sladkey, Lynn Slater, Chris Smith, David Smith, Paul D. Smith, Wilson Snyder, William Sommerfeld, Simon South, Andre Spiegel, Michael Staats, Thomas Steffen, Ulf Stegemann, -Reiner Steib, Sam Steingold, Ake Stenhoff, Peter Stephenson, Ken +Reiner Steib, Sam Steingold, Ake Stenhoff, Philipp Stephani, Peter Stephenson, Ken Stevens, Andy Stewart, Jonathan Stigelman, Martin Stjernholm, Kim F. Storm, Steve Strassmann, Christopher Suckling, Olaf Sylvester, Naoto Takahashi, Steven Tamm, Jan Tatarik, Luc Teirlinck, Jean-Philippe Theberge, Jens commit 82b6c765ffa18f4e3892b860eb77a9ea24430bbb Author: Eli Zaretskii Date: Sat Sep 30 15:08:47 2017 +0300 Improve indexing of multi-file/buffer Isearch commands * doc/emacs/maintaining.texi (Identifier Search): Change wording of index entries to make them different from those for multi-file isearch commands. (Bug#28584) * doc/emacs/search.texi (Other Repeating Search): Index the multi-* commands. (Bug#28584) Rearrange the indexing to keep each index entry close to its subject. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 39b7144594..7f91991daa 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1918,8 +1918,8 @@ without displaying the references. @node Identifier Search @subsubsection Searching and Replacing with Identifiers -@cindex search and replace in multiple files -@cindex multiple-file search and replace +@cindex search and replace in multiple source files +@cindex multiple source file search and replace The commands in this section perform various search and replace operations either on identifiers themselves or on files that reference diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 9f7e9a12cd..63cc1c2437 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1685,15 +1685,10 @@ Aside from @code{multi-occur} and @code{multi-occur-in-matching-buffers}, which always search the whole buffer, all operate on the text from point to the end of the buffer, or on the region if it is active. -@findex list-matching-lines -@findex occur -@findex multi-occur -@findex multi-occur-in-matching-buffers -@findex how-many -@findex flush-lines -@findex keep-lines - @table @kbd +@findex multi-isearch-buffers +@cindex isearch multiple buffers +@cindex multiple-buffer isearch @item M-x multi-isearch-buffers Prompt for one or more buffer names, ending with @key{RET}; then, begin a multi-buffer incremental search in those buffers. (If the @@ -1702,10 +1697,14 @@ next specified buffer, and so forth.) With a prefix argument, prompt for a regexp and begin a multi-buffer incremental search in buffers matching that regexp. +@findex multi-isearch-buffers-regexp @item M-x multi-isearch-buffers-regexp This command is just like @code{multi-isearch-buffers}, except it performs an incremental regexp search. +@findex multi-isearch-files +@cindex isearch multiple files +@cindex multiple-file isearch @item M-x multi-isearch-files Prompt for one or more file names, ending with @key{RET}; then, begin a multi-file incremental search in those files. (If the @@ -1714,6 +1713,7 @@ next specified file, and so forth.) With a prefix argument, prompt for a regexp and begin a multi-file incremental search in files matching that regexp. +@findex multi-isearch-files-regexp @item M-x multi-isearch-files-regexp This command is just like @code{multi-isearch-files}, except it performs an incremental regexp search. @@ -1729,6 +1729,7 @@ a multi-file incremental search is activated automatically. @vindex list-matching-lines-jump-to-current-line @cindex list-matching-lines-current-line-face (face name) @kindex M-s o +@findex occur @item M-x occur @itemx M-s o Prompt for a regexp, and display a list showing each line in the @@ -1768,25 +1769,30 @@ mode, in which edits made to the entries are also applied to the text in the originating buffer. Type @kbd{C-c C-c} to return to Occur mode. +@findex list-matching-lines The command @kbd{M-x list-matching-lines} is a synonym for @kbd{M-x occur}. +@findex multi-occur @item M-x multi-occur This command is just like @code{occur}, except it is able to search through multiple buffers. It asks you to specify the buffer names one by one. +@findex multi-occur-in-matching-buffers @item M-x multi-occur-in-matching-buffers This command is similar to @code{multi-occur}, except the buffers to search are specified by a regular expression that matches visited file names. With a prefix argument, it uses the regular expression to match buffer names instead. +@findex how-many @item M-x how-many Prompt for a regexp, and print the number of matches for it in the buffer after point. If the region is active, this operates on the region instead. +@findex flush-lines @item M-x flush-lines Prompt for a regexp, and delete each line that contains a match for it, operating on the text after point. This command deletes the @@ -1800,6 +1806,7 @@ lines. It deletes the lines before starting to look for the next match; hence, it ignores a match starting on the same line at which another match ended. +@findex keep-lines @item M-x keep-lines Prompt for a regexp, and delete each line that @emph{does not} contain a match for it, operating on the text after point. If point is not at commit 645ff6c7029daef082b3a558407121207fa64ff5 Author: Mark Oteiza Date: Tue Sep 26 17:13:36 2017 -0400 Add CAM02 JCh and CAM02-UCS J'a'b' conversions * src/lcms.c (rad2deg, parse_jch_list, parse_jab_list, xyz_to_jch): (jch_to_xyz, jch_to_jab, jab_to_jch): New functions. (lcms-jch->xyz, lcms-jch->xyz, lcms-jch->jab, lcms-jab->jch): New Lisp functions. (lcms-cam02-ucs): Refactor. (syms_of_lcms2): Declare new functions. * test/src/lcms-tests.el (lcms-roundtrip, lcms-ciecam02-gold): (lcms-jmh->cam02-ucs-silver): New tests. * etc/NEWS: Mention new functions. diff --git a/etc/NEWS b/etc/NEWS index ab9a2a5f32..adeee9e6ef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -76,7 +76,8 @@ If the lcms2 library is installed, Emacs will enable features built on top of that library. The new configure option '--without-lcms2' can be used to build without lcms2 support even if it is installed. Emacs linked to Little CMS exposes color management functions in Lisp: the -color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs'. +color metrics 'lcms-cie-de2000' and 'lcms-cam02-ucs', as well as +functions for conversion to and from CIE CAM02 and CAM02-UCS. ** The configure option '--with-gameuser' now defaults to 'no', as this appears to be the most common configuration in practice. diff --git a/src/lcms.c b/src/lcms.c index a5e527911e..c7da57658a 100644 --- a/src/lcms.c +++ b/src/lcms.c @@ -25,6 +25,13 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +typedef struct +{ + double J; + double a; + double b; +} lcmsJab_t; + #ifdef WINDOWSNT # include # include "w32.h" @@ -36,6 +43,8 @@ DEF_DLL_FN (cmsHANDLE, cmsCIECAM02Init, (cmsContext ContextID, const cmsViewingConditions* pVC)); DEF_DLL_FN (void, cmsCIECAM02Forward, (cmsHANDLE hModel, const cmsCIEXYZ* pIn, cmsJCh* pOut)); +DEF_DLL_FN (void, cmsCIECAM02Reverse, + (cmsHANDLE hModel, const cmsJCh* pIn, cmsCIEXYZ* pOut)); DEF_DLL_FN (void, cmsCIECAM02Done, (cmsHANDLE hModel)); DEF_DLL_FN (cmsBool, cmsWhitePointFromTemp, (cmsCIExyY* WhitePoint, cmsFloat64Number TempK)); @@ -54,6 +63,7 @@ init_lcms_functions (void) LOAD_DLL_FN (library, cmsCIE2000DeltaE); LOAD_DLL_FN (library, cmsCIECAM02Init); LOAD_DLL_FN (library, cmsCIECAM02Forward); + LOAD_DLL_FN (library, cmsCIECAM02Reverse); LOAD_DLL_FN (library, cmsCIECAM02Done); LOAD_DLL_FN (library, cmsWhitePointFromTemp); LOAD_DLL_FN (library, cmsxyY2XYZ); @@ -63,6 +73,7 @@ init_lcms_functions (void) # undef cmsCIE2000DeltaE # undef cmsCIECAM02Init # undef cmsCIECAM02Forward +# undef cmsCIECAM02Reverse # undef cmsCIECAM02Done # undef cmsWhitePointFromTemp # undef cmsxyY2XYZ @@ -70,6 +81,7 @@ init_lcms_functions (void) # define cmsCIE2000DeltaE fn_cmsCIE2000DeltaE # define cmsCIECAM02Init fn_cmsCIECAM02Init # define cmsCIECAM02Forward fn_cmsCIECAM02Forward +# define cmsCIECAM02Reverse fn_cmsCIECAM02Reverse # define cmsCIECAM02Done fn_cmsCIECAM02Done # define cmsWhitePointFromTemp fn_cmsWhitePointFromTemp # define cmsxyY2XYZ fn_cmsxyY2XYZ @@ -145,6 +157,12 @@ deg2rad (double degrees) return M_PI * degrees / 180.0; } +static double +rad2deg (double radians) +{ + return 180.0 * radians / M_PI; +} + static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 }; static void @@ -180,6 +198,46 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) return true; } +static bool +parse_jch_list (Lisp_Object jch_list, cmsJCh *color) +{ +#define PARSE_JCH_LIST_FIELD(field) \ + if (CONSP (jch_list) && NUMBERP (XCAR (jch_list))) \ + { \ + color->field = XFLOATINT (XCAR (jch_list)); \ + jch_list = XCDR (jch_list); \ + } \ + else \ + return false; + + PARSE_JCH_LIST_FIELD (J); + PARSE_JCH_LIST_FIELD (C); + PARSE_JCH_LIST_FIELD (h); + + if (! NILP (jch_list)) + return false; + return true; +} + +static bool +parse_jab_list (Lisp_Object jab_list, lcmsJab_t *color) +{ +#define PARSE_JAB_LIST_FIELD(field) \ + if (CONSP (jab_list) && NUMBERP (XCAR (jab_list))) \ + { \ + color->field = XFLOATINT (XCAR (jab_list)); \ + jab_list = XCDR (jab_list); \ + } \ + else \ + return false; + + PARSE_JAB_LIST_FIELD (J); + PARSE_JAB_LIST_FIELD (a); + PARSE_JAB_LIST_FIELD (b); + + return true; +} + static bool parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, cmsViewingConditions *vc) @@ -216,6 +274,204 @@ parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp, return true; } +static void +xyz_to_jch (const cmsCIEXYZ *xyz, cmsJCh *jch, const cmsViewingConditions *vc) +{ + cmsHANDLE h; + + h = cmsCIECAM02Init (0, vc); + cmsCIECAM02Forward (h, xyz, jch); + cmsCIECAM02Done (h); +} + +static void +jch_to_xyz (const cmsJCh *jch, cmsCIEXYZ *xyz, const cmsViewingConditions *vc) +{ + cmsHANDLE h; + + h = cmsCIECAM02Init (0, vc); + cmsCIECAM02Reverse (h, jch, xyz); + cmsCIECAM02Done (h); +} + +static void +jch_to_jab (const cmsJCh *jch, lcmsJab_t *jab, double FL, double c1, double c2) +{ + double Mp = 43.86 * log (1.0 + c2 * (jch->C * sqrt (sqrt (FL)))); + jab->J = 1.7 * jch->J / (1.0 + (c1 * jch->J)); + jab->a = Mp * cos (deg2rad (jch->h)); + jab->b = Mp * sin (deg2rad (jch->h)); +} + +static void +jab_to_jch (const lcmsJab_t *jab, cmsJCh *jch, double FL, double c1, double c2) +{ + jch->J = jab->J / (1.0 + c1 * (100.0 - jab->J)); + jch->h = atan2 (jab->b, jab->a); + double Mp = hypot (jab->a, jab->b); + jch->h = rad2deg (jch->h); + if (jch->h < 0.0) + jch->h += 360.0; + jch->C = (exp (c2 * Mp) - 1.0) / (c2 * sqrt (sqrt (FL))); +} + +DEFUN ("lcms-xyz->jch", Flcms_xyz_to_jch, Slcms_xyz_to_jch, 1, 3, 0, + doc: /* Convert CIE CAM02 JCh to CIE XYZ. +COLOR is a list (X Y Z), with Y scaled about unity. +Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', +which see. */) + (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view) +{ + cmsViewingConditions vc; + cmsJCh jch; + cmsCIEXYZ xyz, xyzw; + +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + + if (!(CONSP (color) && parse_xyz_list (color, &xyz))) + signal_error ("Invalid color", color); + if (NILP (whitepoint)) + xyzw = illuminant_d65; + else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) + signal_error ("Invalid white point", whitepoint); + if (NILP (view)) + default_viewing_conditions (&xyzw, &vc); + else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) + signal_error ("Invalid viewing conditions", view); + + xyz_to_jch(&xyz, &jch, &vc); + return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h)); +} + +DEFUN ("lcms-jch->xyz", Flcms_jch_to_xyz, Slcms_jch_to_xyz, 1, 3, 0, + doc: /* Convert CIE XYZ to CIE CAM02 JCh. +COLOR is a list (J C h), where lightness of white is equal to 100, and hue +is given in degrees. +Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', +which see. */) + (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view) +{ + cmsViewingConditions vc; + cmsJCh jch; + cmsCIEXYZ xyz, xyzw; + +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + + if (!(CONSP (color) && parse_jch_list (color, &jch))) + signal_error ("Invalid color", color); + if (NILP (whitepoint)) + xyzw = illuminant_d65; + else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) + signal_error ("Invalid white point", whitepoint); + if (NILP (view)) + default_viewing_conditions (&xyzw, &vc); + else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) + signal_error ("Invalid viewing conditions", view); + + jch_to_xyz(&jch, &xyz, &vc); + return list3 (make_float (xyz.X / 100.0), + make_float (xyz.Y / 100.0), + make_float (xyz.Z / 100.0)); +} + +DEFUN ("lcms-jch->jab", Flcms_jch_to_jab, Slcms_jch_to_jab, 1, 3, 0, + doc: /* Convert CIE CAM02 JCh to CAM02-UCS J'a'b'. +COLOR is a list (J C h) as described in `lcms-jch->xyz', which see. +Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', +which see. */) + (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view) +{ + cmsViewingConditions vc; + lcmsJab_t jab; + cmsJCh jch; + cmsCIEXYZ xyzw; + double FL, k, k4; + +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + + if (!(CONSP (color) && parse_jch_list (color, &jch))) + signal_error ("Invalid color", color); + if (NILP (whitepoint)) + xyzw = illuminant_d65; + else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) + signal_error ("Invalid white point", whitepoint); + if (NILP (view)) + default_viewing_conditions (&xyzw, &vc); + else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) + signal_error ("Invalid viewing conditions", view); + + k = 1.0 / (1.0 + (5.0 * vc.La)); + k4 = k * k * k * k; + FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La); + jch_to_jab (&jch, &jab, FL, 0.007, 0.0228); + return list3 (make_float (jab.J), make_float (jab.a), make_float (jab.b)); +} + +DEFUN ("lcms-jab->jch", Flcms_jab_to_jch, Slcms_jab_to_jch, 1, 3, 0, + doc: /* Convert CAM02-UCS J'a'b' to CIE CAM02 JCh. +COLOR is a list (J' a' b'), where white corresponds to lightness J equal to 100. +Optional arguments WHITEPOINT and VIEW are the same as in `lcms-cam02-ucs', +which see. */) + (Lisp_Object color, Lisp_Object whitepoint, Lisp_Object view) +{ + cmsViewingConditions vc; + cmsJCh jch; + lcmsJab_t jab; + cmsCIEXYZ xyzw; + double FL, k, k4; + +#ifdef WINDOWSNT + if (!lcms_initialized) + lcms_initialized = init_lcms_functions (); + if (!lcms_initialized) + { + message1 ("lcms2 library not found"); + return Qnil; + } +#endif + + if (!(CONSP (color) && parse_jab_list (color, &jab))) + signal_error ("Invalid color", color); + if (NILP (whitepoint)) + xyzw = illuminant_d65; + else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) + signal_error ("Invalid white point", whitepoint); + if (NILP (view)) + default_viewing_conditions (&xyzw, &vc); + else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) + signal_error ("Invalid viewing conditions", view); + + k = 1.0 / (1.0 + (5.0 * vc.La)); + k4 = k * k * k * k; + FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La); + jab_to_jch (&jab, &jch, FL, 0.007, 0.0228); + return list3 (make_float (jch.J), make_float (jch.C), make_float (jch.h)); +} + /* References: Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research and application, 37 No.3, 2012. @@ -239,10 +495,9 @@ The default viewing conditions are (20 100 1 1). */) { cmsViewingConditions vc; cmsJCh jch1, jch2; - cmsHANDLE h1, h2; cmsCIEXYZ xyz1, xyz2, xyzw; - double Jp1, ap1, bp1, Jp2, ap2, bp2; - double Mp1, Mp2, FL, k, k4; + lcmsJab_t jab1, jab2; + double FL, k, k4; #ifdef WINDOWSNT if (!lcms_initialized) @@ -267,41 +522,17 @@ The default viewing conditions are (20 100 1 1). */) else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc))) signal_error ("Invalid view conditions", view); - h1 = cmsCIECAM02Init (0, &vc); - h2 = cmsCIECAM02Init (0, &vc); - cmsCIECAM02Forward (h1, &xyz1, &jch1); - cmsCIECAM02Forward (h2, &xyz2, &jch2); - cmsCIECAM02Done (h1); - cmsCIECAM02Done (h2); + xyz_to_jch (&xyz1, &jch1, &vc); + xyz_to_jch (&xyz2, &jch2, &vc); - /* Now have colors in JCh, need to calculate J'a'b' - - M = C * F_L^0.25 - J' = 1.7 J / (1 + 0.007 J) - M' = 43.86 ln(1 + 0.0228 M) - a' = M' cos(h) - b' = M' sin(h) - - where - - F_L = 0.2 k^4 (5 L_A) + 0.1 (1 - k^4)^2 (5 L_A)^(1/3), - k = 1/(5 L_A + 1) - */ k = 1.0 / (1.0 + (5.0 * vc.La)); k4 = k * k * k * k; FL = vc.La * k4 + 0.1 * (1 - k4) * (1 - k4) * cbrt (5.0 * vc.La); - Mp1 = 43.86 * log (1.0 + 0.0228 * (jch1.C * sqrt (sqrt (FL)))); - Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL)))); - Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J)); - Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J)); - ap1 = Mp1 * cos (deg2rad (jch1.h)); - ap2 = Mp2 * cos (deg2rad (jch2.h)); - bp1 = Mp1 * sin (deg2rad (jch1.h)); - bp2 = Mp2 * sin (deg2rad (jch2.h)); - - return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) + - (ap2 - ap1) * (ap2 - ap1) + - (bp2 - bp1) * (bp2 - bp1))); + jch_to_jab (&jch1, &jab1, FL, 0.007, 0.0228); + jch_to_jab (&jch2, &jab2, FL, 0.007, 0.0228); + + return make_float (hypot (jab2.J - jab1.J, + hypot (jab2.a - jab1.a, jab2.b - jab1.b))); } DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, @@ -359,6 +590,10 @@ void syms_of_lcms2 (void) { defsubr (&Slcms_cie_de2000); + defsubr (&Slcms_xyz_to_jch); + defsubr (&Slcms_jch_to_xyz); + defsubr (&Slcms_jch_to_jab); + defsubr (&Slcms_jab_to_jch); defsubr (&Slcms_cam02_ucs); defsubr (&Slcms2_available_p); defsubr (&Slcms_temp_to_white_point); diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index d6d1d16b9a..cc324af68b 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -94,6 +94,38 @@ B is considered the exact value." (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504)) '(0.29902 0.31485 1.0)))) +(ert-deftest lcms-roundtrip () + "Test accuracy of converting to and from different color spaces" + (skip-unless (featurep 'lcms2)) + (should + (let ((color '(.5 .3 .7))) + (lcms-triple-approx-p (lcms-jch->xyz (lcms-xyz->jch color)) + color + 0.0001))) + (should + (let ((color '(.8 -.2 .2))) + (lcms-triple-approx-p (lcms-jch->jab (lcms-jab->jch color)) + color + 0.0001)))) + +(ert-deftest lcms-ciecam02-gold () + "Test CIE CAM02 JCh gold values" + (skip-unless (featurep 'lcms2)) + (should + (lcms-triple-approx-p + (lcms-xyz->jch '(0.1931 0.2393 0.1014) + '(0.9888 0.900 0.3203) + '(18 200 1 1.0)) + '(48.0314 38.7789 191.0452) + 0.02)) + (should + (lcms-triple-approx-p + (lcms-xyz->jch '(0.1931 0.2393 0.1014) + '(0.9888 0.90 0.3203) + '(18 20 1 1.0)) + '(47.6856 36.0527 185.3445) + 0.09))) + (ert-deftest lcms-dE-cam02-ucs-silver () "Test CRI-CAM02-UCS deltaE metric values from colorspacious." (skip-unless (featurep 'lcms2)) @@ -114,4 +146,16 @@ B is considered the exact value." 8.503323264883667 0.04))) +(ert-deftest lcms-jmh->cam02-ucs-silver () + "Compare JCh conversion to CAM02-UCS to values from colorspacious." + (skip-unless (featurep 'lcms2)) + (should + (lcms-triple-approx-p (lcms-jch->jab '(50 20 10)) + '(62.96296296 16.22742674 2.86133316) + 0.05)) + (should + (lcms-triple-approx-p (lcms-jch->jab '(10 60 100)) + '(15.88785047 -6.56546789 37.23461867) + 0.04))) + ;;; lcms-tests.el ends here commit 157007b58e41afc848f79c99aced0f09109dfdac Author: Eli Zaretskii Date: Sat Sep 30 11:27:29 2017 +0300 Fix uses of @kindex in the Emacs manual * doc/emacs/programs.texi (Expressions, Semantic, Hungry Delete): * doc/emacs/mark.texi (Global Mark Ring) (Disabled Transient Mark): * doc/emacs/buffers.texi (Select Buffer): * doc/emacs/mule.texi (File Name Coding): Fix @kindex entries which used @key. Reported by Marcin Borkowski . diff --git a/doc/emacs/buffers.texi b/doc/emacs/buffers.texi index f3a3c8ef25..a8b810ef91 100644 --- a/doc/emacs/buffers.texi +++ b/doc/emacs/buffers.texi @@ -110,8 +110,8 @@ it, Emacs asks for the file name to use, and the buffer's major mode is re-established taking that file name into account (@pxref{Choosing Modes}). -@kindex C-x @key{LEFT} -@kindex C-x @key{RIGHT} +@kindex C-x LEFT +@kindex C-x RIGHT @findex next-buffer @findex previous-buffer For conveniently switching between a few buffers, use the commands diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index 1e160508e5..eb93570600 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -367,7 +367,7 @@ of buffers that you have been in, and, for each buffer, a place where you set the mark. The length of the global mark ring is controlled by @code{global-mark-ring-max}, and is 16 by default. -@kindex C-x C-@key{SPC} +@kindex C-x C-SPC @findex pop-global-mark The command @kbd{C-x C-@key{SPC}} (@code{pop-global-mark}) jumps to the buffer and position of the latest entry in the global ring. It also @@ -449,7 +449,7 @@ using @kbd{C-@key{SPC} C-@key{SPC}} or @kbd{C-u C-x C-x}. @table @kbd @item C-@key{SPC} C-@key{SPC} -@kindex C-@key{SPC} C-@key{SPC} +@kindex C-SPC C-SPC Set the mark at point (like plain @kbd{C-@key{SPC}}) and enable Transient Mark mode just once, until the mark is deactivated. (This is not really a separate command; you are using the @kbd{C-@key{SPC}} diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 2f27b9aa0e..2862832e72 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1198,7 +1198,7 @@ names (@code{set-file-name-coding-system}). @end table @findex set-file-name-coding-system -@kindex C-x @key{RET} F +@kindex C-x RET F @cindex file names with non-@acronym{ASCII} characters The command @kbd{C-x @key{RET} F} (@code{set-file-name-coding-system}) specifies a coding system to use for encoding file @emph{names}. It diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index 27ac0eb640..2b0649cd92 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -712,7 +712,7 @@ before it. An argument of zero, rather than doing nothing, transposes the balanced expressions ending at or after point and the mark. @kindex C-M-@@ -@kindex C-M-@key{SPC} +@kindex C-M-SPC @findex mark-sexp To operate on balanced expressions with a command which acts on the region, type @kbd{C-M-@key{SPC}} (@code{mark-sexp}). This sets the @@ -1467,7 +1467,7 @@ Prompt for the name of a function defined in any file Emacs has parsed, and move point there (@code{semantic-complete-jump}). @item C-c , @key{SPC} -@kindex C-c , @key{SPC} +@kindex C-c , SPC Display a list of possible completions for the symbol at point (@code{semantic-complete-analyze-inline}). This also activates a set of special key bindings for choosing a completion: @key{RET} accepts @@ -1716,8 +1716,8 @@ preprocessor commands. @item C-c C-@key{DEL} @itemx C-c @key{DEL} @findex c-hungry-delete-backwards -@kindex C-c C-@key{DEL} (C Mode) -@kindex C-c @key{DEL} (C Mode) +@kindex C-c C-DEL (C Mode) +@kindex C-c DEL (C Mode) Delete the entire block of whitespace preceding point (@code{c-hungry-delete-backwards}). @item C-c C-d @@ -1725,8 +1725,8 @@ Delete the entire block of whitespace preceding point (@code{c-hungry-delete-bac @itemx C-c @key{Delete} @findex c-hungry-delete-forward @kindex C-c C-d (C Mode) -@kindex C-c C-@key{Delete} (C Mode) -@kindex C-c @key{Delete} (C Mode) +@kindex C-c C-Delete (C Mode) +@kindex C-c Delete (C Mode) Delete the entire block of whitespace after point (@code{c-hungry-delete-forward}). @end table commit 63a45e8837146636d7a6113955c8419980b0855b Merge: f428757cdb 3ab2f9bbb9 Author: Eli Zaretskii Date: Sat Sep 30 09:57:58 2017 +0300 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26 commit f428757cdb26cc3e47123e5c75bd689a14304997 Merge: 73dba0f466 26d58f0c58 Author: Eli Zaretskii Date: Fri Sep 29 22:03:30 2017 +0300 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emacs into emacs-26 commit 73dba0f4665768b0263050211b61fffbc2dab165 Author: Eli Zaretskii Date: Fri Sep 29 15:59:17 2017 +0300 Fix last doc string change in simple.el * lisp/simple.el (shell-command-saved-pos) (region-extract-function, region-bounds): Doc fixes. (Bug#28609) diff --git a/lisp/simple.el b/lisp/simple.el index 469557713d..767a3f041e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -53,8 +53,8 @@ restores the buffer position before the command." :version "26.1") (defvar shell-command-saved-pos nil - "Point position in the output buffer after command completes. -It is an alist of (BUFFER . POS), where BUFFER is the output + "Position of point in the output buffer after command completes. +It is a cons cell of the form (BUFFER . POS), where BUFFER is the output buffer, and POS is the point position in BUFFER once the command finishes. This variable is used when `shell-command-dont-erase-buffer' is non-nil.") @@ -1003,7 +1003,7 @@ Called with one argument METHOD. If METHOD is `delete-only', then delete the region; the return value is undefined. If METHOD is nil, then return the content as a string. If METHOD is `bounds', then return the boundaries of the region -as a list of pairs of (START . END) positions. +as a cons cell of the form (START . END). If METHOD is anything else, delete the region and return its content as a string, after filtering it with `filter-buffer-substring', which is called with METHOD as its 3rd argument.") @@ -5473,7 +5473,8 @@ also checks the value of `use-empty-active-region'." (progn (cl-assert (mark)) t))) (defun region-bounds () - "Return the boundaries of the region as a list of pairs of (START . END) positions." + "Return the boundaries of the region as a pair of positions. +Value is a cons cell of the form (START . END)." (funcall region-extract-function 'bounds)) (defun region-noncontiguous-p () commit 66b75d3f2002459edccd241af57c63b380b192d3 Author: Tino Calancha Date: Tue Aug 15 15:43:16 2017 +0900 archive-int-to-mode: Fix order of testing S_ISUID, S_ISGID bits * lisp/arc-mode.el (archive-int-to-mode): Swap order of 2048 and 1024 tests (Bug#28092). * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode): Update test. diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index bd7548b704..938c143b8e 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -559,13 +559,13 @@ FLOAT, if non-nil, means generate and return a float instead of an integer (if (zerop (logand 256 mode)) ?- ?r) (if (zerop (logand 128 mode)) ?- ?w) (if (zerop (logand 64 mode)) - (if (zerop (logand 1024 mode)) ?- ?S) - (if (zerop (logand 1024 mode)) ?x ?s)) + (if (zerop (logand 2048 mode)) ?- ?S) + (if (zerop (logand 2048 mode)) ?x ?s)) (if (zerop (logand 32 mode)) ?- ?r) (if (zerop (logand 16 mode)) ?- ?w) (if (zerop (logand 8 mode)) - (if (zerop (logand 2048 mode)) ?- ?S) - (if (zerop (logand 2048 mode)) ?x ?s)) + (if (zerop (logand 1024 mode)) ?- ?S) + (if (zerop (logand 1024 mode)) ?x ?s)) (if (zerop (logand 4 mode)) ?- ?r) (if (zerop (logand 2 mode)) ?- ?w) (if (zerop (logand 1 mode)) ?- ?x))) diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 04047bab62..8c8465d366 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -27,7 +27,8 @@ (cons 420 "-rw-r--r--") (cons 292 "-r--r--r--") (cons 512 "----------") - (cons 1024 "---S------")))) + (cons 1024 "------S---") ; Bug#28092 + (cons 2048 "---S------")))) (dolist (x alist) (should (equal (cdr x) (archive-int-to-mode (car x))))))) commit 97460582e2d0052f27d342ddb90309dc3da700b8 Author: Paul Eggert Date: Mon Aug 14 18:16:04 2017 -0700 Improve rename-file port to macOS * src/fileio.c (Frename_file): On macOS, renameat_noreplace can fail with errno == ENOTSUP on file systems where it is not supported, according to the Apple documentation. diff --git a/src/fileio.c b/src/fileio.c index 9f6de5b6ca..e557483ac4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2297,7 +2297,7 @@ This is what happens in interactive use with M-x. */) rename_errno = errno; switch (rename_errno) { - case EEXIST: case EINVAL: case ENOSYS: + case EEXIST: case EINVAL: case ENOSYS: case ENOTSUP: barf_or_query_if_file_exists (newname, rename_errno == EEXIST, "rename to it", INTEGERP (ok_if_already_exists), commit e88bbd22c5ffb1d6008c0c7e18a36043b0f397dd Author: Noam Postavsky Date: Sat Apr 8 20:58:20 2017 -0400 Speed up ./configure with more caching (Bug#27960) * configure.ac: Cache the 'GTK compiles', 'GSettings is in gio', 'LN_S', '-znocombreloc', 'sysinfo', 'gcc autodepends', '-b link', 'Xkb', 'Xpm preprocessor', 'tputs library' 'GLib', 'signals via characters', and 'Windows API header' checks. Remove pause after warning about GTK bug. diff --git a/configure.ac b/configure.ac index 86d5b3e94f..443344de4c 100644 --- a/configure.ac +++ b/configure.ac @@ -1137,36 +1137,31 @@ dnl hosted on AFS, both examples where simple links work, but links to dnl directories fail. We use a cut-down version instead. dnl AC_PROG_LN_S -AC_MSG_CHECKING([whether ln -s works for files in the same directory]) -rm -f conf$$ conf$$.file +AC_CACHE_CHECK([command to symlink files in the same directory], [emacs_cv_ln_s_fileonly], +[rm -f conf$$ conf$$.file -LN_S_FILEONLY='cp -p' +emacs_cv_ln_s_fileonly='cp -p' dnl On MinGW, ensure we will call the MSYS /bin/ln.exe, not some dnl random program in the current directory. if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then if test "$opsys" = "mingw32"; then - LN_S_FILEONLY='/bin/ln -s' + emacs_cv_ln_s_fileonly='/bin/ln -s' else - LN_S_FILEONLY='ln -s' + emacs_cv_ln_s_fileonly='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then if test "$opsys" = "mingw32"; then - LN_S_FILEONLY=/bin/ln + emacs_cv_ln_s_fileonly=/bin/ln else - LN_S_FILEONLY=ln + emacs_cv_ln_s_fileonly=ln fi fi fi -rm -f conf$$ conf$$.file - -if test "$LN_S_FILEONLY" = "ln -s"; then - AC_MSG_RESULT([yes]) -else - AC_MSG_RESULT([no, using $LN_S_FILEONLY]) -fi +rm -f conf$$ conf$$.file]) +LN_S_FILEONLY=$emacs_cv_ln_s_fileonly AC_SUBST(LN_S_FILEONLY) @@ -1322,22 +1317,25 @@ dnl http://bugs.debian.org/684788 dnl * unnecessary, since temacs is the only thing that actually needs it. dnl Indeed this is where it was originally, prior to: dnl http://lists.gnu.org/archive/html/emacs-pretest-bug/2004-03/msg00170.html -late_LDFLAGS="$LDFLAGS" if test x$GCC = xyes; then LDFLAGS_NOCOMBRELOC="-Wl,-znocombreloc" else LDFLAGS_NOCOMBRELOC="-znocombreloc" fi +AC_CACHE_CHECK([for -znocombreloc], [emacs_cv_znocombreloc], +[late_LDFLAGS="$LDFLAGS" LDFLAGS="$LDFLAGS $LDFLAGS_NOCOMBRELOC" -AC_MSG_CHECKING([for -znocombreloc]) AC_LINK_IFELSE([AC_LANG_PROGRAM([], [])], - [AC_MSG_RESULT(yes)], + [emacs_cv_znocombreloc=yes], [emacs_cv_znocombreloc=no]) + +LDFLAGS="$late_LDFLAGS"]) + +if test x$emacs_cv_znocombreloc = xno; then LDFLAGS_NOCOMBRELOC= - [AC_MSG_RESULT(no)]) +fi -LDFLAGS="$late_LDFLAGS" AC_CACHE_CHECK([whether addresses are sanitized], [emacs_cv_sanitize_address], @@ -1700,13 +1698,13 @@ fi # sysinfo as well. To make sure that we're using GNU/Linux # sysinfo, we explicitly set one of its fields. if test "$ac_cv_header_sys_sysinfo_h" = yes; then - AC_MSG_CHECKING([if Linux sysinfo may be used]) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], + AC_CACHE_CHECK([if Linux sysinfo may be used], [emacs_cv_linux_sysinfo], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], [[struct sysinfo si; si.totalram = 0; sysinfo (&si)]])], - emacs_cv_linux_sysinfo=yes, emacs_cv_linux_sysinfo=no) - AC_MSG_RESULT($emacs_cv_linux_sysinfo) + emacs_cv_linux_sysinfo=yes, emacs_cv_linux_sysinfo=no)]) + if test $emacs_cv_linux_sysinfo = yes; then AC_DEFINE([HAVE_LINUX_SYSINFO], 1, [Define to 1 if you have Linux sysinfo function.]) AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], @@ -1765,15 +1763,15 @@ AUTO_DEPEND=no AUTODEPEND_PARENTS='lib src' dnl check if we have GCC and autodepend is on. if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then - AC_MSG_CHECKING([whether gcc understands -MMD -MF]) - SAVE_CFLAGS="$CFLAGS" + AC_CACHE_CHECK([whether gcc understands -MMD -MF], [emacs_cv_autodepend], + [SAVE_CFLAGS="$CFLAGS" CFLAGS="$CFLAGS -MMD -MF deps.d -MP" - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], , ac_enable_autodepend=no) + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])], + [emacs_cv_autodepend=yes], [emacs_cv_autodepend=no]) CFLAGS="$SAVE_CFLAGS" - test -f deps.d || ac_enable_autodepend=no - rm -rf deps.d - AC_MSG_RESULT([$ac_enable_autodepend]) - if test $ac_enable_autodepend = yes; then + test -f deps.d || emacs_cv_autodepend=no + rm -rf deps.d]) + if test $emacs_cv_autodepend = yes; then AUTO_DEPEND=yes fi fi @@ -2037,19 +2035,17 @@ if test "${with_w32}" != no; then fi if test "${opsys}" = "mingw32"; then - AC_MSG_CHECKING([whether Windows API headers are recent enough]) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ + AC_CACHE_CHECK([whether Windows API headers are recent enough], [emacs_cv_w32api], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #include ]], [[PIMAGE_NT_HEADERS pHeader; PIMAGE_SECTION_HEADER pSection = IMAGE_FIRST_SECTION(pHeader)]])], - [emacs_cv_w32api=yes - HAVE_W32=yes], - emacs_cv_w32api=no) - AC_MSG_RESULT($emacs_cv_w32api) + [emacs_cv_w32api=yes], [emacs_cv_w32api=no])]) if test "${emacs_cv_w32api}" = "no"; then AC_MSG_ERROR([the Windows API headers are too old to support this build.]) fi + HAVE_W32=${emacs_cv_w32api} fi FIRSTFILE_OBJ= @@ -2412,8 +2408,8 @@ if test "${HAVE_X11}" = "yes"; then fi if test "${opsys}" = "gnu-linux"; then - AC_MSG_CHECKING(whether X on GNU/Linux needs -b to link) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], + AC_CACHE_CHECK([whether X on GNU/Linux needs -b to link], [emacs_cv_b_link], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[XOpenDisplay ("foo");]])], [xgnu_linux_first_failure=no], [xgnu_linux_first_failure=yes]) @@ -2429,28 +2425,29 @@ if test "${HAVE_X11}" = "yes"; then if test "${xgnu_linux_second_failure}" = "yes"; then # If we get the same failure with -b, there is no use adding -b. # So leave it out. This plays safe. - AC_MSG_RESULT(no) + emacs_cv_b_link=no else - LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" - C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" - AC_MSG_RESULT(yes) + emacs_cv_b_link=yes fi CPPFLAGS=$OLD_CPPFLAGS LIBS=$OLD_LIBS else - AC_MSG_RESULT(no) + emacs_cv_b_link=no + fi]) + if test "x$emacs_cv_b_link" = xyes ; then + LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -b i486-linuxaout" + C_SWITCH_X_SITE="$C_SWITCH_X_SITE -b i486-linuxaout" fi fi # Reportedly, some broken Solaris systems have XKBlib.h but are missing # header files included from there. - AC_MSG_CHECKING(for Xkb) - AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include + AC_CACHE_CHECK([for Xkb], [emacs_cv_xkb], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include #include ]], [[XkbDescPtr kb = XkbGetKeyboard (0, XkbAllComponentsMask, XkbUseCoreKbd);]])], - emacs_xkb=yes, emacs_xkb=no) - AC_MSG_RESULT($emacs_xkb) - if test $emacs_xkb = yes; then + emacs_cv_xkb=yes, emacs_cv_xkb=no)]) + if test $emacs_cv_xkb = yes; then AC_DEFINE(HAVE_XKB, 1, [Define to 1 if you have the Xkb extension.]) fi @@ -2611,9 +2608,8 @@ if test x"$pkg_check_gtk" = xyes; then CFLAGS="$CFLAGS $GTK_CFLAGS" LIBS="$GTK_LIBS $LIBS" dnl Try to compile a simple GTK program. - AC_MSG_CHECKING([whether GTK compiles]) - GTK_COMPILES=no - AC_LINK_IFELSE( + AC_CACHE_CHECK([whether GTK compiles], [emacs_cv_gtk_compiles], + [AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[/* Check the Gtk and Glib APIs. */ #include @@ -2631,9 +2627,8 @@ if test x"$pkg_check_gtk" = xyes; then 0, 0, 0, G_CALLBACK (callback), 0)) gtk_main_iteration (); ]])], - [GTK_COMPILES=yes]) - AC_MSG_RESULT([$GTK_COMPILES]) - if test "${GTK_COMPILES}" != "yes"; then + [emacs_cv_gtk_compiles=yes], [emacs_cv_gtk_compiles=no])]) + if test "${emacs_cv_gtk_compiles}" != "yes"; then GTK_OBJ= if test "$USE_X_TOOLKIT" != "maybe"; then AC_MSG_ERROR([Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?]); @@ -2650,7 +2645,6 @@ if test x"$pkg_check_gtk" = xyes; then one display, but if you use more than one and close one of them Emacs may crash. See http://bugzilla.gnome.org/show_bug.cgi?id=85715]]) - sleep 3 fi fi @@ -2764,8 +2758,8 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then CFLAGS="$CFLAGS $GSETTINGS_CFLAGS" old_LIBS=$LIBS LIBS="$LIBS $GSETTINGS_LIBS" - AC_MSG_CHECKING([whether GSettings is in gio]) - AC_LINK_IFELSE( + AC_CACHE_CHECK([whether GSettings is in gio], [emacs_cv_gsettings_in_gio], + [AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[/* Check that gsettings really is present. */ #include @@ -2775,10 +2769,9 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then GSettings *settings; GVariant *val = g_settings_get_value (settings, ""); ]])], - [], HAVE_GSETTINGS=no) - AC_MSG_RESULT([$HAVE_GSETTINGS]) + [emacs_cv_gsettings_in_gio=yes], [emacs_cv_gsettings_in_gio=no])]) - if test "$HAVE_GSETTINGS" = "yes"; then + if test "$emacs_cv_gsettings_in_gio" = "yes"; then AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.]) SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" SETTINGS_LIBS="$GSETTINGS_LIBS" @@ -3341,18 +3334,18 @@ if test "${HAVE_W32}" = "yes" && test "${opsys}" = "cygwin"; then AC_CHECK_HEADER(noX/xpm.h, [AC_CHECK_LIB(Xpm, XpmReadFileToImage, HAVE_XPM=yes)]) if test "${HAVE_XPM}" = "yes"; then - AC_MSG_CHECKING(for XpmReturnAllocPixels preprocessor define) - AC_EGREP_CPP(no_return_alloc_pixels, + AC_CACHE_CHECK([for XpmReturnAllocPixels preprocessor define], + [emacs_cv_cpp_xpm_return_alloc_pixels], + [AC_EGREP_CPP(no_return_alloc_pixels, [#include "noX/xpm.h" #ifndef XpmReturnAllocPixels no_return_alloc_pixels #endif - ], HAVE_XPM=no, HAVE_XPM=yes) + ], emacs_cv_cpp_xpm_return_alloc_pixels=no, + emacs_cv_cpp_xpm_return_alloc_pixels=yes)]) - if test "${HAVE_XPM}" = "yes"; then - AC_MSG_RESULT(yes) - else - AC_MSG_RESULT(no) + if test "$emacs_cv_cpp_xpm_return_alloc_pixels" = "no"; then + HAVE_XPM=no LDFLAGS="$SAVE_LDFLAGS" fi fi @@ -3372,18 +3365,18 @@ if test "${HAVE_X11}" = "yes"; then AC_CHECK_HEADER(X11/xpm.h, [AC_CHECK_LIB(Xpm, XpmReadFileToPixmap, HAVE_XPM=yes, , -lX11)]) if test "${HAVE_XPM}" = "yes"; then - AC_MSG_CHECKING(for XpmReturnAllocPixels preprocessor define) - AC_EGREP_CPP(no_return_alloc_pixels, - [#include "X11/xpm.h" + AC_CACHE_CHECK([for XpmReturnAllocPixels preprocessor define], + [emacs_cv_cpp_xpm_return_alloc_pixels], + [AC_EGREP_CPP(no_return_alloc_pixels, + [#include "noX/xpm.h" #ifndef XpmReturnAllocPixels no_return_alloc_pixels #endif - ], HAVE_XPM=no, HAVE_XPM=yes) + ], emacs_cv_cpp_xpm_return_alloc_pixels=no, + emacs_cv_cpp_xpm_return_alloc_pixels=yes)]) - if test "${HAVE_XPM}" = "yes"; then - AC_MSG_RESULT(yes) - else - AC_MSG_RESULT(no) + if test "$emacs_cv_cpp_xpm_return_alloc_pixels" = "no"; then + HAVE_XPM=no fi fi fi @@ -3985,17 +3978,11 @@ AC_CHECK_FUNCS(grantpt) # PTY-related GNU extensions. AC_CHECK_FUNCS(getpt posix_openpt) -# Check this now, so that we will NOT find the above functions in ncurses. -# That is because we have not set up to link ncurses in lib-src. -# It's better to believe a function is not available -# than to expect to find it in ncurses. -# Also we need tputs and friends to be able to build at all. -AC_MSG_CHECKING([for library containing tputs]) -# Run a test program that contains a call to tputs, a call that is -# never executed. This tests whether a pre-'main' dynamic linker -# works with the library. It's too much trouble to actually call -# tputs in the test program, due to portability hassles. When -# cross-compiling, assume the test program will run if it links. +dnl Run a test program that contains a call to tputs, a call that is +dnl never executed. This tests whether a pre-'main' dynamic linker +dnl works with the library. It's too much trouble to actually call +dnl tputs in the test program, due to portability hassles. When +dnl cross-compiling, assume the test program will run if it links. AC_DEFUN([tputs_link_source], [ AC_LANG_SOURCE( [[extern void tputs (const char *, int, int (*)(int)); @@ -4006,38 +3993,42 @@ AC_DEFUN([tputs_link_source], [ return 0; }]]) ]) -if test "${opsys}" = "mingw32"; then - msg='none required' +# Check this now, so that we will NOT find the above functions in ncurses. +# That is because we have not set up to link ncurses in lib-src. +# It's better to believe a function is not available +# than to expect to find it in ncurses. +# Also we need tputs and friends to be able to build at all. +AC_CACHE_CHECK([for library containing tputs], [emacs_cv_tputs_lib], +[if test "${opsys}" = "mingw32"; then + emacs_cv_tputs_lib='none required' else # Maybe curses should be tried earlier? # See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=9736#35 for tputs_library in '' tinfo ncurses terminfo termcap curses; do OLIBS=$LIBS if test -z "$tputs_library"; then - LIBS_TERMCAP= - msg='none required' + emacs_cv_tputs_lib='none required' else - LIBS_TERMCAP=-l$tputs_library - msg=$LIBS_TERMCAP - LIBS="$LIBS_TERMCAP $LIBS" + emacs_cv_tputs_lib=-l$tputs_library + LIBS="$emacs_cv_tputs_lib $LIBS" fi - AC_RUN_IFELSE([tputs_link_source], [], [msg=no], - [AC_LINK_IFELSE([tputs_link_source], [], [msg=no])]) + AC_RUN_IFELSE([tputs_link_source], [], [emacs_cv_tputs_lib=no], + [AC_LINK_IFELSE([tputs_link_source], [], [emacs_cv_tputs_lib=no])]) LIBS=$OLIBS - if test "X$msg" != Xno; then + if test "X$emacs_cv_tputs_lib" != Xno; then break fi done -fi -AC_MSG_RESULT([$msg]) -if test "X$msg" = Xno; then - AC_MSG_ERROR([The required function 'tputs' was not found in any library. +fi]) +AS_CASE(["$emacs_cv_tputs_lib"], + [no], [AC_MSG_ERROR([The required function 'tputs' was not found in any library. The following libraries were tried (in order): libtinfo, libncurses, libterminfo, libtermcap, libcurses Please try installing whichever of these libraries is most appropriate for your system, together with its header files. -For example, a libncurses-dev(el) or similar package.]) -fi +For example, a libncurses-dev(el) or similar package.])], + [-l*], [LIBS_TERMCAP=$emacs_cv_tputs_lib], + [*], [LIBS_TERMCAP=]) ## Use termcap instead of terminfo? ## Only true for: freebsd < 40000, ms-w32, msdos, netbsd < 599002500. @@ -4273,28 +4264,27 @@ dnl glib at a low level. dnl dnl Check this late, since it depends on $GTK_CFLAGS etc. XGSELOBJ= -OLDCFLAGS="$CFLAGS" +AC_CACHE_CHECK([whether GLib is linked in], [emacs_cv_links_glib], +[OLDCFLAGS="$CFLAGS" OLDLIBS="$LIBS" CFLAGS="$CFLAGS $GTK_CFLAGS $RSVG_CFLAGS $DBUS_CFLAGS $SETTINGS_CFLAGS" LIBS="$LIBS $GTK_LIBS $RSVG_LIBS $DBUS_LIBS $SETTINGS_LIBS" CFLAGS="$CFLAGS $NOTIFY_CFLAGS $CAIRO_CFLAGS" LIBS="$LIBS $NOTIFY_LIBS $CAIRO_LIBS" -AC_MSG_CHECKING([whether GLib is linked in]) AC_LINK_IFELSE([AC_LANG_PROGRAM( [[#include ]], [[g_print ("Hello world");]])], - [links_glib=yes], - [links_glib=no]) -AC_MSG_RESULT([$links_glib]) -if test "${links_glib}" = "yes"; then + [emacs_cv_links_glib=yes], + [emacs_cv_links_glib=no]) +CFLAGS="$OLDCFLAGS" +LIBS="$OLDLIBS"]) +if test "${emacs_cv_links_glib}" = "yes"; then AC_DEFINE(HAVE_GLIB, 1, [Define to 1 if GLib is linked in.]) if test "$HAVE_NS" = no;then XGSELOBJ=xgselect.o fi fi -CFLAGS="$OLDCFLAGS" -LIBS="$OLDLIBS" AC_SUBST(XGSELOBJ) dnl Adapted from Haible's version. @@ -4660,16 +4650,15 @@ case $opsys in dnl FIXME Does gnu-kfreebsd have linux/version.h? It seems unlikely... gnu-linux | gnu-kfreebsd ) - AC_MSG_CHECKING([for signals via characters]) - AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ + AC_CACHE_CHECK([for signals via characters], [emacs_cv_signals_via_chars], + [AC_PREPROC_IFELSE([AC_LANG_PROGRAM([[ #include #if LINUX_VERSION_CODE < 0x20400 # error "Linux version too old" #endif - ]], [[]])], emacs_signals_via_chars=yes, emacs_signals_via_chars=no) + ]], [[]])], emacs_cv_signals_via_chars=yes, emacs_cv_signals_via_chars=no)]) - AC_MSG_RESULT([$emacs_signals_via_chars]) - test $emacs_signals_via_chars = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1) + test "$emacs_cv_signals_via_chars" = yes && AC_DEFINE(SIGNALS_VIA_CHARACTERS, 1) ;; esac commit 13a846823a92447d5cf0c2ce2bb401c5cdcb9ee4 Author: Paul Eggert Date: Mon Aug 14 15:25:13 2017 -0700 Improve rename-file behavior on macOS Problem reported by Philipp Stephani (Bug#27986). * src/fileio.c (Frename_file): Worry about file name case sensitivity only if CYGWIN or DOS_NT. * src/sysdep.c (renameat_noreplace): Use renameatx_np on macOS, since this provides the necessary atomicity guarantees. diff --git a/src/fileio.c b/src/fileio.c index 69079c6ae4..9f6de5b6ca 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2259,12 +2259,14 @@ This is what happens in interactive use with M-x. */) not worry whether NEWNAME exists or whether it is a directory, as it is already another name for FILE. */ bool case_only_rename = false; +#if defined CYGWIN || defined DOS_NT if (!NILP (Ffile_name_case_insensitive_p (file))) { newname = Fexpand_file_name (newname, Qnil); case_only_rename = !NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))); } +#endif if (!case_only_rename) newname = expand_cp_target (Fdirectory_file_name (file), newname); diff --git a/src/sysdep.c b/src/sysdep.c index 35f499c185..2e18a419e3 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2693,11 +2693,13 @@ renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { #if defined SYS_renameat2 && defined RENAME_NOREPLACE return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); +#elif defined RENAME_EXCL + return renameatx_np (srcfd, src, dstfd, dst, RENAME_EXCL); #else -#ifdef WINDOWSNT +# ifdef WINDOWSNT if (srcfd == AT_FDCWD && dstfd == AT_FDCWD) return sys_rename_replace (src, dst, 0); -#endif +# endif errno = ENOSYS; return -1; #endif commit 4fe9a9efcfdd39c5751d4506e94afaf28fcbcaef Author: Glenn Morris Date: Mon Aug 14 17:23:18 2017 -0400 Clean up temp files after some tests * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file): Also delete .elc file if present. * test/lisp/progmodes/etags-tests.el (etags-buffer-local-tags-table-list): Delete temp file at end. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 8ef2ce7025..ab70b3009e 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -512,7 +512,9 @@ bytecompiled code, and their results compared.") `(let ((,file-name-var (make-temp-file "emacs"))) (unwind-protect (progn ,@body) - (delete-file ,file-name-var)))) + (delete-file ,file-name-var) + (let ((elc (concat ,file-name-var ".elc"))) + (if (file-exists-p elc) (delete-file elc)))))) (ert-deftest bytecomp-tests--unescaped-char-literals () "Check that byte compiling warns about unescaped character diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index 0153f327ba..845f3fe76a 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -96,15 +96,18 @@ (ert-deftest etags-buffer-local-tags-table-list () "Test that a buffer-local value of `tags-table-list' is used." (let ((file (make-temp-file "etag-test-tmpfile"))) - (set-buffer (find-file-noselect file)) - (fundamental-mode) - (setq-local tags-table-list - (list (expand-file-name "manual/etags/ETAGS.good_3" - etags-tests--test-dir))) - (cl-letf ((tag-tables tags-table-list) - (tags-file-name nil) - ((symbol-function 'read-file-name) - (lambda (&rest _) - (error "We should not prompt the user")))) - (should (visit-tags-table-buffer)) - (should (equal tags-file-name (car tag-tables)))))) + (unwind-protect + (progn + (set-buffer (find-file-noselect file)) + (fundamental-mode) + (setq-local tags-table-list + (list (expand-file-name "manual/etags/ETAGS.good_3" + etags-tests--test-dir))) + (cl-letf ((tag-tables tags-table-list) + (tags-file-name nil) + ((symbol-function 'read-file-name) + (lambda (&rest _) + (error "We should not prompt the user")))) + (should (visit-tags-table-buffer)) + (should (equal tags-file-name (car tag-tables))))) + (delete-file file)))) commit 5ba4c7d16b800864fa14b8a981e33f6aa6fa94d6 Author: Eli Zaretskii Date: Mon Aug 14 19:31:12 2017 +0300 Implement renameat_noreplace for MS-Windows * src/sysdep.c (renameat_noreplace) [WINDOWSNT]: Implement minimal emulation for MS-Windows. (Bug#27986) diff --git a/src/sysdep.c b/src/sysdep.c index 9eb733221e..35f499c185 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2694,6 +2694,10 @@ renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) #if defined SYS_renameat2 && defined RENAME_NOREPLACE return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); #else +#ifdef WINDOWSNT + if (srcfd == AT_FDCWD && dstfd == AT_FDCWD) + return sys_rename_replace (src, dst, 0); +#endif errno = ENOSYS; return -1; #endif commit 16f11be4b96fc37204dc950e64f78ed340cd70d8 Author: Eli Zaretskii Date: Mon Aug 14 19:17:22 2017 +0300 Fix 'rename' on MS-Windows * src/w32.c (sys_rename_replace): Use the FORCE argument only if the primitive rename errors out with EEXIST. diff --git a/src/w32.c b/src/w32.c index c5b51bb6b0..c821e245d8 100644 --- a/src/w32.c +++ b/src/w32.c @@ -4502,7 +4502,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) filename_to_utf16 (temp, temp_w); filename_to_utf16 (newname, newname_w); result = _wrename (temp_w, newname_w); - if (result < 0 && force) + if (result < 0) { DWORD w32err = GetLastError (); @@ -4520,7 +4520,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; } - else if (errno == EEXIST) + else if (errno == EEXIST && force) { if (_wchmod (newname_w, 0666) != 0) return result; @@ -4546,7 +4546,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) filename_to_ansi (temp, temp_a); filename_to_ansi (newname, newname_a); result = rename (temp_a, newname_a); - if (result < 0 && force) + if (result < 0) { DWORD w32err = GetLastError (); @@ -4559,7 +4559,7 @@ sys_rename_replace (const char *oldname, const char *newname, BOOL force) && (attributes & FILE_ATTRIBUTE_DIRECTORY)) errno = EXDEV; } - else if (errno == EEXIST) + else if (errno == EEXIST && force) { if (_chmod (newname_a, 0666) != 0) return result; commit 65899e5b0180284b87b1fa94c091b903056c6bfc Author: Michael Albinus Date: Mon Aug 14 18:05:58 2017 +0200 * lisp/net/ange-ftp.el (ange-ftp-skip-msgs): Support ftp-ssl. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index a4842077ad..0fbf82577a 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -693,6 +693,7 @@ parenthesized expressions in REGEXP for the components (in that order)." (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|" "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|" "^Data connection \\|" + "^SSL not available\\|" "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|" "^500 .*AUTH\\|^KERBEROS\\|" "^500 This security scheme is not implemented\\|" commit ab2da681b904cd0c7bfac3a6f5fb3347cc591f20 Author: Mark Oteiza Date: Mon Aug 14 01:54:11 2017 -0400 Tiny JSON performance improvement Get rid of some needless uses of apply. Measuring with (benchmark-run 10 (json-read-file "test.json")) showed 1.5-2.5% reduction of execution time. * lisp/json.el (json-peek): Nix let-binding. (json-read-string): Use concat for making a string from chars. (json-read-array): Use cond and more appropriate conversion instead of blindly applying. diff --git a/lisp/json.el b/lisp/json.el index 3def94ce04..627e65efa4 100644 --- a/lisp/json.el +++ b/lisp/json.el @@ -193,8 +193,7 @@ Unlike `reverse', this keeps the property-value pairs intact." (defsubst json-peek () "Return the character at point." - (let ((char (char-after (point)))) - (or char :json-eof))) + (or (char-after (point)) :json-eof)) (defsubst json-pop () "Advance past the character at point, returning it." @@ -415,7 +414,7 @@ representation will be parsed correctly." ;; Skip over the '"' (json-advance) (if characters - (apply 'string (nreverse characters)) + (concat (nreverse characters)) ""))) ;; String encoding @@ -639,7 +638,9 @@ become JSON objects." (signal 'json-error (list 'bleah))))) ;; Skip over the "]" (json-advance) - (apply json-array-type (nreverse elements)))) + (pcase json-array-type + (`vector (nreverse (vconcat elements))) + (`list (nreverse elements))))) ;; Array encoding commit 5bdc97d55df30f6af107ddd136901983a7e2706a Author: Paul Eggert Date: Sun Aug 13 11:54:46 2017 -0700 Be consistent in spelling 'ok-if-already-exists'. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d3f40a7c0c..25f32c231c 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1652,7 +1652,7 @@ with @code{add-name-to-file} and then deleting @var{filename} has the same effect as renaming, aside from momentary intermediate states. @end deffn -@deffn Command copy-file oldname newname &optional ok-if-exists time preserve-uid-gid preserve-extended-attributes +@deffn Command copy-file oldname newname &optional ok-if-already-exists time preserve-uid-gid preserve-extended-attributes This command copies the file @var{oldname} to @var{newname}. An error is signaled if @var{oldname} does not exist. If @var{newname} names a directory, it copies @var{oldname} into that directory, @@ -1684,7 +1684,7 @@ default file permissions (see @code{set-default-file-modes} below), if SELinux context are not copied over in either case. @end deffn -@deffn Command make-symbolic-link filename newname &optional ok-if-exists +@deffn Command make-symbolic-link filename newname &optional ok-if-already-exists @pindex ln @kindex file-already-exists This command makes a symbolic link to @var{filename}, named diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index cb8086bdb3..a4842077ad 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3846,12 +3846,12 @@ E.g., (unless okay-p (error "%s: %s" 'ange-ftp-copy-files-async line)) (if files (let* ((ff (car files)) - (from-file (nth 0 ff)) - (to-file (nth 1 ff)) - (ok-if-exists (nth 2 ff)) - (keep-date (nth 3 ff))) + (from-file (nth 0 ff)) + (to-file (nth 1 ff)) + (ok-if-already-exists (nth 2 ff)) + (keep-date (nth 3 ff))) (ange-ftp-copy-file-internal - from-file to-file ok-if-exists keep-date + from-file to-file ok-if-already-exists keep-date (and verbose-p (format "%s --> %s" from-file to-file)) (list 'ange-ftp-copy-files-async verbose-p (cdr files)) t)) diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 12e6c84b3c..9fee09f38e 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -467,7 +467,7 @@ agenda view showing the flagged items." (make-directory target-dir 'parents)) (if org-mobile-use-encryption (org-mobile-encrypt-and-move file target-path) - (copy-file file target-path 'ok-if-exists)) + (copy-file file target-path 'ok-if-already-exists)) (setq check (shell-command-to-string (concat (shell-quote-argument org-mobile-checksum-binary) " " @@ -687,7 +687,7 @@ encryption program does not understand them." (let ((encfile (concat infile "_enc"))) (org-mobile-encrypt-file infile encfile) (when outfile - (copy-file encfile outfile 'ok-if-exists) + (copy-file encfile outfile 'ok-if-already-exists) (delete-file encfile)))) (defun org-mobile-encrypt-file (infile outfile) commit 8de2edd9ef8b4776fd7226de285c1d135b3e6938 Merge: e2e3856141 abab4b091f Author: Eli Zaretskii Date: Sun Aug 13 18:58:24 2017 +0300 Merge branch 'master' of git.savannah.gnu.org:/srv/git/emacs commit e2e3856141a315ea4a7acbd0534feaa848c4bf6b Author: Alexander Gramiak Date: Sun Aug 13 17:56:31 2017 +0300 Use 'header-line-highlight' face in proced and erc * lisp/erc/erc-list.el (erc-list-button): * lisp/proced.el (proced-format): Use the 'header-line-highlight face. (Bug#28033) diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 5110239f61..7d6413ee7f 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -145,7 +145,7 @@ (erc-propertize title 'column-number column 'help-echo "mouse-1: sort by column" - 'mouse-face 'highlight + 'mouse-face 'header-line-highlight 'keymap erc-list-menu-sort-button-map)) (define-derived-mode erc-list-menu-mode special-mode "ERC-List" diff --git a/lisp/proced.el b/lisp/proced.el index be3b7c41a6..18693f4556 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -1438,7 +1438,7 @@ Replace newline characters by \"^J\" (two characters)." (hprops (if (nth 4 grammar) (let ((descend (if (eq key sort-key) proced-descend (nth 5 grammar)))) - `(proced-key ,key mouse-face highlight + `(proced-key ,key mouse-face header-line-highlight help-echo ,(format proced-header-help-echo (if descend "-" "+") (nth 1 grammar) commit abab4b091f2412b435c51b29c4d501f4fc806cb3 Author: Ulf Jasper Date: Sun Aug 13 16:50:19 2017 +0200 Remove feeds with dead uris from newsticker--raw-url-list-defaults * lisp/net/newst-backend.el (newsticker--raw-url-list-defaults): Remove feeds with dead uris. diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 3f8c9961b8..8f748c1eba 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -75,10 +75,6 @@ considered to be running if the newsticker timer list is not empty." "https://www.emacswiki.org/emacs?action=rss" nil 3600) - ("Freshmeat.net" - "http://freshmeat.net/index.atom") - ("Kuro5hin.org" - "http://www.kuro5hin.org/backend.rdf") ("LWN (Linux Weekly News)" "http://lwn.net/headlines/rss") ("NY Times: Technology" @@ -102,9 +98,7 @@ considered to be running if the newsticker timer list is not empty." ("Tagesschau (german)" "http://www.tagesschau.de/newsticker.rdf" nil - 1800) - ("Telepolis (german)" - "http://www.heise.de/tp/news.rdf")) + 1800)) "Default URL list in raw form. This list is fed into defcustom via `newsticker--splicer'.") commit 2367c15b18dd6b3aaf82bdbab9d2e833ec838ef4 Author: Eli Zaretskii Date: Sun Aug 13 17:53:48 2017 +0300 Fix vertical cursor motion when cursor is on the fringe * lisp/simple.el (line-move-visual): Fix an off-by-one error in setting temporary-goal-column when newline overflows into the fringe. Support that use case in R2L paragraphs as well. diff --git a/lisp/simple.el b/lisp/simple.el index 16f69f2bbe..58f8372192 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6261,9 +6261,10 @@ If NOERROR, don't signal an error if we can't move that many lines." (let ((posn (posn-at-point)) x-pos) (cond - ;; Handle the `overflow-newline-into-fringe' case: - ((eq (nth 1 posn) 'right-fringe) - (setq temporary-goal-column (cons (- (window-width) 1) hscroll))) + ;; Handle the `overflow-newline-into-fringe' case + ;; (left-fringe is for the R2L case): + ((memq (nth 1 posn) '(right-fringe left-fringe)) + (setq temporary-goal-column (cons (window-width) hscroll))) ((car (posn-x-y posn)) (setq x-pos (car (posn-x-y posn))) ;; In R2L lines, the X pixel coordinate is measured from the commit 28a5b8adcc1cf5e70b06749c73645f4caa9d0b37 Author: Eli Zaretskii Date: Sun Aug 13 17:49:07 2017 +0300 Fix vertical cursor motion across too wide images * src/indent.c (Fvertical_motion): If lines are truncated and we end up beyond the right margin of the window, don't assume we are in the next screen line, unless VPOS actually says so. (Bug#28071) diff --git a/src/indent.c b/src/indent.c index 4c6dacd204..d76ac028d5 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2229,10 +2229,10 @@ whether or not it is currently displayed in some window. */) screen lines we need to backtrack. */ it_overshoot_count = it.vpos; } - /* We will overshoot if lines are truncated and point lies + /* We might overshoot if lines are truncated and point lies beyond the right margin of the window. */ if (it.line_wrap == TRUNCATE && it.current_x >= it.last_visible_x - && it_overshoot_count == 0) + && it_overshoot_count == 0 && it.vpos > 0) it_overshoot_count = 1; if (it_overshoot_count > 0) move_it_by_lines (&it, -it_overshoot_count); commit 8c8be4f8f439123859bf20f4d46055fa6c81f2e8 Author: Tino Calancha Date: Sun Aug 13 23:41:01 2017 +0900 Add test suites for arc-mode and tar-mode * test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode) * test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode): New tests. diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el new file mode 100644 index 0000000000..04047bab62 --- /dev/null +++ b/test/lisp/arc-mode-tests.el @@ -0,0 +1,36 @@ +;;; arc-mode-tests.el --- Test suite for arc-mode. -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: +(require 'ert) +(require 'arc-mode) + + +(ert-deftest arc-mode-test-archive-int-to-mode () + (let ((alist (list (cons 448 "-rwx------") + (cons 420 "-rw-r--r--") + (cons 292 "-r--r--r--") + (cons 512 "----------") + (cons 1024 "---S------")))) + (dolist (x alist) + (should (equal (cdr x) (archive-int-to-mode (car x))))))) + +(provide 'arc-mode-tests) + +;; arc-mode-tests.el ends here diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el new file mode 100644 index 0000000000..76ec058e61 --- /dev/null +++ b/test/lisp/tar-mode-tests.el @@ -0,0 +1,36 @@ +;;; tar-mode-tests.el --- Test suite for tar-mode. -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: +(require 'ert) +(require 'tar-mode) + + +(ert-deftest tar-mode-test-tar-grind-file-mode () + (let ((alist (list (cons 448 "rwx------") + (cons 420 "rw-r--r--") + (cons 292 "r--r--r--") + (cons 512 "--------T") + (cons 1024 "-----S---")))) + (dolist (x alist) + (should (equal (cdr x) (tar-grind-file-mode (car x))))))) + +(provide 'tar-mode-tests) + +;; tar-mode-tests.el ends here commit 00bc04f60614907c8042a9f2eb73cc8062006649 Author: Tino Calancha Date: Sun Aug 13 23:38:29 2017 +0900 * lisp/tar-mode.el (tar-grind-file-mode): Fix docstring diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 1d453d2980..b0d3177694 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -469,7 +469,7 @@ checksum before doing the check." (concat " " (substring str 4 16) (format-time-string " %Y" time)))) (defun tar-grind-file-mode (mode) - "Construct a `-rw--r--r--' string indicating MODE. + "Construct a `rw-r--r--' string indicating MODE. MODE should be an integer which is a file mode value." (string (if (zerop (logand 256 mode)) ?- ?r) commit 0b858d9a88509e1ad67826fec57cb6ecaf8812f2 Author: Ulf Jasper Date: Sun Aug 13 16:26:31 2017 +0200 Fix uri of Emacs Wiki * lisp/net/newst-backend.el (newsticker--raw-url-list-defaults): Fix uri of Emacs Wiki. (Bug#27981) diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index f38c72a26b..3f8c9961b8 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -72,7 +72,7 @@ considered to be running if the newsticker timer list is not empty." ("Debian Security Advisories - Long format" "http://www.debian.org/security/dsa-long.en.rdf") ("Emacs Wiki" - "http://www.emacswiki.org/cgi-bin/wiki.pl?action=rss" + "https://www.emacswiki.org/emacs?action=rss" nil 3600) ("Freshmeat.net" commit 55a5e30c9fe32f44b98d30023f38d3a2e3fd32e4 Author: Michael Albinus Date: Sun Aug 13 10:45:22 2017 +0200 ; Do not mention ange-ftp-lovers ML in ange-ftp.el (Bug#28075) diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index ebc14693f6..cb8086bdb3 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -530,33 +530,8 @@ ;; to fix its files hashtable. A cookie to anyone who can think of a ;; fast, sure-fire way to recognize ULTRIX over ftp. -;; If you find any bugs or problems with this package, PLEASE either e-mail -;; the above author, or send a message to the ange-ftp-lovers mailing list -;; below. Ideas and constructive comments are especially welcome. - -;; ange-ftp-lovers: -;; -;; ange-ftp has its own mailing list modestly called ange-ftp-lovers. All -;; users of ange-ftp are welcome to subscribe (see below) and to discuss -;; aspects of ange-ftp. New versions of ange-ftp are posted periodically to -;; the mailing list. - -;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the -;; list, please mail one of the following addresses: -;; -;; ange-ftp-lovers-request@hplb.hpl.hp.com -;; -;; Please don't forget the -request part. -;; -;; For mail to be posted directly to ange-ftp-lovers, send to one of the -;; following addresses: -;; -;; ange-ftp-lovers@hplb.hpl.hp.com -;; -;; Alternatively, there is a mailing list that only gets announcements of new -;; ange-ftp releases. This is called ange-ftp-lovers-announce, and can be -;; subscribed to by e-mailing to the -request address as above. Please make -;; it clear in the request which mailing list you wish to join. +;; If you find any bugs or problems with this package, PLEASE report a +;; bug to the Emacs maintainers via M-x report-emacs-bug. ;; ----------------------------------------------------------- ;; Technical information on this package: commit ebf53ed4f6469d24c3a76835eab014d82aed551c Author: Paul Eggert Date: Sat Aug 12 20:04:43 2017 -0700 Fix make-temp-file bug with ""/"."/".." prefix The bug with "." and ".." has been present for a while; I introduced the bug with "" earlier today in my patch for Bug#28023. * lisp/files.el (make-temp-file): Do not use expand-file-name if PREFIX is empty or "." or "..", as it does the wrong thing. Compute absolute-prefix here ... (files--make-magic-temp-file): ... instead of here ... * src/fileio.c (Fmake_temp_file_internal): ... or here. * lisp/files.el (make-temp-file): If the prefix is empty, append "/" to the absolute prefix so that the new files are children rather than siblings of temporary-file-directory. This fixes a bug introduced in the previous change. * test/lisp/files-tests.el (files-test-make-temp-file-empty-prefix): New test, for the bug. diff --git a/lisp/files.el b/lisp/files.el index 19573cdf7b..b05d453b0e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1407,14 +1407,17 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." - (let ((absolute-prefix (expand-file-name prefix temporary-file-directory))) + (let ((absolute-prefix + (if (or (zerop (length prefix)) (member prefix '("." ".."))) + (concat (file-name-as-directory temporary-file-directory) prefix) + (expand-file-name prefix temporary-file-directory)))) (if (find-file-name-handler absolute-prefix 'write-region) - (files--make-magic-temp-file prefix dir-flag suffix) + (files--make-magic-temp-file absolute-prefix dir-flag suffix) (make-temp-file-internal absolute-prefix (if dir-flag t) (or suffix ""))))) -(defun files--make-magic-temp-file (prefix &optional dir-flag suffix) - "Implement (make-temp-file PREFIX DIR-FLAG SUFFIX). +(defun files--make-magic-temp-file (absolute-prefix &optional dir-flag suffix) + "Implement (make-temp-file ABSOLUTE-PREFIX DIR-FLAG SUFFIX). This implementation works on magic file names." ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the @@ -1423,13 +1426,7 @@ This implementation works on magic file names." (let (file) (while (condition-case () (progn - (setq file - (make-temp-name - (if (zerop (length prefix)) - (file-name-as-directory - temporary-file-directory) - (expand-file-name prefix - temporary-file-directory)))) + (setq file (make-temp-name absolute-prefix)) (if suffix (setq file (concat file suffix))) (if dir-flag diff --git a/src/fileio.c b/src/fileio.c index b7e3b71a47..69079c6ae4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -662,17 +662,16 @@ DEFUN ("make-temp-file-internal", Fmake_temp_file_internal, Return the name of the generated file. If DIR-FLAG is zero, do not create the file, just its name. Otherwise, if DIR-FLAG is non-nil, create an empty directory. The file name should end in SUFFIX. +Do not expand PREFIX; a non-absolute PREFIX is relative to the Emacs +working directory. Signal an error if the file could not be created. This function does not grok magic file names. */) (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix) { - bool make_temp_name = EQ (dir_flag, make_number (0)); + CHECK_STRING (prefix); CHECK_STRING (suffix); - if (!make_temp_name) - prefix = Fexpand_file_name (prefix, Vtemporary_file_directory); - Lisp_Object encoded_prefix = ENCODE_FILE (prefix); Lisp_Object encoded_suffix = ENCODE_FILE (suffix); ptrdiff_t prefix_len = SBYTES (encoded_prefix); @@ -686,7 +685,7 @@ This function does not grok magic file names. */) memset (data + prefix_len, 'X', nX); memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len); int kind = (NILP (dir_flag) ? GT_FILE - : make_temp_name ? GT_NOCREATE + : EQ (dir_flag, make_number (0)) ? GT_NOCREATE : GT_DIR); int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind); if (fd < 0 || (NILP (dir_flag) && emacs_close (fd) != 0)) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 7bfdca53e0..4a17e0d469 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -166,6 +166,20 @@ form.") (should (eq buffer-file-coding-system 'iso-2022-7bit-unix)))) (delete-file tempfile)))) +(ert-deftest files-test-make-temp-file-empty-prefix () + "Test make-temp-file with an empty prefix." + (let ((tempfile (make-temp-file "")) + (tempdir (make-temp-file "" t)) + (tempfile-. (make-temp-file ".")) + (tempdir-. (make-temp-file "." t)) + (tempfile-.. (make-temp-file "..")) + (tempdir-.. (make-temp-file ".." t))) + (dolist (file (list tempfile tempfile-. tempfile-..)) + (should file) + (delete-file file)) + (dolist (dir (list tempdir tempdir-. tempdir-..)) + (should dir) + (delete-directory dir)))) ;; Stop the above "Local Var..." confusing Emacs. commit a6ad98ad66e1d0c0dac5f25ba91e11d0cf9da725 Author: Paul Eggert Date: Sat Aug 12 14:00:17 2017 -0700 Improve make-temp-file performance on local files For the motivation behind this patch, please see Bug#28023 and: http://emacshorrors.com/posts/make-temp-name.html Although, given the recent changes to Tramp, the related security problem in make-temp-file is already fixed, make-temp-file still has several unnecessary system calls. In the typical case on GNU/Linux, this patch replaces 8 syscalls (symlink, open, close, readlinkat, uname, getpid, unlink, umask) by 2 (open, close). * admin/merge-gnulib (GNULIB_MODULES): Add tempname, now that Emacs is using it directly. * configure.ac (AUTO_DEPEND): Remove AC_SYS_LONG_FILE_NAMES; no longer needed. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lisp/files.el (files--make-magic-temp-file): Rename from make-temp-file. (make-temp-file): Use make-temp-file-internal for non-magic file names. * src/fileio.c: Include tempname.h. (make_temp_name_tbl, make_temp_name_count) (make_temp_name_count_initialized_p, make_temp_name): Remove. (Fmake_temp_file_internal): New function. (Fmake_temp_name): Use it. * src/filelock.c (get_boot_time): Use Fmake_temp_file_internal instead of make_temp_name. diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index cead305aee..10b558d1ad 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -205,7 +205,6 @@ HAVE_LIBXML2 HAVE_LIBXMU HAVE_LOCALTIME_R HAVE_LOCAL_SOCKETS -HAVE_LONG_FILE_NAMES HAVE_LONG_LONG_INT HAVE_LRAND48 HAVE_LSTAT diff --git a/admin/merge-gnulib b/admin/merge-gnulib index a16d7fa53e..7eca64305d 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -39,8 +39,8 @@ GNULIB_MODULES=' manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio - stpcpy strtoimax symlink sys_stat - sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub + stpcpy strtoimax symlink sys_stat sys_time + tempname time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimens vla warnings ' diff --git a/configure.ac b/configure.ac index 9f80620a80..86d5b3e94f 100644 --- a/configure.ac +++ b/configure.ac @@ -1779,9 +1779,6 @@ if test "$GCC" = yes && test "$ac_enable_autodepend" = yes; then fi AC_SUBST(AUTO_DEPEND) -dnl checks for operating system services -AC_SYS_LONG_FILE_NAMES - #### Choose a window system. ## We leave window_system equal to none if diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index c5df3f42e4..30986b4ed7 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time tempname time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump @@ -904,7 +904,6 @@ gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@ gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@ gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@ gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@ -gl_GNULIB_ENABLED_tempname = @gl_GNULIB_ENABLED_tempname@ gl_LIBOBJS = @gl_LIBOBJS@ gl_LTLIBOBJS = @gl_LTLIBOBJS@ gltests_LIBOBJS = @gltests_LIBOBJS@ @@ -2701,10 +2700,8 @@ endif ## begin gnulib module tempname ifeq (,$(OMIT_GNULIB_MODULE_tempname)) -ifneq (,$(gl_GNULIB_ENABLED_tempname)) libgnu_a_SOURCES += tempname.c -endif EXTRA_DIST += tempname.h endif diff --git a/lisp/files.el b/lisp/files.el index 0fe7f9c522..19573cdf7b 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1407,6 +1407,15 @@ You can then use `write-region' to write new data into the file. If DIR-FLAG is non-nil, create a new empty directory instead of a file. If SUFFIX is non-nil, add that at the end of the file name." + (let ((absolute-prefix (expand-file-name prefix temporary-file-directory))) + (if (find-file-name-handler absolute-prefix 'write-region) + (files--make-magic-temp-file prefix dir-flag suffix) + (make-temp-file-internal absolute-prefix + (if dir-flag t) (or suffix ""))))) + +(defun files--make-magic-temp-file (prefix &optional dir-flag suffix) + "Implement (make-temp-file PREFIX DIR-FLAG SUFFIX). +This implementation works on magic file names." ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 69d77229bf..d1089860e1 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -387,6 +387,7 @@ AC_DEFUN([gl_INIT], AC_PROG_MKDIR_P gl_SYS_TYPES_H AC_PROG_MKDIR_P + gl_FUNC_GEN_TEMPNAME gl_HEADER_TIME_H gl_TIME_R if test $HAVE_LOCALTIME_R = 0 || test $REPLACE_LOCALTIME_R = 1; then @@ -424,7 +425,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false gl_gnulib_enabled_strtoll=false - gl_gnulib_enabled_tempname=false gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b () { @@ -560,13 +560,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_strtoll=true fi } - func_gl_gnulib_m4code_tempname () - { - if ! $gl_gnulib_enabled_tempname; then - gl_FUNC_GEN_TEMPNAME - gl_gnulib_enabled_tempname=true - fi - } func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () { if ! $gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec; then @@ -612,9 +605,6 @@ AC_DEFUN([gl_INIT], if test $REPLACE_LSTAT = 1; then func_gl_gnulib_m4code_dosname fi - if test $HAVE_MKOSTEMP = 0; then - func_gl_gnulib_m4code_tempname - fi if test $HAVE_READLINKAT = 0; then func_gl_gnulib_m4code_260941c0e5dc67ec9e87d1fb321c300b fi @@ -644,7 +634,6 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_tempname], [$gl_gnulib_enabled_tempname]) AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) # End of code from modules m4_ifval(gl_LIBSOURCES_LIST, [ diff --git a/src/buffer.c b/src/buffer.c index 0d0f43e937..2d508f35cf 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1085,7 +1085,6 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) genbase = name; else { - /* Note fileio.c:make_temp_name does random differently. */ char number[sizeof "-999999"]; int i = XFASTINT (Frandom (make_number (999999))); AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i)); diff --git a/src/fileio.c b/src/fileio.c index 31fd84512e..b7e3b71a47 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -97,6 +97,7 @@ along with GNU Emacs. If not, see . */ #include #include #include +#include #include @@ -655,149 +656,67 @@ In Unix-syntax, this function just removes the final slash. */) return val; } -static const char make_temp_name_tbl[64] = -{ - 'A','B','C','D','E','F','G','H', - 'I','J','K','L','M','N','O','P', - 'Q','R','S','T','U','V','W','X', - 'Y','Z','a','b','c','d','e','f', - 'g','h','i','j','k','l','m','n', - 'o','p','q','r','s','t','u','v', - 'w','x','y','z','0','1','2','3', - '4','5','6','7','8','9','-','_' -}; - -static unsigned make_temp_name_count, make_temp_name_count_initialized_p; - -/* Value is a temporary file name starting with PREFIX, a string. +DEFUN ("make-temp-file-internal", Fmake_temp_file_internal, + Smake_temp_file_internal, 3, 3, 0, + doc: /* Generate a new file whose name starts with PREFIX, a string. +Return the name of the generated file. If DIR-FLAG is zero, do not +create the file, just its name. Otherwise, if DIR-FLAG is non-nil, +create an empty directory. The file name should end in SUFFIX. - The Emacs process number forms part of the result, so there is - no danger of generating a name being used by another process. - In addition, this function makes an attempt to choose a name - which has no existing file. To make this work, PREFIX should be - an absolute file name. +Signal an error if the file could not be created. - BASE64_P means add the pid as 3 characters in base64 - encoding. In this case, 6 characters will be added to PREFIX to - form the file name. Otherwise, if Emacs is running on a system - with long file names, add the pid as a decimal number. - - This function signals an error if no unique file name could be - generated. */ - -Lisp_Object -make_temp_name (Lisp_Object prefix, bool base64_p) +This function does not grok magic file names. */) + (Lisp_Object prefix, Lisp_Object dir_flag, Lisp_Object suffix) { - Lisp_Object val, encoded_prefix; - ptrdiff_t len; - printmax_t pid; - char *p, *data; - char pidbuf[INT_BUFSIZE_BOUND (printmax_t)]; - int pidlen; - - CHECK_STRING (prefix); - - /* VAL is created by adding 6 characters to PREFIX. The first - three are the PID of this process, in base 64, and the second - three are incremented if the file already exists. This ensures - 262144 unique file names per PID per PREFIX. */ - - pid = getpid (); - - if (base64_p) - { - pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidlen = 3; - } - else + bool make_temp_name = EQ (dir_flag, make_number (0)); + CHECK_STRING (suffix); + if (!make_temp_name) + prefix = Fexpand_file_name (prefix, Vtemporary_file_directory); + + Lisp_Object encoded_prefix = ENCODE_FILE (prefix); + Lisp_Object encoded_suffix = ENCODE_FILE (suffix); + ptrdiff_t prefix_len = SBYTES (encoded_prefix); + ptrdiff_t suffix_len = SBYTES (encoded_suffix); + if (INT_MAX < suffix_len) + args_out_of_range (prefix, suffix); + int nX = 6; + Lisp_Object val = make_uninit_string (prefix_len + nX + suffix_len); + char *data = SSDATA (val); + memcpy (data, SSDATA (encoded_prefix), prefix_len); + memset (data + prefix_len, 'X', nX); + memcpy (data + prefix_len + nX, SSDATA (encoded_suffix), suffix_len); + int kind = (NILP (dir_flag) ? GT_FILE + : make_temp_name ? GT_NOCREATE + : GT_DIR); + int fd = gen_tempname (data, suffix_len, O_BINARY | O_CLOEXEC, kind); + if (fd < 0 || (NILP (dir_flag) && emacs_close (fd) != 0)) { -#ifdef HAVE_LONG_FILE_NAMES - pidlen = sprintf (pidbuf, "%"pMd, pid); -#else - pidbuf[0] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidbuf[1] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidbuf[2] = make_temp_name_tbl[pid & 63], pid >>= 6; - pidlen = 3; -#endif - } - - encoded_prefix = ENCODE_FILE (prefix); - len = SBYTES (encoded_prefix); - val = make_uninit_string (len + 3 + pidlen); - data = SSDATA (val); - memcpy (data, SSDATA (encoded_prefix), len); - p = data + len; - - memcpy (p, pidbuf, pidlen); - p += pidlen; - - /* Here we try to minimize useless stat'ing when this function is - invoked many times successively with the same PREFIX. We achieve - this by initializing count to a random value, and incrementing it - afterwards. - - We don't want make-temp-name to be called while dumping, - because then make_temp_name_count_initialized_p would get set - and then make_temp_name_count would not be set when Emacs starts. */ - - if (!make_temp_name_count_initialized_p) - { - make_temp_name_count = time (NULL); - make_temp_name_count_initialized_p = 1; - } - - while (1) - { - unsigned num = make_temp_name_count; - - p[0] = make_temp_name_tbl[num & 63], num >>= 6; - p[1] = make_temp_name_tbl[num & 63], num >>= 6; - p[2] = make_temp_name_tbl[num & 63], num >>= 6; - - /* Poor man's congruential RN generator. Replace with - ++make_temp_name_count for debugging. */ - make_temp_name_count += 25229; - make_temp_name_count %= 225307; - - if (!check_existing (data)) + static char const kind_message[][32] = { - /* We want to return only if errno is ENOENT. */ - if (errno == ENOENT) - return DECODE_FILE (val); - else - /* The error here is dubious, but there is little else we - can do. The alternatives are to return nil, which is - as bad as (and in many cases worse than) throwing the - error, or to ignore the error, which will likely result - in looping through 225307 stat's, which is not only - dog-slow, but also useless since eventually nil would - have to be returned anyway. */ - report_file_error ("Cannot create temporary name for prefix", - prefix); - /* not reached */ - } + [GT_FILE] = "Creating file with prefix", + [GT_DIR] = "Creating directory with prefix", + [GT_NOCREATE] = "Creating file name with prefix" + }; + report_file_error (kind_message[kind], prefix); } + return DECODE_FILE (val); } DEFUN ("make-temp-name", Fmake_temp_name, Smake_temp_name, 1, 1, 0, doc: /* Generate temporary file name (string) starting with PREFIX (a string). -The Emacs process number forms part of the result, so there is no -danger of generating a name being used by another Emacs process -\(so long as only a single host can access the containing directory...). This function tries to choose a name that has no existing file. For this to work, PREFIX should be an absolute file name, and PREFIX and the returned string should both be non-magic. -There is a race condition between calling `make-temp-name' and creating the -file, which opens all kinds of security holes. For that reason, you should -normally use `make-temp-file' instead. */) +There is a race condition between calling `make-temp-name' and +later creating the file, which opens all kinds of security holes. +For that reason, you should normally use `make-temp-file' instead. */) (Lisp_Object prefix) { - return make_temp_name (prefix, 0); + return Fmake_temp_file_internal (prefix, make_number (0), + empty_unibyte_string); } DEFUN ("expand-file-name", Fexpand_file_name, Sexpand_file_name, 1, 2, 0, @@ -6168,6 +6087,7 @@ This includes interactive calls to `delete-file' and defsubr (&Sfile_name_as_directory); defsubr (&Sdirectory_name_p); defsubr (&Sdirectory_file_name); + defsubr (&Smake_temp_file_internal); defsubr (&Smake_temp_name); defsubr (&Sexpand_file_name); defsubr (&Ssubstitute_in_file_name); diff --git a/src/filelock.c b/src/filelock.c index dd8cb28c42..3d6941695a 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -206,14 +206,11 @@ get_boot_time (void) WTMP_FILE, counter); if (! NILP (Ffile_exists_p (tempname))) { - /* The utmp functions on mescaline.gnu.org accept only - file names up to 8 characters long. Choose a 2 - character long prefix, and call make_temp_file with - second arg non-zero, so that it will add not more - than 6 characters to the prefix. */ - filename = Fexpand_file_name (build_string ("wt"), - Vtemporary_file_directory); - filename = make_temp_name (filename, 1); + /* The utmp functions on older systems accept only file + names up to 8 bytes long. Choose a 2 byte prefix, so + the 6-byte suffix does not make the name too long. */ + filename = Fmake_temp_file_internal (build_string ("wt"), Qnil, + empty_unibyte_string); CALLN (Fcall_process, build_string ("gzip"), Qnil, list2 (QCfile, filename), Qnil, build_string ("-cd"), tempname); diff --git a/src/lisp.h b/src/lisp.h index 25be5c0cee..48cf3b3070 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4014,7 +4014,6 @@ extern bool file_directory_p (const char *); extern bool file_accessible_directory_p (Lisp_Object); extern void init_fileio (void); extern void syms_of_fileio (void); -extern Lisp_Object make_temp_name (Lisp_Object, bool); /* Defined in search.c. */ extern void shrink_regexp_cache (void); commit 9eb30cb03613ae158c870d603a05a6a6393dc485 Author: Paul Eggert Date: Sat Aug 12 10:54:32 2017 -0700 Document internal-use naming conventions * doc/lispref/functions.texi (Function Names): * doc/lispref/variables.texi (Tips for Defining): Document naming conventions for internal-use functions and vars. See Bug#28023#59. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 283f74ff5d..06de2e2f73 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -544,6 +544,15 @@ variable; these two uses of a symbol are independent and do not conflict. (This is not the case in some dialects of Lisp, like Scheme.) + By convention, if a function's symbol consists of two names +separated by @samp{--}, the function is intended for internal use and +the first part names the file defining the function. For example, a +function named @code{vc-git--rev-parse} is an internal function +defined in @file{vc-git.el}. Internal-use functions written in C have +names ending in @samp{-internal}, e.g., @code{bury-buffer-internal}. +Emacs code contributed before 2018 may follow other internal-use +naming conventions, which are being phased out. + @node Defining Functions @section Defining Functions @cindex defining a function diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 2818ea067d..7650ed4e3d 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -574,6 +574,16 @@ The value is a whole shell command. @item @dots{}-switches The value specifies options for a command. + +@item @var{prefix}--@dots{} +The variable is intended for internal use and is defined in the file +@file{@var{prefix}.el}. (Emacs code contributed before 2018 may +follow other conventions, which are being phased out.) + +@item @dots{}-internal +The variable is intended for internal use and is defined in C code. +(Emacs code contributed before 2018 may follow other conventions, +which are being phased out.) @end table When you define a variable, always consider whether you should mark commit 81e22163ebce94d4a3f77e089ee86b8efc6a36f4 Author: Paul Eggert Date: Sat Aug 12 09:06:55 2017 -0700 Simplify re and document 'autoconf.sh all' * GNUmakefile (ALL_IF_GIT): Remove; no longer needed, now that ./autogen.sh defaults to "all". All uses removed. * README: Mention autoconf.sh's effect on Git configuration. diff --git a/GNUmakefile b/GNUmakefile index 98d31f4afc..304a7b34f3 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -62,13 +62,10 @@ default $(ORDINARY_GOALS): Makefile # Execute in sequence, so that multiple user goals don't conflict. .NOTPARALLEL: -# 'all' if a .git subdirectory is present, empty otherwise. -ALL_IF_GIT = $(subst .git,all,$(wildcard .git)) - configure: @echo >&2 'There seems to be no "configure" file in this directory.' - @echo >&2 Running ./autogen.sh $(ALL_IF_GIT) ... - ./autogen.sh $(ALL_IF_GIT) + @echo >&2 Running ./autogen.sh ... + ./autogen.sh @echo >&2 '"configure" file built.' Makefile: configure diff --git a/README b/README index 494ee08c2b..527e406a63 100644 --- a/README +++ b/README @@ -45,7 +45,8 @@ The file 'configure.ac' is the input used by the autoconf program to construct the 'configure' script. The shell script 'autogen.sh' generates 'configure' and other files by -running Autoconf, which in turn uses GNU m4. If you want to use it, +running Autoconf (which in turn uses GNU m4), and configures files in +the .git subdirectory if you are using Git. If you want to use it, you will need to install recent versions of these build tools. This should be needed only if you edit files like 'configure.ac' that specify Emacs's autobuild procedure. commit ed9404692f75598c74d3ff6a4003f9373a5404f9 Author: Paul Eggert Date: Sat Aug 12 08:56:52 2017 -0700 Default autogen.sh to 'all' This addresses a problem noted by RMS in: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00052.html * autogen.sh (do_git): Set to true if this script is invoked with no arguments and there is a .git subdirectory. diff --git a/CONTRIBUTE b/CONTRIBUTE index 365e423249..9b5fb090e7 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -14,7 +14,7 @@ Briefly, the following shell commands build and run Emacs from scratch: git config --global transfer.fsckObjects true git clone git://git.sv.gnu.org/emacs.git cd emacs - ./autogen.sh all + ./autogen.sh ./configure make src/emacs diff --git a/INSTALL.REPO b/INSTALL.REPO index ce346bb246..e7bb3bba03 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -19,7 +19,7 @@ To use the autotools, run the following shell command to generate the 'configure' script and some related files, and to set up your git configuration: - $ ./autogen.sh all + $ ./autogen.sh You can then configure your build as follows: diff --git a/autogen.sh b/autogen.sh index 76fde9e18d..70f9cbd245 100755 --- a/autogen.sh +++ b/autogen.sh @@ -127,7 +127,8 @@ done case $do_autoconf,$do_git in false,false) - do_autoconf=true;; + do_autoconf=true + test -e .git && do_git=true;; esac # Generate Autoconf-related files, if requested. commit bbf52c142afbb9e10bf2ae20b3c77993fda26b43 Author: Paul Eggert Date: Sat Aug 12 08:52:25 2017 -0700 Adjust jka-compr to recent Tramp changes. * lisp/jka-compr.el (jka-compr-write-region): Two new args LOCKNAME and MUSTBENEW. diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el index 26a7cf506f..9e780f82b3 100644 --- a/lisp/jka-compr.el +++ b/lisp/jka-compr.el @@ -252,7 +252,8 @@ There should be no more than seven characters after the final `/'." "This routine will return the name of a new file." (make-temp-file jka-compr-temp-name-template)) -(defun jka-compr-write-region (start end file &optional append visit) +(defun jka-compr-write-region (start end file &optional + append visit lockname mustbenew) (let* ((filename (expand-file-name file)) (visit-file (if (stringp visit) (expand-file-name visit) filename)) (info (jka-compr-get-compression-info visit-file)) @@ -334,7 +335,8 @@ There should be no more than seven characters after the final `/'." (jka-compr-run-real-handler 'write-region (list (point-min) (point-max) filename - (and append can-append) 'dont)) + (and append can-append) 'dont + lockname mustbenew)) (erase-buffer)) ) (delete-file temp-file) @@ -365,7 +367,8 @@ There should be no more than seven characters after the final `/'." nil) (jka-compr-run-real-handler 'write-region - (list start end filename append visit))))) + (list start end filename append visit + lockname mustbenew))))) (defun jka-compr-insert-file-contents (file &optional visit beg end replace) commit a685d9d7591df5b85c433940bbfaad283a82c495 Author: Eli Zaretskii Date: Sat Aug 12 15:11:16 2017 +0300 Improve doc strings of 2 functions in simple.el * lisp/simple.el (beginning-of-visual-line) (move-beginning-of-line): Doc fix. Reported by Justin Burkett . diff --git a/lisp/simple.el b/lisp/simple.el index 933ffc55a6..16f69f2bbe 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6622,6 +6622,8 @@ which are part of the text that the image rests on.) With argument ARG not nil or 1, move forward ARG - 1 lines first. If point reaches the beginning or end of buffer, it stops there. +\(But if the buffer doesn't end in a newline, it stops at the +beginning of the last line.) To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (interactive "^p") (or arg (setq arg 1)) @@ -6710,6 +6712,8 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." "Move point to beginning of current visual line. With argument N not nil or 1, move forward N - 1 visual lines first. If point reaches the beginning or end of buffer, it stops there. +\(But if the buffer doesn't end in a newline, it stops at the +beginning of the last visual line.) To ignore intangibility, bind `inhibit-point-motion-hooks' to t." (interactive "^p") (or n (setq n 1)) commit fce2b2d2b40a1c0505d1ad623baef76f726c436a Author: Eli Zaretskii Date: Sat Aug 12 14:44:20 2017 +0300 Fix completion on directory names on MS-DOS/MS-Windows * src/msdos.c (faccessat): * src/w32.c (faccessat): Support relative file names, and add D_OK to 'mode' if the argument is a directory. This unbreaks file-name completion when the completion result is a directory. diff --git a/src/msdos.c b/src/msdos.c index 87b6f84148..5b025753d9 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -3950,10 +3950,23 @@ faccessat (int dirfd, const char * path, int mode, int flags) && !(IS_DIRECTORY_SEP (path[0]) || IS_DEVICE_SEP (path[1]))) { - errno = EBADF; - return -1; + char lastc = dir_pathname[strlen (dir_pathname) - 1]; + + if (strlen (dir_pathname) + strlen (path) + IS_DIRECTORY_SEP (lastc) + >= MAXPATHLEN) + { + errno = ENAMETOOLONG; + return -1; + } + + sprintf (fullname, "%s%s%s", + dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", path); + path = fullname; } + if ((mode & F_OK) != 0 && IS_DIRECTORY_SEP (path[strlen (path) - 1])) + mode |= D_OK; + return access (path, mode); } diff --git a/src/w32.c b/src/w32.c index bdeaed0675..c5b51bb6b0 100644 --- a/src/w32.c +++ b/src/w32.c @@ -3887,15 +3887,30 @@ int faccessat (int dirfd, const char * path, int mode, int flags) { DWORD attributes; + char fullname[MAX_UTF8_PATH]; + /* Rely on a hack: an open directory is modeled as file descriptor 0, + and its actual file name is stored in dir_pathname by opendir. + This is good enough for the current usage in Emacs, but is fragile. */ if (dirfd != AT_FDCWD && !(IS_DIRECTORY_SEP (path[0]) || IS_DEVICE_SEP (path[1]))) { - errno = EBADF; - return -1; + char lastc = dir_pathname[strlen (dir_pathname) - 1]; + + if (_snprintf (fullname, sizeof fullname, "%s%s%s", + dir_pathname, IS_DIRECTORY_SEP (lastc) ? "" : "/", path) + < 0) + { + errno = ENAMETOOLONG; + return -1; + } + path = fullname; } + if (IS_DIRECTORY_SEP (path[strlen (path) - 1]) && (mode & F_OK) != 0) + mode |= D_OK; + /* MSVCRT implementation of 'access' doesn't recognize D_OK, and its newer versions blow up when passed D_OK. */ path = map_w32_filename (path, NULL); commit ec5cfaa4568327b5b0b299be2664f7fdae123292 Author: Michael Albinus Date: Sat Aug 12 12:30:39 2017 +0200 Implement EXCL of write-region for Tramp * lisp/net/ange-ftp.el (ange-ftp-write-region): * lisp/net/tramp-adb.el (tramp-adb-handle-write-region) * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region) * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Implement MUSTBENEW. * lisp/net/tramp-gvfs.el (tramp-gvfs-do-copy-or-rename-file) * lisp/net/tramp-sh.el (tramp-sh-handle-make-symbolic-link) (tramp-sh-handle-add-name-to-file) (tramp-do-copy-or-rename-file) * lisp/net/tramp-smb.el (tramp-smb-handle-make-symbolic-link): Adapt error message for `file-already-exists'. * src/lisp.h: * src/eval.c (call8): New function. * src/fileio.c (write_region): Pass also lockname and mustbenew to the file name handler. * test/lisp/net/tramp-tests.el (tramp-test10-write-region): Add tests for MUSTBENEW. diff --git a/etc/NEWS b/etc/NEWS index 0670a7bbf9..3f38153048 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1200,6 +1200,10 @@ particular, the function 'internal--module-call' has been removed. Code that depends on undocumented internals of the module system might break. +--- +** The arguments LOCKNAME and MUSTBENEW of 'write-region' are +propagated to file name handlers now. + * Lisp Changes in Emacs 26.1 diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index ecb60e5a4f..ebc14693f6 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -3223,8 +3223,12 @@ system TYPE.") (defun ange-ftp-binary-file (file) (string-match-p ange-ftp-binary-file-name-regexp file)) -(defun ange-ftp-write-region (start end filename &optional append visit) +(defun ange-ftp-write-region + (start end filename &optional append visit _lockname mustbenew) (setq filename (expand-file-name filename)) + (when mustbenew + (ange-ftp-barf-or-query-if-file-exists + filename "overwrite" (not (eq mustbenew 'excl)))) (let ((parsed (ange-ftp-ftp-name filename))) (if parsed (let* ((host (nth 0 parsed)) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 346979000f..6e662df6e2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -630,14 +630,17 @@ But handle the case, if the \"test\" command is not available." rw-path))))))) (defun tramp-adb-handle-write-region - (start end filename &optional append visit lockname confirm) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (and confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " - filename)) - (tramp-error v 'file-error "File not overwritten"))) + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (tramp-error v 'file-already-exists filename)) + ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-property v (file-name-directory localname)) @@ -650,8 +653,7 @@ But handle the case, if the \"test\" command is not available." tmpfile (logior (or (file-modes tmpfile) 0) (string-to-number "0600" 8)))) (tramp-run-real-handler - 'write-region - (list start end tmpfile append 'no-message lockname confirm)) + 'write-region (list start end tmpfile append 'no-message lockname)) (with-tramp-progress-reporter v 3 (format-message "Moving tmp file `%s' to `%s'" tmpfile filename) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 4c750df3c4..48f50a3d05 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -658,8 +658,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error - v 'file-already-exists "File %s already exists" newname)) + (tramp-error v 'file-already-exists newname)) (if (or (and equal-remote (tramp-get-connection-property v "direct-copy-failed" nil)) @@ -1172,12 +1171,16 @@ file-notify events." 'rename-file (list filename newname ok-if-already-exists)))) (defun tramp-gvfs-handle-write-region - (start end filename &optional append visit lockname confirm) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." + (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (and confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) - (tramp-error v 'file-error "File not overwritten"))) + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (tramp-error v 'file-already-exists filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) @@ -1186,10 +1189,7 @@ file-notify events." ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. (tramp-run-real-handler - 'write-region - (if confirm ; don't pass this arg unless defined for backward compat. - (list start end tmpfile append 'no-message lockname confirm) - (list start end tmpfile append 'no-message lockname))) + 'write-region (list start end tmpfile append 'no-message lockname)) (condition-case nil (rename-file tmpfile filename 'ok-if-already-exists) (error diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 4beb6fe521..6b365c10e2 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1085,8 +1085,7 @@ target of the symlink differ." (format "File %s already exists; make it a link anyway? " l-localname))))) - (tramp-error - l 'file-already-exists "File %s already exists" l-localname) + (tramp-error l 'file-already-exists l-localname) (delete-file linkname))) ;; If FILENAME is a Tramp name, use just the localname component. @@ -1925,9 +1924,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" (format "File %s already exists; make it a new name anyway? " newname))) - (tramp-error - v2 'file-already-exists - "add-name-to-file: file %s already exists" newname)) + (tramp-error v2 'file-already-exists newname)) (when ok-if-already-exists (setq ln (concat ln " -f"))) (tramp-flush-file-property v2 (file-name-directory v2-localname)) (tramp-flush-file-property v2 v2-localname) @@ -2041,8 +2038,7 @@ file names." (with-parsed-tramp-file-name (if t1 filename newname) nil (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error - v 'file-already-exists "File %s already exists" newname)) + (tramp-error v 'file-already-exists newname)) (with-tramp-progress-reporter v 0 (format "%s %s to %s" @@ -3150,23 +3146,16 @@ the result will be a local, non-Tramp, file name." ;; CCC grok LOCKNAME (defun tramp-sh-handle-write-region - (start end filename &optional append visit lockname confirm) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - ;; Following part commented out because we don't know what to do about - ;; file locking, and it does not appear to be a problem to ignore it. - ;; Ange-ftp ignores it, too. - ;; (when (and lockname (stringp lockname)) - ;; (setq lockname (expand-file-name lockname))) - ;; (unless (or (eq lockname nil) - ;; (string= lockname filename)) - ;; (error - ;; "tramp-sh-handle-write-region: LOCKNAME must be nil or equal FILENAME")) - - (when (and confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " filename)) - (tramp-error v 'file-error "File not overwritten"))) + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (tramp-error v 'file-already-exists filename)) (let ((uid (or (tramp-compat-file-attribute-user-id (file-attributes filename 'integer)) @@ -3185,8 +3174,7 @@ the result will be a local, non-Tramp, file name." (file-writable-p localname))))) ;; Short track: if we are on the local host, we can run directly. (tramp-run-real-handler - 'write-region - (list start end localname append 'no-message lockname confirm)) + 'write-region (list start end localname append 'no-message lockname)) (let* ((modes (save-excursion (tramp-default-file-modes filename))) ;; We use this to save the value of @@ -3223,7 +3211,7 @@ the result will be a local, non-Tramp, file name." (condition-case err (tramp-run-real-handler 'write-region - (list start end tmpfile append 'no-message lockname confirm)) + (list start end tmpfile append 'no-message lockname)) ((error quit) (setq tramp-temp-buffer-file-name nil) (delete-file tmpfile) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 1aadd14fb4..367beb823a 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -137,6 +137,7 @@ call, letting the SMB client use the default one." "NT_STATUS_HOST_UNREACHABLE" "NT_STATUS_IMAGE_ALREADY_LOADED" "NT_STATUS_INVALID_LEVEL" + "NT_STATUS_INVALID_PARAMETER_MIX" "NT_STATUS_IO_TIMEOUT" "NT_STATUS_LOGON_FAILURE" "NT_STATUS_NETWORK_ACCESS_DENIED" @@ -1124,9 +1125,7 @@ target of the symlink differ." (format "File %s already exists; make it a new name anyway? " linkname))) - (tramp-error - v2 'file-already-exists - "make-symbolic-link: file %s already exists" linkname)) + (tramp-error v2 'file-already-exists linkname)) (unless (tramp-smb-get-cifs-capabilities v1) (tramp-error v2 'file-error "make-symbolic-link not supported")) ;; We must also flush the cache of the directory, because @@ -1469,14 +1468,17 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (error filename)))) (defun tramp-smb-handle-write-region - (start end filename &optional append visit lockname confirm) + (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." (setq filename (expand-file-name filename)) (with-parsed-tramp-file-name filename nil - (when (and confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " - filename)) - (tramp-error v 'file-error "File not overwritten"))) + (when (and mustbenew (file-exists-p filename) + (or (eq mustbenew 'excl) + (not + (y-or-n-p + (format "File %s exists; overwrite anyway? " filename))))) + (tramp-error v 'file-already-exists filename)) + ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. (tramp-flush-file-property v (file-name-directory localname)) @@ -1489,10 +1491,7 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." ;; modtime data to be clobbered from the temp file. We call ;; `set-visited-file-modtime' ourselves later on. (tramp-run-real-handler - 'write-region - (if confirm ; don't pass this arg unless defined for backward compat. - (list start end tmpfile append 'no-message lockname confirm) - (list start end tmpfile append 'no-message lockname))) + 'write-region (list start end tmpfile append 'no-message lockname)) (with-tramp-progress-reporter v 3 (format "Moving tmp file %s to %s" tmpfile filename) diff --git a/src/eval.c b/src/eval.c index fe2708b1bb..e3e7d8e26b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2660,6 +2660,17 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7); } +/* Call function fn with 8 arguments arg1, arg2, arg3, arg4, arg5, + arg6, arg7, arg8. */ +/* ARGSUSED */ +Lisp_Object +call8 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, + Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7, + Lisp_Object arg8) +{ + return CALLN (Ffuncall, fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8); +} + DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, doc: /* Non-nil if OBJECT is a function. */) (Lisp_Object object) diff --git a/src/fileio.c b/src/fileio.c index 8506a198fe..31fd84512e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -4852,8 +4852,8 @@ write_region (Lisp_Object start, Lisp_Object end, Lisp_Object filename, if (!NILP (handler)) { Lisp_Object val; - val = call6 (handler, Qwrite_region, start, end, - filename, append, visit); + val = call8 (handler, Qwrite_region, start, end, + filename, append, visit, lockname, mustbenew); if (visiting) { diff --git a/src/lisp.h b/src/lisp.h index 4de6fc85ec..25be5c0cee 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3846,6 +3846,7 @@ extern Lisp_Object call4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object call7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); +extern Lisp_Object call8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 50dfd6fac2..45cf95fcfe 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1846,7 +1846,23 @@ This checks also `file-name-as-directory', `file-name-directory', (write-region 3 5 tmp-name)) (with-temp-buffer (insert-file-contents tmp-name) - (should (string-equal (buffer-string) "34")))) + (should (string-equal (buffer-string) "34"))) + + ;; Do not overwrite if excluded. + (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) + (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) + ;; `mustbenew' is passed to Tramp since Emacs 26.1. We + ;; have no test for this, so we check function + ;; `temporary-file-directory', which has been added to + ;; Emacs 26.1 as well. + (when (fboundp 'temporary-file-directory) + (should-error + (cl-letf (((symbol-function 'y-or-n-p) 'ignore)) + (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) + :type 'file-already-exists) + (should-error + (write-region "foo" nil tmp-name nil nil nil 'excl) + :type 'file-already-exists))) ;; Cleanup. (ignore-errors (delete-file tmp-name)))))) commit e94b0d4d54e39b2601b7f3f724d6c6d8a556e89f Author: Eli Zaretskii Date: Sat Aug 12 13:18:13 2017 +0300 Adapt Proced display to display-line-numbers * lisp/proced.el (proced-header-line): Account for the width taken by display-line-numbers. (Bug#27895) diff --git a/lisp/proced.el b/lisp/proced.el index 86d79689a4..be3b7c41a6 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -602,7 +602,9 @@ Important: the match ends just after the marker.") (defun proced-header-line () "Return header line for Proced buffer." - (list (propertize " " 'display '(space :align-to 0)) + (list (propertize " " + 'display + (list 'space :align-to (+ 2 (line-number-display-width)))) (if (<= (window-hscroll) (length proced-header-line)) (replace-regexp-in-string ;; preserve text properties "\\(%\\)" "\\1\\1" commit a955d7951624bf38649448dc89b411e8212dec0b Author: Eli Zaretskii Date: Sat Aug 12 12:45:05 2017 +0300 Adapt tabulated list when display-line-number is turned on * lisp/emacs-lisp/tabulated-list.el (tabulated-list-mode): Add a hook to revert the display when display-line-numbers is turned on. (Bug#27895) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index b91532f7e8..955b664b8c 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -628,7 +628,9 @@ as the ewoc pretty-printer." (setq-local glyphless-char-display tabulated-list-glyphless-char-display) ;; Avoid messing up the entries' display just because the first ;; column of the first entry happens to begin with a R2L letter. - (setq bidi-paragraph-direction 'left-to-right)) + (setq bidi-paragraph-direction 'left-to-right) + ;; This is for if/when they turn on display-line-numbers + (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t)) (put 'tabulated-list-mode 'mode-class 'special) commit 8cc8ad02bd5c410c61680735149ce7caf67f088d Author: Eli Zaretskii Date: Sat Aug 12 11:29:37 2017 +0300 Use Gnulib 'tempname' on MS-Windows * lib-src/ntlib.h (mkdir, open): Remove redefinitions. They are now in nt/inc/ms-w32.h. * lib-src/ntlib.c (sys_mkdir, sys_open): New functions. (mkostemp): Remove. * src/w32.c (mkostemp): Remove. (sys_mkdir): Accept a second (unused) argument. * src/fileio.c (Fmake_directory_internal): Remove the WINDOWSNT specific call to mkdir. (Bug#28023) * nt/inc/ms-w32.h (mkdir): Remove from "#ifdef emacs" and redefine to accept 2 arguments. (open): Remove from "#ifdef emacs". * nt/mingw-cfg.site (ac_cv_func_mkostemp): Remove. * nt/gnulib-cfg.mk (OMIT_GNULIB_MODULE_mkostemp) (OMIT_GNULIB_MODULE_tempname): Remove. diff --git a/lib-src/ntlib.c b/lib-src/ntlib.c index 78ba9061f6..9908f0fa45 100644 --- a/lib-src/ntlib.c +++ b/lib-src/ntlib.c @@ -36,9 +36,11 @@ along with GNU Emacs. If not, see . */ char *sys_ctime (const time_t *); FILE *sys_fopen (const char *, const char *); +int sys_mkdir (const char *, mode_t); int sys_chdir (const char *); int mkostemp (char *, int); int sys_rename (const char *, const char *); +int sys_open (const char *, int, int); /* MinGW64 defines _TIMEZONE_DEFINED and defines 'struct timespec' in its system headers. */ @@ -245,6 +247,12 @@ sys_chdir (const char * path) return _chdir (path); } +int +sys_mkdir (const char * path, mode_t mode) +{ + return _mkdir (path); +} + static FILETIME utc_base_ft; static long double utc_base; static int init = 0; @@ -396,61 +404,6 @@ lstat (const char * path, struct stat * buf) return stat (path, buf); } -/* Implementation of mkostemp for MS-Windows, to avoid race conditions - when using mktemp. Copied from w32.c. - - This is used only in update-game-score.c. It is overkill for that - use case, since update-game-score renames the temporary file into - the game score file, which isn't atomic on MS-Windows anyway, when - the game score already existed before running the program, which it - almost always does. But using a simpler implementation just to - make a point is uneconomical... */ - -int -mkostemp (char * template, int flags) -{ - char * p; - int i, fd = -1; - unsigned uid = GetCurrentThreadId (); - int save_errno = errno; - static char first_char[] = "abcdefghijklmnopqrstuvwyz0123456789!%-_@#"; - - errno = EINVAL; - if (template == NULL) - return -1; - - p = template + strlen (template); - i = 5; - /* replace up to the last 5 X's with uid in decimal */ - while (--p >= template && p[0] == 'X' && --i >= 0) - { - p[0] = '0' + uid % 10; - uid /= 10; - } - - if (i < 0 && p[0] == 'X') - { - i = 0; - do - { - p[0] = first_char[i]; - if ((fd = open (template, - flags | _O_CREAT | _O_EXCL | _O_RDWR, - S_IRUSR | S_IWUSR)) >= 0 - || errno != EEXIST) - { - if (fd >= 0) - errno = save_errno; - return fd; - } - } - while (++i < sizeof (first_char)); - } - - /* Template is badly formed or else we can't generate a unique name. */ - return -1; -} - /* On Windows, you cannot rename into an existing file. */ int sys_rename (const char *from, const char *to) @@ -464,3 +417,9 @@ sys_rename (const char *from, const char *to) } return retval; } + +int +sys_open (const char * path, int oflag, int mode) +{ + return _open (path, oflag, mode); +} diff --git a/lib-src/ntlib.h b/lib-src/ntlib.h index 32189dcc7a..b69a40b4f0 100644 --- a/lib-src/ntlib.h +++ b/lib-src/ntlib.h @@ -58,10 +58,6 @@ int fchown (int fd, unsigned uid, unsigned gid); #undef dup2 #define dup2 _dup2 #undef fopen -#undef mkdir -#define mkdir _mkdir -#undef open -#define open _open #undef pipe #define pipe _pipe #undef read diff --git a/nt/gnulib-cfg.mk b/nt/gnulib-cfg.mk index 175329fb9e..d2b96f99e2 100644 --- a/nt/gnulib-cfg.mk +++ b/nt/gnulib-cfg.mk @@ -50,7 +50,6 @@ OMIT_GNULIB_MODULE_dirfd = true OMIT_GNULIB_MODULE_fcntl = true OMIT_GNULIB_MODULE_fcntl-h = true OMIT_GNULIB_MODULE_inttypes-incomplete = true -OMIT_GNULIB_MODULE_mkostemp = true OMIT_GNULIB_MODULE_pipe2 = true OMIT_GNULIB_MODULE_secure_getenv = true OMIT_GNULIB_MODULE_signal-h = true @@ -60,5 +59,4 @@ OMIT_GNULIB_MODULE_sys_select = true OMIT_GNULIB_MODULE_sys_stat = true OMIT_GNULIB_MODULE_sys_time = true OMIT_GNULIB_MODULE_sys_types = true -OMIT_GNULIB_MODULE_tempname = true OMIT_GNULIB_MODULE_unistd = true diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 957d8c6bdb..e1dbe29bbb 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -237,9 +237,6 @@ extern void w32_reset_stack_overflow_guard (void); #define fopen sys_fopen #define link sys_link #define localtime sys_localtime -#define mkdir sys_mkdir -#undef open -#define open sys_open #undef read #define read sys_read #define rename sys_rename @@ -289,6 +286,10 @@ extern int sys_umask (int); #endif /* emacs */ +/* Used both in Emacs, in lib-src, and in Gnulib. */ +#undef open +#define open sys_open + /* Map to MSVC names. */ #define execlp _execlp #define execvp _execvp @@ -465,6 +466,12 @@ extern char *get_emacs_configuration_options (void); #include #endif +/* Needed in Emacs and in Gnulib. */ +/* This must be after including sys/stat.h, because we need mode_t. */ +#undef mkdir +#define mkdir(d,f) sys_mkdir(d,f) +int sys_mkdir (const char *, mode_t); + #ifdef emacs typedef void * (* malloc_fn)(size_t); @@ -518,9 +525,9 @@ extern int getpagesize (void); extern void * memrchr (void const *, int, size_t); +/* Declared here, since we don't use Gnulib's stdlib.h. */ extern int mkostemp (char *, int); - #if defined (__MINGW32__) /* Define to 1 if the system has the type `long long int'. */ diff --git a/nt/mingw-cfg.site b/nt/mingw-cfg.site index a106717979..d9a824008c 100644 --- a/nt/mingw-cfg.site +++ b/nt/mingw-cfg.site @@ -79,7 +79,6 @@ ac_cv_func_getaddrinfo=yes # Implemented as an inline function in ws2tcpip.h ac_cv_func_gai_strerror=yes # Implemented in w32.c -ac_cv_func_mkostemp=yes ac_cv_func_readlink=yes ac_cv_func_symlink=yes # Avoid run-time tests of readlink and symlink, which will fail diff --git a/src/fileio.c b/src/fileio.c index 9aae7d997e..8506a198fe 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2178,11 +2178,7 @@ DEFUN ("make-directory-internal", Fmake_directory_internal, dir = SSDATA (encoded_dir); -#ifdef WINDOWSNT - if (mkdir (dir) != 0) -#else if (mkdir (dir, 0777 & ~auto_saving_dir_umask) != 0) -#endif report_file_error ("Creating directory", directory); return Qnil; diff --git a/src/w32.c b/src/w32.c index fa3cbe183f..bdeaed0675 100644 --- a/src/w32.c +++ b/src/w32.c @@ -74,7 +74,6 @@ char *sys_ctime (const time_t *); int sys_chdir (const char *); int sys_creat (const char *, int); FILE *sys_fopen (const char *, const char *); -int sys_mkdir (const char *); int sys_open (const char *, int, int); int sys_rename (char const *, char const *); int sys_rmdir (const char *); @@ -4344,7 +4343,7 @@ sys_link (const char * old, const char * new) } int -sys_mkdir (const char * path) +sys_mkdir (const char * path, mode_t mode) { path = map_w32_filename (path, NULL); @@ -4397,61 +4396,6 @@ sys_open (const char * path, int oflag, int mode) return res; } -/* Implementation of mkostemp for MS-Windows, to avoid race conditions - when using mktemp. - - Standard algorithm for generating a temporary file name seems to be - use pid or tid with a letter on the front (in place of the 6 X's) - and cycle through the letters to find a unique name. We extend - that to allow any reasonable character as the first of the 6 X's, - so that the number of simultaneously used temporary files will be - greater. */ - -int -mkostemp (char * template, int flags) -{ - char * p; - int i, fd = -1; - unsigned uid = GetCurrentThreadId (); - int save_errno = errno; - static char first_char[] = "abcdefghijklmnopqrstuvwyz0123456789!%-_@#"; - - errno = EINVAL; - if (template == NULL) - return -1; - - p = template + strlen (template); - i = 5; - /* replace up to the last 5 X's with uid in decimal */ - while (--p >= template && p[0] == 'X' && --i >= 0) - { - p[0] = '0' + uid % 10; - uid /= 10; - } - - if (i < 0 && p[0] == 'X') - { - i = 0; - do - { - p[0] = first_char[i]; - if ((fd = sys_open (template, - flags | _O_CREAT | _O_EXCL | _O_RDWR, - S_IRUSR | S_IWUSR)) >= 0 - || errno != EEXIST) - { - if (fd >= 0) - errno = save_errno; - return fd; - } - } - while (++i < sizeof (first_char)); - } - - /* Template is badly formed or else we can't generate a unique name. */ - return -1; -} - int fchmod (int fd, mode_t mode) { commit 84288cf4211a4490c0155d3c0022617b92294f49 Author: Alexander Gramiak Date: Sat Aug 12 10:12:36 2017 +0300 Add new face 'header-line-highlight' * lisp/faces.el: Define the face. * lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header): * lisp/info.el (Info-fontify-node): Use the new face. * doc/emacs/display.texi (Standard Faces): * etc/NEWS: Document the new face. (Bug#28033) diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 083fcdf97a..45cfb950f0 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -711,6 +711,12 @@ Similar to @code{mode-line} for a window's header line, which appears at the top of a window just as the mode line appears at the bottom. Most windows do not have a header line---only some special modes, such Info mode, create one. +@item header-line-highlight +@cindex header-line-highlight face +Similar to @code{highlight} and @code{mode-line-highlight}, but used +for mouse-sensitive portions of text on header lines. This is a +separate face because the @code{header-line} face might be customized +in a way that does not interact well with @code{highlight}. @item vertical-border @cindex vertical-border face This face is used for the vertical divider between windows on text diff --git a/etc/NEWS b/etc/NEWS index 2b789be3c8..0670a7bbf9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -254,6 +254,12 @@ face instead of the 'escape-glyph' face. ** Approximations to quotes are now displayed with the new 'homoglyph' face instead of the 'escape-glyph' face. ++++ +** New face 'header-line-highlight'. +This face is the header-line analogue of 'mode-line-highlight'; it +should be the preferred mouse-face for mouse-sensitive elements in the +header line. + --- ** 'C-x h' ('mark-whole-buffer') will now avoid marking the prompt part of minibuffers. diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 8ff5cdf18e..b91532f7e8 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -191,7 +191,7 @@ Populated by `tabulated-list-init-header'.") ;; FIXME: Should share code with tabulated-list-print-col! (let ((x (max tabulated-list-padding 0)) (button-props `(help-echo "Click to sort by column" - mouse-face highlight + mouse-face header-line-highlight keymap ,tabulated-list-sort-button-map)) (cols nil)) (if display-line-numbers diff --git a/lisp/faces.el b/lisp/faces.el index 5ed11d11ce..01d94d7aae 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2628,6 +2628,11 @@ Use the face `mode-line-highlight' for features that can be selected." :version "21.1" :group 'basic-faces) +(defface header-line-highlight '((t :inherit highlight)) + "Basic header line face for highlighting." + :version "26.1" + :group 'basic-faces) + (defface vertical-border '((((type tty)) :inherit mode-line-inactive)) "Face used for vertical window dividers on ttys." diff --git a/lisp/info.el b/lisp/info.el index c7f0bbf08d..45a9116e06 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4654,7 +4654,7 @@ first line or header line, and for breadcrumb links.") (if (string-equal (downcase tag) "node") (put-text-property nbeg nend 'font-lock-face 'info-header-node) (put-text-property nbeg nend 'font-lock-face 'info-header-xref) - (put-text-property tbeg nend 'mouse-face 'highlight) + (put-text-property tbeg nend 'mouse-face 'header-line-highlight) (put-text-property tbeg nend 'help-echo (concat "mouse-2: Go to node " commit 19d2b4a3e2eb900158f0e78864d971b44cc8ea89 Author: Arash Esbati Date: Fri Aug 11 23:57:35 2017 +0200 Make a case-sensitive match for strings * lisp/textmodes/reftex.el (reftex-typekey-check): Temporarily let-bind `case-fold-search' to nil in order to be case-sensitive when matching a string. (Bug#27518) diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index 9754d2b20f..d46bd0dacd 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -1496,7 +1496,8 @@ When DIE is non-nil, throw an error if file not found." (and n (setq conf-variable (nth n conf-variable))) (or (eq conf-variable t) (and (stringp conf-variable) - (string-match (concat "[" conf-variable "]") typekey)))) + (let ((case-fold-search nil)) + (string-match (concat "[" conf-variable "]") typekey))))) (defun reftex-check-recursive-edit () ;; Check if we are already in a recursive edit. Abort with helpful commit e3ed43f4ac667d39fffcc48cfbe97b074f9aa5c7 Author: Stephen Berman Date: Fri Aug 11 11:28:57 2017 +0200 Fix a minor todo-mode regression * lisp/calendar/todo-mode.el (todo-get-overlay): Wrap in save-excursion. This fixes a regression introduced by the fix for bug#27609, whereby trying to raise the priority of the first item or lower the priority of the last item, which should be noops, moves point to the item's start. Clarify comment. * test/lisp/calendar/todo-mode-tests.el (todo-test-raise-lower-priority): Add test cases for trying to raise first item and lower last item. (with-todo-test): Clear abbreviated-home-dir, since we change HOME. (todo-test-toggle-item-header02): Remove ":expected-result :failed" and tests of point after todo-next-item, since the effect when using Todo mode is not reproducible in the test environment. Add commentary about this. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index e39fee5bfa..ba7389c07a 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -5381,20 +5381,21 @@ marked) not done todo items." (defun todo-get-overlay (val) "Return the overlay at point whose `todo' property has value VAL." - ;; When headers are hidden, the display engine makes item's start - ;; inaccessible to commands, so go there here, if necessary, in - ;; order to check for prefix and header overlays. - (when (memq val '(prefix header)) - (unless (looking-at todo-item-start) (todo-item-start))) - ;; Use overlays-in to find prefix overlays and check over two - ;; positions to find done separator overlay. - (let ((ovs (overlays-in (point) (1+ (point)))) - ov) - (catch 'done - (while ovs - (setq ov (pop ovs)) - (when (eq (overlay-get ov 'todo) val) - (throw 'done ov)))))) + (save-excursion + ;; When headers are hidden, the display engine makes item's start + ;; inaccessible to commands, so then we have to go there + ;; non-interactively to check for prefix and header overlays. + (when (memq val '(prefix header)) + (unless (looking-at todo-item-start) (todo-item-start))) + ;; Use overlays-in to find prefix overlays and check over two + ;; positions to find done separator overlay. + (let ((ovs (overlays-in (point) (1+ (point)))) + ov) + (catch 'done + (while ovs + (setq ov (pop ovs)) + (when (eq (overlay-get ov 'todo) val) + (throw 'done ov))))))) (defun todo-marked-item-p () "Non-nil if this item begins with `todo-item-mark'. diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 7158987920..4763d27a85 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el @@ -46,6 +46,9 @@ "Set up an isolated todo-mode test environment." (declare (debug (body))) `(let* ((todo-test-home (make-temp-file "todo-test-home-" t)) + ;; Since we change HOME, clear this to avoid a conflict + ;; e.g. if Emacs runs within the user's home directory. + (abbreviated-home-dir nil) (process-environment (cons (format "HOME=%s" todo-test-home) process-environment)) (todo-directory todo-test-data-dir) @@ -170,7 +173,7 @@ In particular, all lines of a multiline item should be highlighted." (goto-char (point-min)) (let ((p1 (point)) (s1 (todo-item-string)) - p2 s2 p3) + p2 s2 p3 p4) ;; First item in category. (should (equal p1 (todo-item-start))) (todo-next-item) @@ -230,7 +233,22 @@ In particular, all lines of a multiline item should be highlighted." (should (eq (point) p3)) (todo-lower-item-priority) ;; Lowering item priority on a done item is a noop. - (should (eq (point) p3))))) + (should (eq (point) p3)) + ;; Case 5: raising first item and lowering last item. + (goto-char (point-min)) ; Now on first item. + ;; Changing item priority moves point to todo-item-start, so move + ;; it away from there for the test. + (end-of-line) + (setq p4 (point)) + (todo-raise-item-priority) + ;; Raising priority of first item is a noop. + (should (equal (point) p4)) + (goto-char (point-max)) + (todo-previous-item) ; Now on last item. + (end-of-line) + (setq p4 (point)) + (todo-lower-item-priority) + (should (equal (point) p4))))) (ert-deftest todo-test-todo-mark-unmark-category () ; bug#27609 "Test behavior of todo-mark-category and todo-unmark-category." @@ -426,9 +444,14 @@ the top done item should be the first done item." ;; Header is shown. (should-not (todo-get-overlay 'header)))) +;; FIXME: This test doesn't show the effect of the display overlay on +;; calling todo-next-item in todo-mode: When using Todo mode, the +;; display engine moves point out of the overlay, but here point does +;; not get moved, even when display-graphic-p. (ert-deftest todo-test-toggle-item-header02 () ; bug#27609 "Test navigating between items with hidden header." - :expected-result :failed ; FIXME + ;; This makes no difference for testing todo-next-item. + ;; (skip-unless (display-graphic-p)) (with-todo-test (todo-test--show 2) (let* ((start0 (point)) @@ -448,17 +471,26 @@ the top done item should be the first done item." ;; Point hasn't changed... (should (eq (point) start0)) (should (looking-at todo-item-start)) - ;; FIXME: In the test run this puts point at todo-item-start, - ;; i.e. the display overlay doesn't affect this movement, unlike - ;; with the command in todo-mode (and using call-interactively - ;; here doesn't change this). (todo-next-item) - (should (eq (point) start2)) - (should-not (looking-at todo-item-start)) + ;; FIXME: This should (and when using todo-mode does) put point + ;; at the start of the item's test, not at todo-item-start, like + ;; todo-previous-item below. But the following tests fail; why? + ;; (N.B.: todo-backward-item, called by todo-previous-item, + ;; explicitly moves point forward to where it needs to be because + ;; otherwise the display engine moves it backward.) + ;; (should (eq (point) start2)) + ;; (should-not (looking-at todo-item-start)) + ;; And these pass, though they shouldn't: + (should-not (eq (point) start2)) + (should (looking-at todo-item-start)) (todo-previous-item) ;; ...but now it has. (should (eq (point) start1)) (should-not (looking-at todo-item-start)) + ;; This fails just like the above. + ;; (todo-next-item) + ;; (should (eq (point) start2)) + ;; (should-not (looking-at todo-item-start)) ;; This is the status quo but is it desirable? (todo-toggle-item-header) (should (eq (point) start1)) commit a56e6e79613779895975b1762c311bf8fe46f551 Author: Paul Eggert Date: Fri Aug 11 01:04:30 2017 -0700 Improve performance for rename-file etc. Although this does not fix Bug#27986, it is a step forward. I plan to propose a more-significant patch later. * lisp/files.el (directory-name-p): Move from here ... * src/fileio.c (Fdirectory_name_p): ... to here. (directory_like, cp_like_target): New static functions. (Fcopy_file, Frename_file, Fadd_name_to_file) (Fmake_symbolic_link): Use them, to avoid directory-testing syscalls on file names that must be directories if they exist. Omit unnecessary initializations and CHECK_STRING calls. (Frename_file): Don't call file_name_case_insensitive_p twice on the same file. Compare both file names expanded, instead of the old name expanded and the new one unexpanded. diff --git a/lisp/files.el b/lisp/files.el index f2758ab18c..0fe7f9c522 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -792,16 +792,6 @@ The path separator is colon in GNU and GNU-like systems." (lambda (f) (and (file-directory-p f) 'dir-ok))) (error "No such directory found via CDPATH environment variable")))) -(defsubst directory-name-p (name) - "Return non-nil if NAME ends with a directory separator character." - (let ((len (length name)) - (lastc ?.)) - (if (> len 0) - (setq lastc (aref name (1- len)))) - (or (= lastc ?/) - (and (memq system-type '(windows-nt ms-dos)) - (= lastc ?\\))))) - (defun directory-files-recursively (dir regexp &optional include-directories) "Return list of all files under DIR that have file names matching REGEXP. This function works recursively. Files are returned in \"depth first\" diff --git a/src/fileio.c b/src/fileio.c index 15845e3914..9aae7d997e 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -267,9 +267,9 @@ Otherwise, return nil. A file name is handled if one of the regular expressions in `file-name-handler-alist' matches it. -If OPERATION equals `inhibit-file-name-operation', then we ignore +If OPERATION equals `inhibit-file-name-operation', then ignore any handlers that are members of `inhibit-file-name-handlers', -but we still do run any other handlers. This lets handlers +but still do run any other handlers. This lets handlers use the standard functions without calling themselves recursively. */) (Lisp_Object filename, Lisp_Object operation) { @@ -583,6 +583,38 @@ directory_file_name (char *dst, char *src, ptrdiff_t srclen, bool multibyte) return srclen; } +DEFUN ("directory-name-p", Fdirectory_name_p, Sdirectory_name_p, 1, 1, 0, + doc: /* Return non-nil if NAME ends with a directory separator character. */) + (Lisp_Object name) +{ + CHECK_STRING (name); + ptrdiff_t namelen = SBYTES (name); + unsigned char c = namelen ? SREF (name, namelen - 1) : 0; + return IS_DIRECTORY_SEP (c) ? Qt : Qnil; +} + +/* Return true if NAME must be that of a directory if it exists. + When NAME is a directory name, this avoids system calls compared to + just calling Ffile_directory_p. */ + +static bool +directory_like (Lisp_Object name) +{ + return !NILP (Fdirectory_name_p (name)) || !NILP (Ffile_directory_p (name)); +} + +/* Return the expansion of NEWNAME, except that if NEWNAME is like a + directory then return the expansion of FILE's basename under + NEWNAME. This is like how 'cp FILE NEWNAME' works. */ + +static Lisp_Object +expand_cp_target (Lisp_Object file, Lisp_Object newname) +{ + return (directory_like (newname) + ? Fexpand_file_name (Ffile_name_nondirectory (file), newname) + : Fexpand_file_name (newname, Qnil)); +} + DEFUN ("directory-file-name", Fdirectory_file_name, Sdirectory_file_name, 1, 1, 0, doc: /* Returns the file name of the directory named DIRECTORY. @@ -1874,9 +1906,9 @@ This function always sets the file modes of the output file to match the input file. The optional third argument OK-IF-ALREADY-EXISTS specifies what to do -if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, we +if file NEWNAME already exists. If OK-IF-ALREADY-EXISTS is nil, signal a `file-already-exists' error without overwriting. If -OK-IF-ALREADY-EXISTS is a number, we request confirmation from the user +OK-IF-ALREADY-EXISTS is an integer, request confirmation from the user about overwriting; this is what happens in interactive use with M-x. Any other value for OK-IF-ALREADY-EXISTS means to overwrite the existing file. @@ -1886,8 +1918,8 @@ last-modified time as the old one. (This works on only some systems.) A prefix arg makes KEEP-TIME non-nil. -If PRESERVE-UID-GID is non-nil, we try to transfer the -uid and gid of FILE to NEWNAME. +If PRESERVE-UID-GID is non-nil, try to transfer the uid and gid of +FILE to NEWNAME. If PRESERVE-PERMISSIONS is non-nil, copy permissions of FILE to NEWNAME; this includes the file modes, along with ACL entries and SELinux @@ -1914,16 +1946,8 @@ permissions. */) struct stat st; #endif - encoded_file = encoded_newname = Qnil; - CHECK_STRING (file); - CHECK_STRING (newname); - - if (!NILP (Ffile_directory_p (newname))) - newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); - else - newname = Fexpand_file_name (newname, Qnil); - file = Fexpand_file_name (file, Qnil); + newname = expand_cp_target (file, newname); /* If the input file name has special constructs in it, call the corresponding file handler. */ @@ -2304,9 +2328,9 @@ DEFUN ("rename-file", Frename_file, Srename_file, 2, 3, "fRename file: \nGRename %s to file: \np", doc: /* Rename FILE as NEWNAME. Both args must be strings. If file has names other than FILE, it continues to have those names. -Signals a `file-already-exists' error if a file NEWNAME already exists +Signal a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if NEWNAME already exists. +An integer third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. */) (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists) { @@ -2314,24 +2338,22 @@ This is what happens in interactive use with M-x. */) Lisp_Object encoded_file, encoded_newname, symlink_target; int dirp = -1; - symlink_target = encoded_file = encoded_newname = Qnil; - CHECK_STRING (file); - CHECK_STRING (newname); file = Fexpand_file_name (file, Qnil); - if ((!NILP (Ffile_directory_p (newname))) - /* If the filesystem is case-insensitive and the file names are - identical but for the case, don't attempt to move directory - to itself. */ - && (NILP (Ffile_name_case_insensitive_p (file)) - || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))) + /* If the filesystem is case-insensitive and the file names are + identical but for case, treat it as a change-case request, and do + not worry whether NEWNAME exists or whether it is a directory, as + it is already another name for FILE. */ + bool case_only_rename = false; + if (!NILP (Ffile_name_case_insensitive_p (file))) { - dirp = !NILP (Ffile_directory_p (file)); - Lisp_Object fname = dirp ? Fdirectory_file_name (file) : file; - newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname); + newname = Fexpand_file_name (newname, Qnil); + case_only_rename = !NILP (Fstring_equal (Fdowncase (file), + Fdowncase (newname))); } - else - newname = Fexpand_file_name (newname, Qnil); + + if (!case_only_rename) + newname = expand_cp_target (Fdirectory_file_name (file), newname); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2345,15 +2367,9 @@ This is what happens in interactive use with M-x. */) encoded_file = ENCODE_FILE (file); encoded_newname = ENCODE_FILE (newname); - /* If the filesystem is case-insensitive and the file names are - identical but for the case, don't worry whether the destination - already exists: the caller simply wants to change the letter-case - of the file name. */ - bool plain_rename - = ((!NILP (ok_if_already_exists) && !INTEGERP (ok_if_already_exists)) - || (file_name_case_insensitive_p (SSDATA (encoded_file)) - && ! NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))); - + bool plain_rename = (case_only_rename + || (!NILP (ok_if_already_exists) + && !INTEGERP (ok_if_already_exists))); int rename_errno; if (!plain_rename) { @@ -2395,7 +2411,7 @@ This is what happens in interactive use with M-x. */) else { if (dirp < 0) - dirp = !NILP (Ffile_directory_p (file)); + dirp = directory_like (file); if (dirp) call4 (Qcopy_directory, file, newname, Qt, Qnil); else @@ -2414,24 +2430,17 @@ This is what happens in interactive use with M-x. */) DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, "fAdd name to file: \nGName to add to %s: \np", doc: /* Give FILE additional name NEWNAME. Both args must be strings. -Signals a `file-already-exists' error if a file NEWNAME already exists +Signal a `file-already-exists' error if a file NEWNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if NEWNAME already exists. +An integer third arg means request confirmation if NEWNAME already exists. This is what happens in interactive use with M-x. */) (Lisp_Object file, Lisp_Object newname, Lisp_Object ok_if_already_exists) { Lisp_Object handler; Lisp_Object encoded_file, encoded_newname; - encoded_file = encoded_newname = Qnil; - CHECK_STRING (file); - CHECK_STRING (newname); file = Fexpand_file_name (file, Qnil); - - if (!NILP (Ffile_directory_p (newname))) - newname = Fexpand_file_name (Ffile_name_nondirectory (file), newname); - else - newname = Fexpand_file_name (newname, Qnil); + newname = expand_cp_target (file, newname); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2471,28 +2480,23 @@ DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, "FMake symbolic link to file: \nGMake symbolic link to file %s: \np", doc: /* Make a symbolic link to TARGET, named LINKNAME. Both args must be strings. -Signals a `file-already-exists' error if a file LINKNAME already exists +Signal a `file-already-exists' error if a file LINKNAME already exists unless optional third argument OK-IF-ALREADY-EXISTS is non-nil. -A number as third arg means request confirmation if LINKNAME already exists. +An integer third arg means request confirmation if LINKNAME already exists. This happens for interactive use with M-x. */) (Lisp_Object target, Lisp_Object linkname, Lisp_Object ok_if_already_exists) { Lisp_Object handler; Lisp_Object encoded_target, encoded_linkname; - encoded_target = encoded_linkname = Qnil; CHECK_STRING (target); - CHECK_STRING (linkname); /* If the link target has a ~, we must expand it to get a truly valid file name. Otherwise, do not expand; we want to permit links to relative file names. */ if (SREF (target, 0) == '~') target = Fexpand_file_name (target, Qnil); - if (!NILP (Ffile_directory_p (linkname))) - linkname = Fexpand_file_name (Ffile_name_nondirectory (target), linkname); - else - linkname = Fexpand_file_name (linkname, Qnil); + linkname = expand_cp_target (target, linkname); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -5577,7 +5581,7 @@ and are changed since last auto-saved. Auto-saving writes the buffer into a file so that your editing is not lost if the system crashes. This file is not the file you visited; that changes only when you save. -Normally we run the normal hook `auto-save-hook' before saving. +Normally, run the normal hook `auto-save-hook' before saving. A non-nil NO-MESSAGE argument means do not print any message if successful. A non-nil CURRENT-ONLY argument means save only current buffer. */) @@ -6111,7 +6115,7 @@ This applies only to the operation `inhibit-file-name-operation'. */); Vinhibit_file_name_operation = Qnil; DEFVAR_LISP ("auto-save-list-file-name", Vauto_save_list_file_name, - doc: /* File name in which we write a list of all auto save file names. + doc: /* File name in which to write a list of all auto save file names. This variable is initialized automatically from `auto-save-list-file-prefix' shortly after Emacs reads your init file, if you have not yet given it a non-nil value. */); @@ -6166,6 +6170,7 @@ This includes interactive calls to `delete-file' and defsubr (&Sfile_name_nondirectory); defsubr (&Sunhandled_file_name_directory); defsubr (&Sfile_name_as_directory); + defsubr (&Sdirectory_name_p); defsubr (&Sdirectory_file_name); defsubr (&Smake_temp_name); defsubr (&Sexpand_file_name); commit 179499cde921a28c82400b1674520da245b93bb9 Author: Noam Postavsky Date: Sun Aug 6 21:35:04 2017 -0400 Respect buffer-local value of tags-table-list (Bug#27772) * lisp/progmodes/etags.el (visit-tags-table-buffer): Save the current buffer around the `tags-table-including' calls so as to get buffer local variables from the right buffer later. * test/lisp/progmodes/etags-tests.el (etags-visit-tags-table-buffer): New test. * test/lisp/progmodes/etags-tests.el (etags-tests--test-dir): New constant. (etags-bug-158, etags-bug-23164): Use it so that when running the test interactively, setting EMACS_TEST_DIRECTORY is not needed. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 8d635cb6d4..222dea1a2a 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -599,12 +599,13 @@ Returns t if it visits a tags table, or nil if there are no more in the list." ;; be frobnicated, and CONT will be set non-nil so we don't ;; do it below. (and buffer-file-name - (or - ;; First check only tables already in buffers. - (tags-table-including buffer-file-name t) - ;; Since that didn't find any, now do the - ;; expensive version: reading new files. - (tags-table-including buffer-file-name nil))) + (save-current-buffer + (or + ;; First check only tables already in buffers. + (tags-table-including buffer-file-name t) + ;; Since that didn't find any, now do the + ;; expensive version: reading new files. + (tags-table-including buffer-file-name nil)))) ;; Fourth, use the user variable tags-file-name, if it is ;; not already in the current list. (and tags-file-name diff --git a/test/lisp/progmodes/etags-tests.el b/test/lisp/progmodes/etags-tests.el index eec8a02f1b..0153f327ba 100644 --- a/test/lisp/progmodes/etags-tests.el +++ b/test/lisp/progmodes/etags-tests.el @@ -23,9 +23,15 @@ (require 'ert) (require 'etags) +(eval-when-compile (require 'cl-lib)) (defvar his-masters-voice t) +(defconst etags-tests--test-dir + (or (getenv "EMACS_TEST_DIRECTORY") + (expand-file-name "../../.." + (or load-file-name buffer-file-name)))) + (defun y-or-n-p (_prompt) "Replacement for `y-or-n-p' that returns what we tell it to." his-masters-voice) @@ -38,8 +44,7 @@ (set-buffer buf-with-global-tags) (setq default-directory (expand-file-name ".")) (visit-tags-table - (expand-file-name "manual/etags/ETAGS.good_1" - (getenv "EMACS_TEST_DIRECTORY"))) + (expand-file-name "manual/etags/ETAGS.good_1" etags-tests--test-dir)) ;; Check that tags in ETAGS.good_1 are recognized. (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) (should (bufferp xref-buf)) @@ -55,8 +60,7 @@ (setq default-directory (expand-file-name ".")) (let (his-masters-voice) (visit-tags-table - (expand-file-name "manual/etags/ETAGS.good_3" - (getenv "EMACS_TEST_DIRECTORY")) + (expand-file-name "manual/etags/ETAGS.good_3" etags-tests--test-dir) t)) ;; Check that tags in ETAGS.good_1 are recognized. (setq xref-buf (xref-find-definitions "LL_Task_Procedure_Access/t")) @@ -84,8 +88,23 @@ (set-buffer (get-buffer-create "*foobar*")) (fundamental-mode) (visit-tags-table - (expand-file-name "manual/etags/ETAGS.good_3" - (getenv "EMACS_TEST_DIRECTORY")) + (expand-file-name "manual/etags/ETAGS.good_3" etags-tests--test-dir) t) (should (equal (should-error (xref-find-definitions "foobar123")) '(user-error "No definitions found for: foobar123")))) + +(ert-deftest etags-buffer-local-tags-table-list () + "Test that a buffer-local value of `tags-table-list' is used." + (let ((file (make-temp-file "etag-test-tmpfile"))) + (set-buffer (find-file-noselect file)) + (fundamental-mode) + (setq-local tags-table-list + (list (expand-file-name "manual/etags/ETAGS.good_3" + etags-tests--test-dir))) + (cl-letf ((tag-tables tags-table-list) + (tags-file-name nil) + ((symbol-function 'read-file-name) + (lambda (&rest _) + (error "We should not prompt the user")))) + (should (visit-tags-table-buffer)) + (should (equal tags-file-name (car tag-tables)))))) commit 81656add8117e8d1b7faab18b330d0706462b433 Author: Tom Tromey Date: Wed Aug 9 16:06:23 2017 -0600 Fix auto-filling regression Bug#28003 * lisp/newcomment.el (comment-indent-new-line): Check comment-auto-fill-only-comments. Reverts earlier change. * lisp/simple.el (internal-auto-fill): Call auto-fill-function, not do-auto-fill. diff --git a/lisp/newcomment.el b/lisp/newcomment.el index e3ee4dfab1..8772b52376 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1382,9 +1382,10 @@ unless optional argument SOFT is non-nil." (interactive) (comment-normalize-vars t) (let (compos comin) - ;; If we are not inside a comment don't do anything (unless no - ;; comment syntax is defined). + ;; If we are not inside a comment and we only auto-fill comments, + ;; don't do anything (unless no comment syntax is defined). (unless (and comment-start + comment-auto-fill-only-comments (not (called-interactively-p 'interactive)) (not (save-excursion (prog1 (setq compos (comment-beginning)) diff --git a/lisp/simple.el b/lisp/simple.el index 9838f1644f..933ffc55a6 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7243,7 +7243,7 @@ unless optional argument SOFT is non-nil." (when (or (not comment-start) (not comment-auto-fill-only-comments) (nth 4 (syntax-ppss))) - (do-auto-fill))) + (funcall auto-fill-function))) (defvar normal-auto-fill-function 'do-auto-fill "The function to use for `auto-fill-function' if Auto Fill mode is turned on. commit 904be8c4cf8522a54a85542954bd553b6dbd0b64 Author: Paul Eggert Date: Wed Aug 9 11:38:04 2017 -0700 Merge from gnulib This incorporates: 2017-08-09 tempname: do not depend on secure_getenv 2017-08-08 extensions: add _OPENBSD_SOURCE 2017-08-06 manywarnings: Add support for C++ 2017-08-06 warnings, manywarnings: Add support for multiple languages * admin/merge-gnulib: Don't use m4/manywarnings-c++.m4. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * lib/secure_getenv.c, m4/secure_getenv.m4: Remove. * lib/tempname.c, m4/extensions.m4, m4/manywarnings.m4, m4/warnings.m4: Copy from gnulib. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index c23e8a40ea..a16d7fa53e 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -106,6 +106,7 @@ done rm -- "$src"lib/gl_openssl.h "$src"m4/fcntl-o.m4 \ "$src"m4/gl-openssl.m4 \ "$src"m4/gnulib-cache.m4 "$src"m4/gnulib-tool.m4 \ + "$src"m4/manywarnings-c++.m4 \ "$src"m4/warn-on-use.m4 "$src"m4/wint_t.m4 && cp -- "$gnulib_srcdir"/build-aux/texinfo.tex "$src"doc/misc && cp -- "$gnulib_srcdir"/build-aux/config.guess \ diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index a385c8c838..c5df3f42e4 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -903,7 +903,6 @@ gl_GNULIB_ENABLED_dosname = @gl_GNULIB_ENABLED_dosname@ gl_GNULIB_ENABLED_euidaccess = @gl_GNULIB_ENABLED_euidaccess@ gl_GNULIB_ENABLED_getdtablesize = @gl_GNULIB_ENABLED_getdtablesize@ gl_GNULIB_ENABLED_getgroups = @gl_GNULIB_ENABLED_getgroups@ -gl_GNULIB_ENABLED_secure_getenv = @gl_GNULIB_ENABLED_secure_getenv@ gl_GNULIB_ENABLED_strtoll = @gl_GNULIB_ENABLED_strtoll@ gl_GNULIB_ENABLED_tempname = @gl_GNULIB_ENABLED_tempname@ gl_LIBOBJS = @gl_LIBOBJS@ @@ -1912,19 +1911,6 @@ EXTRA_DIST += root-uid.h endif ## end gnulib module root-uid -## begin gnulib module secure_getenv -ifeq (,$(OMIT_GNULIB_MODULE_secure_getenv)) - -ifneq (,$(gl_GNULIB_ENABLED_secure_getenv)) - -endif -EXTRA_DIST += secure_getenv.c - -EXTRA_libgnu_a_SOURCES += secure_getenv.c - -endif -## end gnulib module secure_getenv - ## begin gnulib module sig2str ifeq (,$(OMIT_GNULIB_MODULE_sig2str)) diff --git a/lib/secure_getenv.c b/lib/secure_getenv.c deleted file mode 100644 index df53dea0b2..0000000000 --- a/lib/secure_getenv.c +++ /dev/null @@ -1,54 +0,0 @@ -/* Look up an environment variable, returning NULL in insecure situations. - - Copyright 2013-2017 Free Software Foundation, Inc. - - This program 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. - - This program 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 this program. If not, see . */ - -#include - -#include - -#if !HAVE___SECURE_GETENV -# if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID) -# include -# endif -#endif - -char * -secure_getenv (char const *name) -{ -#if HAVE___SECURE_GETENV /* glibc */ - return __secure_getenv (name); -#elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */ - if (issetugid ()) - return NULL; - return getenv (name); -#elif HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID /* other Unix */ - if (geteuid () != getuid () || getegid () != getgid ()) - return NULL; - return getenv (name); -#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* native Windows */ - /* On native Windows, there is no such concept as setuid or setgid binaries. - - Programs launched as system services have high privileges, but they don't - inherit environment variables from a user. - - Programs launched by a user with "Run as Administrator" have high - privileges and use the environment variables, but the user has been asked - whether he agrees. - - Programs launched by a user without "Run as Administrator" cannot gain - high privileges, therefore there is no risk. */ - return getenv (name); -#else - return NULL; -#endif -} diff --git a/lib/tempname.c b/lib/tempname.c index 9c4a3c2a54..c274b8dd4e 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -69,7 +69,6 @@ # define __mkdir mkdir # define __open open # define __lxstat64(version, file, buf) lstat (file, buf) -# define __secure_getenv secure_getenv #endif #ifdef _LIBC diff --git a/m4/extensions.m4 b/m4/extensions.m4 index c60f537db1..0c16bb832f 100644 --- a/m4/extensions.m4 +++ b/m4/extensions.m4 @@ -1,4 +1,4 @@ -# serial 15 -*- Autoconf -*- +# serial 16 -*- Autoconf -*- # Enable extensions on systems that normally disable them. # Copyright (C) 2003, 2006-2017 Free Software Foundation, Inc. @@ -68,6 +68,10 @@ dnl configure.ac when using autoheader 2.62. #ifndef _GNU_SOURCE # undef _GNU_SOURCE #endif +/* Enable OpenBSD extensions on NetBSD. */ +#ifndef _OPENBSD_SOURCE +# undef _OPENBSD_SOURCE +#endif /* Enable threading extensions on Solaris. */ #ifndef _POSIX_PTHREAD_SEMANTICS # undef _POSIX_PTHREAD_SEMANTICS @@ -128,6 +132,7 @@ dnl configure.ac when using autoheader 2.62. AC_DEFINE([_ALL_SOURCE]) AC_DEFINE([_DARWIN_C_SOURCE]) AC_DEFINE([_GNU_SOURCE]) + AC_DEFINE([_OPENBSD_SOURCE]) AC_DEFINE([_POSIX_PTHREAD_SEMANTICS]) AC_DEFINE([__STDC_WANT_IEC_60559_ATTRIBS_EXT__]) AC_DEFINE([__STDC_WANT_IEC_60559_BFP_EXT__]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 188c116c85..69d77229bf 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -124,7 +124,6 @@ AC_DEFUN([gl_EARLY], # Code from module readlink: # Code from module readlinkat: # Code from module root-uid: - # Code from module secure_getenv: # Code from module sig2str: # Code from module signal-h: # Code from module snippet/_Noreturn: @@ -424,7 +423,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31=false gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7=false gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=false - gl_gnulib_enabled_secure_getenv=false gl_gnulib_enabled_strtoll=false gl_gnulib_enabled_tempname=false gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec=false @@ -550,18 +548,6 @@ AC_DEFUN([gl_INIT], gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c=true fi } - func_gl_gnulib_m4code_secure_getenv () - { - if ! $gl_gnulib_enabled_secure_getenv; then - gl_FUNC_SECURE_GETENV - if test $HAVE_SECURE_GETENV = 0; then - AC_LIBOBJ([secure_getenv]) - gl_PREREQ_SECURE_GETENV - fi - gl_STDLIB_MODULE_INDICATOR([secure_getenv]) - gl_gnulib_enabled_secure_getenv=true - fi - } func_gl_gnulib_m4code_strtoll () { if ! $gl_gnulib_enabled_strtoll; then @@ -579,7 +565,6 @@ AC_DEFUN([gl_INIT], if ! $gl_gnulib_enabled_tempname; then gl_FUNC_GEN_TEMPNAME gl_gnulib_enabled_tempname=true - func_gl_gnulib_m4code_secure_getenv fi } func_gl_gnulib_m4code_682e609604ccaac6be382e4ee3a4eaec () @@ -658,7 +643,6 @@ AC_DEFUN([gl_INIT], AM_CONDITIONAL([gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31], [$gl_gnulib_enabled_5264294aa0a5557541b53c8c741f7f31]) AM_CONDITIONAL([gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7], [$gl_gnulib_enabled_03e0aaad4cb89ca757653bd367a6ccb7]) AM_CONDITIONAL([gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c], [$gl_gnulib_enabled_6099e9737f757db36c47fa9d9f02e88c]) - AM_CONDITIONAL([gl_GNULIB_ENABLED_secure_getenv], [$gl_gnulib_enabled_secure_getenv]) AM_CONDITIONAL([gl_GNULIB_ENABLED_strtoll], [$gl_gnulib_enabled_strtoll]) AM_CONDITIONAL([gl_GNULIB_ENABLED_tempname], [$gl_gnulib_enabled_tempname]) AM_CONDITIONAL([gl_GNULIB_ENABLED_682e609604ccaac6be382e4ee3a4eaec], [$gl_gnulib_enabled_682e609604ccaac6be382e4ee3a4eaec]) @@ -907,7 +891,6 @@ AC_DEFUN([gl_FILE_LIST], [ lib/readlink.c lib/readlinkat.c lib/root-uid.h - lib/secure_getenv.c lib/set-permissions.c lib/sha1.c lib/sha1.h @@ -1008,6 +991,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/localtime-buffer.m4 m4/longlong.m4 m4/lstat.m4 + m4/manywarnings-c++.m4 m4/manywarnings.m4 m4/md5.m4 m4/memrchr.m4 @@ -1024,7 +1008,6 @@ AC_DEFUN([gl_FILE_LIST], [ m4/putenv.m4 m4/readlink.m4 m4/readlinkat.m4 - m4/secure_getenv.m4 m4/sha1.m4 m4/sha256.m4 m4/sha512.m4 diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 6a8939b2c1..a3d255a940 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 10 +# manywarnings.m4 serial 11 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -33,8 +33,16 @@ AC_DEFUN([gl_MANYWARN_COMPLEMENT], # Add all documented GCC warning parameters to variable VARIABLE. # Note that you need to test them using gl_WARN_ADD if you want to # make sure your gcc understands it. +# +# The effects of this macro depend on the current language (_AC_LANG). AC_DEFUN([gl_MANYWARN_ALL_GCC], +[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) + +# Specialization for _AC_LANG = C. +AC_DEFUN([gl_MANYWARN_ALL_GCC(C)], [ + AC_LANG_PUSH([C]) + dnl First, check for some issues that only occur when combining multiple dnl gcc warning categories. AC_REQUIRE([AC_PROG_CC]) @@ -303,4 +311,12 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], fi $1=$gl_manywarn_set + + AC_LANG_POP([C]) +]) + +# Specialization for _AC_LANG = C++. +AC_DEFUN([gl_MANYWARN_ALL_GCC(C++)], +[ + gl_MANYWARN_ALL_GCC_CXX_IMPL([$1]) ]) diff --git a/m4/secure_getenv.m4 b/m4/secure_getenv.m4 deleted file mode 100644 index 6bd4afd9c1..0000000000 --- a/m4/secure_getenv.m4 +++ /dev/null @@ -1,26 +0,0 @@ -# Look up an environment variable more securely. -dnl Copyright 2013-2017 Free Software Foundation, Inc. -dnl This file is free software; the Free Software Foundation -dnl gives unlimited permission to copy and/or distribute it, -dnl with or without modifications, as long as this notice is preserved. - -AC_DEFUN([gl_FUNC_SECURE_GETENV], -[ - dnl Persuade glibc to declare secure_getenv(). - AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) - - AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) - AC_CHECK_FUNCS_ONCE([secure_getenv]) - if test $ac_cv_func_secure_getenv = no; then - HAVE_SECURE_GETENV=0 - fi -]) - -# Prerequisites of lib/secure_getenv.c. -AC_DEFUN([gl_PREREQ_SECURE_GETENV], [ - AC_CHECK_FUNCS([__secure_getenv]) - if test $ac_cv_func___secure_getenv = no; then - AC_CHECK_FUNCS([issetugid]) - fi - AC_CHECK_FUNCS_ONCE([getuid geteuid getgid getegid]) -]) diff --git a/m4/warnings.m4 b/m4/warnings.m4 index e697174edd..aa2735b77f 100644 --- a/m4/warnings.m4 +++ b/m4/warnings.m4 @@ -1,4 +1,4 @@ -# warnings.m4 serial 11 +# warnings.m4 serial 12 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -20,10 +20,12 @@ m4_ifdef([AS_VAR_APPEND], # ----------------------------------------------------------------- # Check if the compiler supports OPTION when compiling PROGRAM. # -# FIXME: gl_Warn must be used unquoted until we can assume Autoconf -# 2.64 or newer. +# The effects of this macro depend on the current language (_AC_LANG). AC_DEFUN([gl_COMPILER_OPTION_IF], -[AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl +[ +dnl FIXME: gl_Warn must be used unquoted until we can assume Autoconf +dnl 2.64 or newer. +AS_VAR_PUSHDEF([gl_Warn], [gl_cv_warn_[]_AC_LANG_ABBREV[]_$1])dnl AS_VAR_PUSHDEF([gl_Flags], [_AC_LANG_PREFIX[]FLAGS])dnl AS_LITERAL_IF([$1], [m4_pushdef([gl_Positive], m4_bpatsubst([$1], [^-Wno-], [-W]))], @@ -51,27 +53,50 @@ AS_VAR_POPDEF([gl_Warn])dnl # ------------------------------ # Clang doesn't complain about unknown warning options unless one also # specifies -Wunknown-warning-option -Werror. Detect this. +# +# The effects of this macro depend on the current language (_AC_LANG). AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS], +[_AC_LANG_DISPATCH([$0], _AC_LANG, $@)]) + +# Specialization for _AC_LANG = C. This macro can be AC_REQUIREd. +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C)], +[ + AC_LANG_PUSH([C]) + gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL + AC_LANG_POP([C]) +]) + +# Specialization for _AC_LANG = C++. This macro can be AC_REQUIREd. +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS(C++)], +[ + AC_LANG_PUSH([C++]) + gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL + AC_LANG_POP([C++]) +]) + +AC_DEFUN([gl_UNKNOWN_WARNINGS_ARE_ERRORS_IMPL], [gl_COMPILER_OPTION_IF([-Werror -Wunknown-warning-option], [gl_unknown_warnings_are_errors='-Wunknown-warning-option -Werror'], [gl_unknown_warnings_are_errors=])]) -# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS], +# gl_WARN_ADD(OPTION, [VARIABLE = WARN_CFLAGS/WARN_CXXFLAGS], # [PROGRAM = AC_LANG_PROGRAM()]) -# --------------------------------------------- -# Adds parameter to WARN_CFLAGS if the compiler supports it when -# compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]). +# ----------------------------------------------------------- +# Adds parameter to WARN_CFLAGS/WARN_CXXFLAGS if the compiler supports it +# when compiling PROGRAM. For example, gl_WARN_ADD([-Wparentheses]). # # If VARIABLE is a variable name, AC_SUBST it. +# +# The effects of this macro depend on the current language (_AC_LANG). AC_DEFUN([gl_WARN_ADD], -[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS]) +[AC_REQUIRE([gl_UNKNOWN_WARNINGS_ARE_ERRORS(]_AC_LANG[)]) gl_COMPILER_OPTION_IF([$1], - [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_CFLAGS]], [[$2]]), [" $1"])], + [gl_AS_VAR_APPEND(m4_if([$2], [], [[WARN_]_AC_LANG_PREFIX[FLAGS]], [[$2]]), [" $1"])], [], [$3]) m4_ifval([$2], [AS_LITERAL_IF([$2], [AC_SUBST([$2])])], - [AC_SUBST([WARN_CFLAGS])])dnl + [AC_SUBST([WARN_]_AC_LANG_PREFIX[FLAGS])])dnl ]) # Local Variables: commit 7fc27ea70bc7dc24776b2c098ac970f2f21e37fb Author: Eli Zaretskii Date: Wed Aug 9 20:15:46 2017 +0300 Fix crashing emacs-module tests on MS-Windows * src/w32fns.c (syms_of_w32fns) : New variable. (emacs_abort): If w32-disable-abort-dialog is non-nil, abort right away, without displaying the Abort dialog, which waits for the user. * test/src/emacs-module-tests.el (module--test-assertion): Run the inferior Emacs with the w32 abort dialog disabled. Expect the status of the aborted Emacs sub-process to be 3 on MS-Windows and 2 on MS-DOS. diff --git a/src/w32fns.c b/src/w32fns.c index 457599fce0..bf3c1d5d30 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10708,6 +10708,11 @@ default value t means to add the width of one canonical character of the tip frame. */); Vw32_tooltip_extra_pixels = Qt; + DEFVAR_BOOL ("w32-disable-abort-dialog", + w32_disable_abort_dialog, + doc: /* Non-nil means don't display the abort dialog when aborting. */); + w32_disable_abort_dialog = 0; + #if 0 /* TODO: Port to W32 */ defsubr (&Sx_change_window_property); defsubr (&Sx_delete_window_property); @@ -10902,6 +10907,9 @@ w32_backtrace (void **buffer, int limit) void emacs_abort (void) { + if (w32_disable_abort_dialog) + abort (); + int button; button = MessageBox (NULL, "A fatal error has occurred!\n\n" diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 2aa85f0b24..6a7ba5580d 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -208,14 +208,22 @@ must evaluate to a regular expression string." (with-temp-buffer (let* ((default-directory tempdir) (status (call-process mod-test-emacs nil t nil - "-batch" "-Q" "-module-assertions" "-eval" + "-batch" "-Q" "-module-assertions" + "-eval" "(setq w32-disable-abort-dialog t)" + "-eval" ,(prin1-to-string `(progn (require 'mod-test ,mod-test-file) ,@body))))) - (should (stringp status)) - ;; eg "Aborted" or "Abort trap: 6" - (should (string-prefix-p "Abort" status)) + ;; Aborting doesn't raise a signal on MS-DOS/Windows, but + ;; rather exits with a non-zero status: 2 on MS-DOS (see + ;; msdos.c:msdos_abort), 3 on Windows, per MSDN documentation + ;; of 'abort'. + (if (memq system-type '(ms-dos windows-nt)) + (should (>= status 2)) + (should (stringp status)) + ;; eg "Aborted" or "Abort trap: 6" + (should (string-prefix-p "Abort" status))) (search-backward "Emacs module assertion: ") (goto-char (match-end 0)) (should (string-match-p ,pattern commit da4438e14f1c55808937872b6d651a807404daa2 Author: Tino Calancha Date: Wed Aug 9 14:47:15 2017 +0900 dired-delete-file: Dont't ask for empty dirs * lisp/dired.el (dired--yes-no-all-quit-help): New defun. (dired-delete-file): Use it. Dont't ask for empty dirs (Bug#27940). * test/lisp/dired-tests.el (dired-test-with-temp-dirs): New auxiliar macro. (dired-test-bug27940): Add new test. diff --git a/lisp/dired.el b/lisp/dired.el index 2e5b847f9b..0455f3d137 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2989,6 +2989,29 @@ Any other value means to ask for each directory." `quit' to exit, `help' to show this help message.") +(defun dired--yes-no-all-quit-help (prompt &optional help-msg) + "Ask a question with valid answers: yes, no, all, quit, help. +PROMPT must end with '? ', for instance, 'Delete it? '. +If optional arg HELP-MSG is non-nil, then is a message to show when +the user answers 'help'. Otherwise, default to `dired-delete-help'." + (let ((valid-answers (list "yes" "no" "all" "quit")) + (answer "") + (input-fn (lambda () + (read-string + (format "%s [yes, no, all, quit, help] " prompt))))) + (setq answer (funcall input-fn)) + (when (string= answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" + (insert (or help-msg dired-delete-help))))) + (while (not (member answer valid-answers)) + (unless (string= answer "help") + (beep) + (message "Please answer `yes' or `no' or `all' or `quit'") + (sleep-for 2)) + (setq answer (funcall input-fn))) + answer)) + ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. @@ -3009,39 +3032,21 @@ TRASH non-nil means to trash the file instead of deleting, provided ;; but more efficient (if (not (eq t (car (file-attributes file)))) (delete-file file trash) - (let* ((valid-answers (list "yes" "no" "all" "quit" "help")) - (answer "") - (input-fn - (lambda () - (setq answer - (read-string - (format "Recursively %s %s? [yes, no, all, quit, help] " - (if (and trash - delete-by-moving-to-trash) - "trash" - "delete") - (dired-make-relative file)))) - (when (string= answer "help") - (with-help-window "*Help*" - (with-current-buffer "*Help*" (insert dired-delete-help)))) - answer))) - (if (and recursive - (directory-files file t dired-re-no-dot) ; Not empty. - (eq recursive 'always)) - (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. - ;; Otherwise prompt user: - (funcall input-fn) - (while (not (member answer valid-answers)) - (unless (string= answer "help") - (beep) - (message "Please answer `yes' or `no' or `all' or `quit'") - (sleep-for 2)) - (funcall input-fn)) - (pcase answer - ('"all" (setq recursive 'always dired-recursive-deletes recursive)) - ('"yes" (if (eq recursive 'top) (setq recursive 'always))) - ('"no" (setq recursive nil)) - ('"quit" (keyboard-quit)))) + (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot)))) + (if (and recursive (not empty-dir-p)) + (unless (eq recursive 'always) + (let ((prompt + (format "Recursively %s %s? " + (if (and trash delete-by-moving-to-trash) + "trash" + "delete") + (dired-make-relative file)))) + (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user. + ('"all" (setq recursive 'always dired-recursive-deletes recursive)) + ('"yes" (if (eq recursive 'top) (setq recursive 'always))) + ('"no" (setq recursive nil)) + ('"quit" (keyboard-quit))))) + (setq recursive nil)) ; Empty dir or recursive is nil. (delete-directory file recursive trash)))) (defun dired-do-flagged-delete (&optional nomessage) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 981afdd929..3c460d0151 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -358,5 +358,90 @@ (should (equal "subdir" (dired-get-filename 'local t)))) (delete-directory top-dir t)))) + +(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body) + "Helper macro for Bug#27940 test." + (declare (indent 1) (debug body)) + (let ((dir (make-symbol "dir")) + (ignore-funcs (make-symbol "ignore-funcs"))) + `(let* ((,dir (make-temp-file "bug27940" t)) + (dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts. + (inhibit-message t) + (default-directory ,dir)) + (dotimes (i 5) (make-directory (format "empty-dir-%d" i))) + (unless ,just-empty-dirs + (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents))) + (make-directory "zeta-empty-dir") + (unwind-protect + (progn + ,@body) + (delete-directory ,dir t) + (kill-buffer (current-buffer)))))) + +(ert-deftest dired-test-bug27940 () + "Test for http://debbugs.gnu.org/27940 ." + ;; If just empty dirs we shouln't be prompted. + (dired-test-with-temp-dirs + 'just-empty-dirs + (let (asked) + (advice-add 'dired--yes-no-all-quit-help + :override + (lambda (_) (setq asked t) "") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (progn + (should-not asked) + (should-not (dired-get-marked-files))) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + ;; Answer yes + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should-not (dired-get-marked-files)) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer no + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer all + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (dired-do-delete nil) + (unwind-protect + (should-not (dired-get-marked-files)) ; All dirs deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))) + ;; Answer quit + (dired-test-with-temp-dirs + nil + (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit") + '((name . dired-test-bug27940-advice))) + (dired default-directory) + (dired-toggle-marks) + (let ((inhibit-message t)) + (dired-do-delete nil)) + (unwind-protect + (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted. + (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))) + + (provide 'dired-tests) ;; dired-tests.el ends here commit 9ecbdeeaa845a75c63210057a8a554eedc9387bf Author: Tino Calancha Date: Wed Aug 9 14:37:21 2017 +0900 Ask files for deletion in buffer order: top first, botton later * lisp/dired.el (dired-do-flagged-delete, dired-do-delete): Call `nreverse' t invert the output of `dired-map-over-marks'. diff --git a/lisp/dired.el b/lisp/dired.el index 54bc621703..2e5b847f9b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3057,9 +3057,10 @@ non-empty directories is allowed." (if (save-excursion (goto-char (point-min)) (re-search-forward regexp nil t)) (dired-internal-do-deletions - ;; this can't move point since ARG is nil - (dired-map-over-marks (cons (dired-get-filename) (point)) - nil) + (nreverse + ;; this can't move point since ARG is nil + (dired-map-over-marks (cons (dired-get-filename) (point)) + nil)) nil t) (or nomessage (message "(No deletions requested)"))))) @@ -3072,9 +3073,10 @@ non-empty directories is allowed." ;; dired-do-flagged-delete. (interactive "P") (dired-internal-do-deletions - ;; this may move point if ARG is an integer - (dired-map-over-marks (cons (dired-get-filename) (point)) - arg) + (nreverse + ;; this may move point if ARG is an integer + (dired-map-over-marks (cons (dired-get-filename) (point)) + arg)) arg t)) (defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p? commit 9723782161f9b1ea6c3ce883acdc1090172b01c3 Author: Alexander Gramiak Date: Sat Aug 5 16:09:54 2017 -0600 Use help-mode xrefs in describe-font * lisp/international/mule-diag.el (describe-font): Use help-setup-xref (Bug#27890). diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index c274621f77..655a5ca6d4 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -838,7 +838,8 @@ The font must be already used by Emacs." (interactive "sFont name (default current choice for ASCII chars): ") (or (and window-system (fboundp 'fontset-list)) (error "No fonts being used")) - (let (font-info) + (let ((xref-item (list #'describe-font fontname)) + font-info) (if (or (not fontname) (= (length fontname) 0)) (setq fontname (face-attribute 'default :font))) (setq font-info (font-info fontname)) @@ -850,6 +851,7 @@ The font must be already used by Emacs." ;; this problem. (message "No information about \"%s\"" (font-xlfd-name fontname)) (message "No matching font found")) + (help-setup-xref xref-item (called-interactively-p 'interactive)) (with-output-to-temp-buffer "*Help*" (describe-font-internal font-info))))) commit 2ef880cc75a393ee57c57930d34c9c4b516db4e4 Author: Katsumi Yamaoka Date: Tue Aug 8 23:40:27 2017 +0000 Don't try to jump to non-existent part (bug#28013) * lisp/gnus/gnus-art.el (gnus-article-edit-part): Don't try to jump to the next part if there is the only one part in the article (bug#28013). diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 3f384c65ec..ce0ff2ee8c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -5058,11 +5058,14 @@ and `gnus-mime-delete-part', and not provided at run-time normally." (gnus-article-edit-done)) (gnus-configure-windows 'article) (sit-for 0) - (when (and current-id (integerp gnus-auto-select-part)) - (gnus-article-jump-to-part - (min (max (+ current-id gnus-auto-select-part) 1) - (with-current-buffer gnus-article-buffer - (length gnus-article-mime-handle-alist))))))) + (let ((handles (with-current-buffer gnus-article-buffer + gnus-article-mime-handle-alist))) + ;; `handles' will be nil if there is the only one part + ;; in the article and is deleted. + (when (and handles current-id (integerp gnus-auto-select-part)) + (gnus-article-jump-to-part + (min (max (+ current-id gnus-auto-select-part) 1) + (length handles))))))) (defun gnus-mime-replace-part (file) "Replace MIME part under point with an external body." commit 63b5a4a65eec5792b985c9d6be68424731bd478d Author: Mark Oteiza Date: Tue Aug 8 15:10:49 2017 -0400 Replace some uses of eval There are a number of places where eval is used unnecessarily to get or set the value of a symbol. * lisp/calendar/calendar.el (diary-date-forms): Use default-value in custom setter. * lisp/desktop.el (desktop-clear): Use set-default instead. * lisp/international/ogonek.el (ogonek-read-encoding): Use symbol-value. diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 84282209dd..1d6749319d 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -835,7 +835,7 @@ For examples of three common styles, see `diary-american-date-forms', diary-american-date-forms) :initialize 'custom-initialize-default :set (lambda (symbol value) - (unless (equal value (eval symbol)) + (unless (equal value (default-value symbol)) (custom-set-default symbol value) (setq diary-font-lock-keywords (diary-font-lock-keywords)) ;; Need to redraw not just to get new font-locking, but also diff --git a/lisp/desktop.el b/lisp/desktop.el index 540d0e3b11..a2260ba490 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -709,8 +709,8 @@ if different)." (setq desktop-io-file-version nil) (dolist (var desktop-globals-to-clear) (if (symbolp var) - (eval `(setq-default ,var nil)) - (eval `(setq-default ,(car var) ,(cdr var))))) + (set-default var nil) + (set-default var (eval (cdr var))))) (let ((preserve-regexp (concat "^\\(" (mapconcat (lambda (regexp) (concat "\\(" regexp "\\)")) diff --git a/lisp/international/ogonek.el b/lisp/international/ogonek.el index ef3a980f19..cabcf90078 100644 --- a/lisp/international/ogonek.el +++ b/lisp/international/ogonek.el @@ -301,13 +301,12 @@ Store the name in the parameter-variable DEFAULT-NAME-VAR. PROMPT is a string to be shown when the user is asked for a name." (let ((encoding (completing-read - (format "%s (default %s): " prompt (eval default-name-var)) + (format "%s (default %s): " prompt (symbol-value default-name-var)) ogonek-name-encoding-alist nil t))) - ;; change the default name to the one just read - (set default-name-var - (if (string= encoding "") (eval default-name-var) encoding)) + ;; change the default name to the one just read, and ;; return the new default as the name you read - (eval default-name-var))) + (set default-name-var + (if (string= encoding "") (symbol-value default-name-var) encoding)))) (defun ogonek-read-prefix (prompt default-prefix-var) "Read a prefix character for prefix notation. commit 884d43b43eb51fe91c657ed0780cf85d31522248 Author: Mark Oteiza Date: Tue Aug 8 15:00:21 2017 -0400 Convert uses of looking-at in viper-ex to following-char * lisp/emulation/viper-ex.el (viper-get-ex-token): Bind (following-char) and use it in the subsequent cond's clauses. (viper-ex, ex-quit, viper-get-ex-file): Use following-char instead. Convert single branch ifs to when diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index ca067033e6..185cf990f7 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -401,13 +401,14 @@ reversed." (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) (set-buffer viper-ex-work-buf) (skip-chars-forward " \t|") - (let ((case-fold-search t)) - (cond ((looking-at "#") + (let ((case-fold-search t) + (char (following-char))) + (cond ((= char ?#) (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) + (setq ex-token (char-to-string char)) (forward-char 1)) ((looking-at "[a-z]") (viper-get-ex-com-subr)) - ((looking-at "\\.") + ((= char ?.) (forward-char 1) (setq ex-token-type 'dot)) ((looking-at "[0-9]") @@ -419,13 +420,13 @@ reversed." (t 'abs-number))) (setq ex-token (string-to-number (buffer-substring (point) (mark t))))) - ((looking-at "\\$") + ((= char ?$) (forward-char 1) (setq ex-token-type 'end)) - ((looking-at "%") + ((= char ?%) (forward-char 1) (setq ex-token-type 'whole)) - ((looking-at "+") + ((= char ?+) (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) (forward-char 1) (insert "1") @@ -436,7 +437,7 @@ reversed." (setq ex-token-type 'plus)) (t (error viper-BadAddress)))) - ((looking-at "-") + ((= char ?-) (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) (forward-char 1) (insert "1") @@ -447,7 +448,7 @@ reversed." (setq ex-token-type 'minus)) (t (error viper-BadAddress)))) - ((looking-at "/") + ((= char ?/) (forward-char 1) (set-mark (point)) (let ((cont t)) @@ -459,9 +460,9 @@ reversed." (setq cont nil)))) (backward-char 1) (setq ex-token (buffer-substring (point) (mark t))) - (if (looking-at "/") (forward-char 1)) + (when (= (following-char) ?/) (forward-char 1)) (setq ex-token-type 'search-forward)) - ((looking-at "\\?") + ((= char ??) (forward-char 1) (set-mark (point)) (let ((cont t)) @@ -472,27 +473,27 @@ reversed." (line-beginning-position 0))) (setq cont nil)) (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) + (when (/= (following-char) ?\n) (forward-char 1)))) (setq ex-token-type 'search-backward) (setq ex-token (buffer-substring (1- (point)) (mark t)))) - ((looking-at ",") + ((= char ?,) (forward-char 1) (setq ex-token-type 'comma)) - ((looking-at ";") + ((= char ?\;) (forward-char 1) (setq ex-token-type 'semi-colon)) ((looking-at "[!=><&~]") (setq ex-token-type 'command) - (setq ex-token (char-to-string (following-char))) + (setq ex-token (char-to-string char)) (forward-char 1)) - ((looking-at "'") + ((= char ?\') (setq ex-token-type 'goto-mark) (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) + (cond ((= (following-char) ?\') (setq ex-token nil)) ((looking-at "[a-z]") (setq ex-token (following-char))) (t (error "%s" "Marks are ' and a-z"))) (forward-char 1)) - ((looking-at "\n") + ((= char ?\n) (setq ex-token-type 'end-mark) (setq ex-token "goto")) (t @@ -687,9 +688,9 @@ reversed." (get-buffer-create viper-ex-work-buf-name)) (set-buffer viper-ex-work-buf) (skip-chars-forward " \t") - (cond ((looking-at "|") + (cond ((= (following-char) ?|) (forward-char 1)) - ((looking-at "\n") + ((= (following-char) ?\n) (setq cont nil)) (t (error "`%s': %s" ex-token viper-SpuriousText))) @@ -994,33 +995,31 @@ reversed." (with-current-buffer (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) (skip-chars-forward " \t") - (if (looking-at "!") - (if (and (not (looking-back "[ \t]" (1- (point)))) - ;; read doesn't have a corresponding :r! form, so ! is - ;; immediately interpreted as a shell command. - (not (string= ex-token "read"))) - (progn - (setq ex-variant t) - (forward-char 1) - (skip-chars-forward " \t")) - (setq ex-cmdfile t) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at ">>") - (progn - (setq ex-append t - ex-variant t) - (forward-char 2) - (skip-chars-forward " \t"))) - (if (looking-at "+") - (progn - (forward-char 1) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-offset (buffer-substring (point) (mark t))) - (forward-char 1) - (skip-chars-forward " \t"))) + (when (= (following-char) ?!) + (if (and (not (memq (preceding-char) '(?\s ?\t))) + ;; read doesn't have a corresponding :r! form, so ! is + ;; immediately interpreted as a shell command. + (not (string= ex-token "read"))) + (progn + (setq ex-variant t) + (forward-char 1) + (skip-chars-forward " \t")) + (setq ex-cmdfile t) + (forward-char 1) + (skip-chars-forward " \t"))) + (when (looking-at ">>") + (setq ex-append t + ex-variant t) + (forward-char 2) + (skip-chars-forward " \t")) + (when (= (following-char) ?+) + (forward-char 1) + (set-mark (point)) + (re-search-forward "[ \t\n]") + (backward-char 1) + (setq ex-offset (buffer-substring (point) (mark t))) + (forward-char 1) + (skip-chars-forward " \t")) ;; this takes care of :r, :w, etc., when they get file names ;; from the history list (if (member ex-token '("read" "write" "edit" "visual" "next")) @@ -1602,7 +1601,7 @@ reversed." ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc. (with-current-buffer (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) - (if (looking-at "!") (forward-char 1))) + (when (= (following-char) ?!) (forward-char 1))) (if (< viper-expert-level 3) (save-buffers-kill-emacs) (kill-buffer (current-buffer)))) @@ -2322,8 +2321,4 @@ Type `mak ' (including the space) to run make with no args." (with-output-to-temp-buffer " *viper-info*" (princ lines)))))) - - - - ;;; viper-ex.el ends here commit 4cb0bdd675f0bc3adc130f1f3d037e4d51152396 Author: Mark Oteiza Date: Tue Aug 8 14:09:38 2017 -0400 Some cleanup in message.el * lisp/gnus/message.el (message-cross-post-insert-note): (message-strip-forbidden-properties): Mark unused args. (message-canlock-generate): Remove extinct variable sha1-maximum-internal-length. (message-make-mail-followup-to): Use loop's thereis clause. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 0f8fdfc9c7..996b0ac5af 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -2325,7 +2325,7 @@ With prefix-argument just set Follow-Up, don't cross-post." (setq message-cross-post-old-target target-group)) (defun message-cross-post-insert-note (target-group cross-post in-old - old-groups) + _old-groups) "Insert a in message body note about a set Followup or Crosspost. If there have been previous notes, delete them. TARGET-GROUP specifies the group to Followup-To. When CROSS-POST is t, insert note about @@ -2843,7 +2843,7 @@ These properties are essential to work, so we should never strip them." (eq message-mail-alias-type type) (memq type message-mail-alias-type))) -(defun message-strip-forbidden-properties (begin end &optional old-length) +(defun message-strip-forbidden-properties (begin end &optional _old-length) "Strip forbidden properties between BEGIN and END, ignoring the third arg. This function is intended to be called from `after-change-functions'. See also `message-forbidden-properties'." @@ -4842,17 +4842,13 @@ command evaluates `message-send-mail-hook' just before sending a message." (run-hooks 'message-send-mail-hook) (mailclient-send-it)) -(defvar sha1-maximum-internal-length) - (defun message-canlock-generate () "Return a string that is non-trivial to guess. Do not use this for anything important, it is cryptographically weak." - (require 'sha1) - (let (sha1-maximum-internal-length) - (sha1 (concat (message-unique-id) - (format "%x%x%x" (random) (random) (random)) - (prin1-to-string (recent-keys)) - (prin1-to-string (garbage-collect)))))) + (sha1 (concat (message-unique-id) + (format "%x%x%x" (random) (random) (random)) + (prin1-to-string (recent-keys)) + (prin1-to-string (garbage-collect))))) (defvar canlock-password) (defvar canlock-password-for-verify) @@ -5852,7 +5848,7 @@ subscribed address (and not the additional To and Cc header contents)." (let ((list (loop for recipient in recipients when (loop for regexp in mft-regexps - when (string-match regexp recipient) return t) + thereis (string-match regexp recipient)) return recipient))) (when list (if only-show-subscribed commit 7d1115e0c792f79c9eb728bf9027053a5868ff23 Author: Paul Eggert Date: Tue Aug 8 09:49:40 2017 -0700 Document make-temp-name magic limitations * doc/lispref/files.texi (Unique File Names): * src/fileio.c (Fmake_temp_name): Document that make-temp-name does not guarantee uniqueness on magic file names. diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 2b692dbf68..d3f40a7c0c 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -2547,13 +2547,14 @@ should compute the directory like this: @end defopt @defun make-temp-name base-name -This function generates a string that can be used as a unique file +This function generates a string that might be a unique file name. The name starts with @var{base-name}, and has several random characters appended to it, which are different in each Emacs job. It is like @code{make-temp-file} except that (i) it just constructs a -name, and does not create a file, and (ii) @var{base-name} should be -an absolute file name (on MS-DOS, this function can truncate -@var{base-name} to fit into the 8+3 file-name limits). +name and does not create a file, (ii) @var{base-name} should be an +absolute file name that is not magic, and (iii) if the returned file +name is magic, it might name an existing file. @xref{Magic File +Names}. @strong{Warning:} In most cases, you should not use this function; use @code{make-temp-file} instead! This function is susceptible to a race diff --git a/src/fileio.c b/src/fileio.c index db760d9b22..15845e3914 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -757,7 +757,8 @@ danger of generating a name being used by another Emacs process \(so long as only a single host can access the containing directory...). This function tries to choose a name that has no existing file. -For this to work, PREFIX should be an absolute file name. +For this to work, PREFIX should be an absolute file name, and PREFIX +and the returned string should both be non-magic. There is a race condition between calling `make-temp-name' and creating the file, which opens all kinds of security holes. For that reason, you should commit 846870e508021ee8d1099280b3f40fe108a34bf0 Author: Tom Tromey Date: Sun Mar 5 10:48:41 2017 -0700 Show number of errors in compilation-mode mode-line Bug#25354 * lisp/progmodes/compile.el (compilation-num-errors-found): Provide default value. (compilation-num-warnings-found, compilation-num-infos-found): New defvars. (compilation-mode-line-errors): New defconst. (compilation-face): Remove. (compilation-type, compilation--note-type): New functions. (compilation-parse-errors): Call compilation--note-type. (compilation-start): Include compilation-mode-line-errors in mode-line-process. (compilation-setup): Initialize compilation-num-* variables to 0. (compilation-handle-exit): Include compilation-mode-line-errors in mode-line-process. * doc/emacs/building.texi (Compilation): Document new feature. diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index f7eb8fe9ea..cc79eae777 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -90,6 +90,10 @@ inserted above point, which remains at the end. Otherwise, point remains fixed while compilation output is added at the end of the buffer. + While compilation proceeds, the mode line is updated to show the +number of errors, warnings, and informational messages that have been +seen so far. + @cindex compilation buffer, keeping point at end @vindex compilation-scroll-output If you change the variable @code{compilation-scroll-output} to a diff --git a/etc/NEWS b/etc/NEWS index 58b08348b1..2b789be3c8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -740,6 +740,11 @@ where to place point after C-c M-r and C-c M-s. --- *** Messages from CMake are now recognized. ++++ +*** The number of errors, warnings, and informational messages is now +displayed in the mode line. These are updated as compilation +proceeds. + +++ *** A new option 'dired-always-read-filesystem' default to nil. If non-nil, buffers visiting files are reverted before search them; diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 31ec5a67d0..f0935cd2ad 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -127,7 +127,21 @@ and a string describing how the process finished.") (defvar compilation-arguments nil "Arguments that were given to `compilation-start'.") -(defvar compilation-num-errors-found) +(defvar compilation-num-errors-found 0) +(defvar compilation-num-warnings-found 0) +(defvar compilation-num-infos-found 0) + +(defconst compilation-mode-line-errors + '(" [" (:propertize (:eval (int-to-string compilation-num-errors-found)) + face compilation-error + help-echo "Number of errors so far") + " " (:propertize (:eval (int-to-string compilation-num-warnings-found)) + face compilation-warning + help-echo "Number of warnings so far") + " " (:propertize (:eval (int-to-string compilation-num-infos-found)) + face compilation-info + help-echo "Number of informational messages so far") + "]")) ;; If you make any changes to `compilation-error-regexp-alist-alist', ;; be sure to run the ERT test in test/lisp/progmodes/compile-tests.el. @@ -886,10 +900,10 @@ from a different message." :group 'compilation :version "22.1") -(defun compilation-face (type) - (or (and (car type) (match-end (car type)) compilation-warning-face) - (and (cdr type) (match-end (cdr type)) compilation-info-face) - compilation-error-face)) +(defun compilation-type (type) + (or (and (car type) (match-end (car type)) 1) + (and (cdr type) (match-end (cdr type)) 0) + 2)) ;; LOC (or location) is a list of (COLUMN LINE FILE-STRUCTURE nil nil) @@ -1334,6 +1348,14 @@ FMTS is a list of format specs for transforming the file name. (compilation-parse-errors start end))) +(defun compilation--note-type (type) + "Note that a new message with severity TYPE was seen. +This updates the appropriate variable used by the mode-line." + (cl-case type + (0 (cl-incf compilation-num-infos-found)) + (1 (cl-incf compilation-num-warnings-found)) + (2 (cl-incf compilation-num-errors-found)))) + (defun compilation-parse-errors (start end &rest rules) "Parse errors between START and END. The errors recognized are the ones specified in RULES which default @@ -1397,14 +1419,17 @@ to `compilation-error-regexp-alist' if RULES is nil." file line end-line col end-col (or type 2) fmt)) (when (integerp file) + (setq type (if (consp type) + (compilation-type type) + (or type 2))) + (compilation--note-type type) + (compilation--put-prop file 'font-lock-face - (if (consp type) - (compilation-face type) - (symbol-value (aref [compilation-info-face - compilation-warning-face - compilation-error-face] - (or type 2)))))) + (symbol-value (aref [compilation-info-face + compilation-warning-face + compilation-error-face] + type)))) (compilation--put-prop line 'font-lock-face compilation-line-face) @@ -1768,7 +1793,8 @@ Returns the compilation buffer created." outbuf command)))) ;; Make the buffer's mode line show process state. (setq mode-line-process - '(:propertize ":%s" face compilation-mode-line-run)) + '((:propertize ":%s" face compilation-mode-line-run) + compilation-mode-line-errors)) ;; Set the process as killable without query by default. ;; This allows us to start a new compilation without @@ -1797,7 +1823,8 @@ Returns the compilation buffer created." (message "Executing `%s'..." command) ;; Fake mode line display as if `start-process' were run. (setq mode-line-process - '(:propertize ":run" face compilation-mode-line-run)) + '((:propertize ":run" face compilation-mode-line-run) + compilation-mode-line-errors)) (force-mode-line-update) (sit-for 0) ; Force redisplay (save-excursion @@ -2106,6 +2133,9 @@ Optional argument MINOR indicates this is called from (make-local-variable 'compilation-messages-start) (make-local-variable 'compilation-error-screen-columns) (make-local-variable 'overlay-arrow-position) + (setq-local compilation-num-errors-found 0) + (setq-local compilation-num-warnings-found 0) + (setq-local compilation-num-infos-found 0) (set (make-local-variable 'overlay-arrow-string) "") (setq next-error-overlay-arrow-position nil) (add-hook 'kill-buffer-hook @@ -2195,16 +2225,18 @@ commands of Compilation major mode are available. See (add-text-properties omax (point) (append '(compilation-handle-exit t) nil)) (setq mode-line-process - (let ((out-string (format ":%s [%s]" process-status (cdr status))) - (msg (format "%s %s" mode-name - (replace-regexp-in-string "\n?$" "" - (car status))))) - (message "%s" msg) - (propertize out-string - 'help-echo msg - 'face (if (> exit-status 0) - 'compilation-mode-line-fail - 'compilation-mode-line-exit)))) + (list + (let ((out-string (format ":%s [%s]" process-status (cdr status))) + (msg (format "%s %s" mode-name + (replace-regexp-in-string "\n?$" "" + (car status))))) + (message "%s" msg) + (propertize out-string + 'help-echo msg + 'face (if (> exit-status 0) + 'compilation-mode-line-fail + 'compilation-mode-line-exit))) + compilation-mode-line-errors)) ;; Force mode line redisplay soon. (force-mode-line-update) (if (and opoint (< opoint omax)) commit c3445aed51944becb3e58f5dace8121c0021f6c7 Author: Mark Oteiza Date: Mon Aug 7 21:50:11 2017 -0400 Do some cleanup in mailcap.el * lisp/net/mailcap.el: Use lexical-binding. (mailcap--set-user-mime-data, mailcap-possible-viewers): Use pcase destructuring. (mailcap-mime-data): Remove some entries for ancient functions. (mailcap-parse-mailcaps, mailcap-mime-info): Nix single-branch ifs. (mailcap-parse-mimetype-file): Just use append. (mailcap-command-p): Remove unused function. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 89f6c91156..0b79521b7a 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1,4 +1,4 @@ -;;; mailcap.el --- MIME media types configuration +;;; mailcap.el --- MIME media types configuration -*- lexical-binding: t -*- ;; Copyright (C) 1998-2017 Free Software Foundation, Inc. @@ -29,7 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (autoload 'mail-header-parse-content-type "mail-parse") (defgroup mailcap nil @@ -70,11 +69,10 @@ (defun mailcap--set-user-mime-data (sym val) (let (res) - (dolist (entry val) - (push `((viewer . ,(car entry)) - (type . ,(cadr entry)) - ,@(when (cl-caddr entry) - `((test . ,(cl-caddr entry))))) + (pcase-dolist (`(,viewer ,type ,test) val) + (push `((viewer . ,viewer) + (type . ,type) + ,@(when test `((test . ,test)))) res)) (set-default sym (nreverse res)))) @@ -121,12 +119,6 @@ is consulted." (viewer . "gnumeric %s") (test . (getenv "DISPLAY")) (type . "application/vnd.ms-excel")) - ("x-x509-ca-cert" - (viewer . ssl-view-site-cert) - (type . "application/x-x509-ca-cert")) - ("x-x509-user-cert" - (viewer . ssl-view-user-cert) - (type . "application/x-x509-user-cert")) ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) @@ -172,10 +164,6 @@ is consulted." (non-viewer . t) (type . "application/zip") ("copiousoutput")) - ("pdf" - (viewer . pdf-view-mode) - (type . "application/pdf") - (test . (eq window-system 'x))) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") @@ -434,9 +422,8 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (if (stringp path) (split-string path path-separator t) path))) - (if (and (file-readable-p fname) - (file-regular-p fname)) - (mailcap-parse-mailcap fname))) + (when (and (file-readable-p fname) (file-regular-p fname)) + (mailcap-parse-mailcap fname))) (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) @@ -597,13 +584,12 @@ the test clause will be unchanged." "Return a list of possible viewers from MAJOR for minor type MINOR." (let ((exact '()) (wildcard '())) - (while major + (pcase-dolist (`(,type . ,attrs) major) (cond - ((equal (car (car major)) minor) - (push (cdr (car major)) exact)) - ((and minor (string-match (concat "^" (car (car major)) "$") minor)) - (push (cdr (car major)) wildcard))) - (setq major (cdr major))) + ((equal type minor) + (push attrs exact)) + ((and minor (string-match (concat "^" type "$") minor)) + (push attrs wildcard)))) (nconc exact wildcard))) (defun mailcap-unescape-mime-test (test type-info) @@ -801,10 +787,9 @@ If NO-DECODE is non-nil, don't decode STRING." (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) (cdr a))) (cdr ctl))) - (while viewers - (if (mailcap-viewer-passes-test (car viewers) info) - (push (car viewers) passed)) - (setq viewers (cdr viewers))) + (dolist (entry viewers) + (when (mailcap-viewer-passes-test entry info) + (push entry passed))) (setq passed (sort passed 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) @@ -971,8 +956,8 @@ If FORCE, re-parse even if already parsed." (dolist (fname (reverse (if (stringp path) (split-string path path-separator t) path))) - (if (and (file-readable-p fname)) - (mailcap-parse-mimetype-file fname))) + (when (file-readable-p fname) + (mailcap-parse-mimetype-file fname))) (setq mailcap-mimetypes-parsed-p t))) (defun mailcap-parse-mimetype-file (fname) @@ -980,7 +965,7 @@ If FORCE, re-parse even if already parsed." (let (type ; The MIME type for this line extns ; The extensions for this line save-pos ; Misc. saved buffer positions - ) + save-extn) (with-temp-buffer (insert-file-contents fname) (mailcap-replace-regexp "#.*" "") @@ -1000,15 +985,13 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^ \t\n") - (setq extns (cons (buffer-substring save-pos (point)) extns))) - (while extns - (setq mailcap-mime-extensions - (cons - (cons (if (= (string-to-char (car extns)) ?.) - (car extns) - (concat "." (car extns))) type) - mailcap-mime-extensions) - extns (cdr extns))))))) + (setq save-extn (buffer-substring save-pos (point))) + (push (cons (if (= (string-to-char save-extn) ?.) + save-extn (concat "." save-extn)) + type) + extns)) + (setq mailcap-mime-extensions (append extns mailcap-mime-extensions) + extns nil))))) (defun mailcap-extension-to-mime (extn) "Return the MIME content type of the file extensions EXTN." @@ -1018,9 +1001,6 @@ If FORCE, re-parse even if already parsed." (setq extn (concat "." extn))) (cdr (assoc (downcase extn) mailcap-mime-extensions))) -;; Unused? -(defalias 'mailcap-command-p 'executable-find) - (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) commit 919ac3ae1635bf2b99eb1f3efc7476826359e92a Author: Tino Calancha Date: Tue Aug 8 10:25:27 2017 +0900 query-replace: Undo replacements performed with 'comma During a `query-replace', the char ',' replaces the character at point and doesn't move point; right after, the char 'u' must undo such replacement (Bug#27268). * lisp/replace.el (replace--push-stack): New macro extracted from `perform-replace'. (perform-replace): Use it. * test/lisp/replace-tests.el (query-replace--undo): Add test. diff --git a/lisp/replace.el b/lisp/replace.el index a5024943e6..09972b40db 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2221,6 +2221,26 @@ It is called with three arguments, as if it were ;; Close overlays opened by `isearch-range-invisible' in `perform-replace'. (isearch-clean-overlays)) +;; A macro because we push STACK, i.e. a local var in `perform-replace'. +(defmacro replace--push-stack (replaced search-str next-replace stack) + (declare (indent 0) (debug (form form form gv-place))) + `(push (list (point) ,replaced +;;; If the replacement has already happened, all we need is the +;;; current match start and end. We could get this with a trivial +;;; match like +;;; (save-excursion (goto-char (match-beginning 0)) +;;; (search-forward (match-string 0)) +;;; (match-data t)) +;;; if we really wanted to avoid manually constructing match data. +;;; Adding current-buffer is necessary so that match-data calls can +;;; return markers which are appropriate for editing. + (if ,replaced + (list + (match-beginning 0) (match-end 0) (current-buffer)) + (match-data t)) + ,search-str ,next-replace) + ,stack)) + (defun perform-replace (from-string replacements query-flag regexp-flag delimited-flag &optional repeat-count map start end backward region-noncontiguous-p) @@ -2264,6 +2284,8 @@ It must return a string." (next-replacement-replaced nil) ; replacement string ; (substituted regexp) (last-was-undo) + (last-was-act-and-show) + (update-stack t) (replace-count 0) (skip-read-only-count 0) (skip-filtered-count 0) @@ -2547,7 +2569,7 @@ It must return a string." next-replacement) (while (and (< stack-idx stack-len) stack - (null replaced)) + (or (null replaced) last-was-act-and-show)) (let* ((elt (nth stack-idx stack))) (setq stack-idx (1+ stack-idx) @@ -2557,10 +2579,11 @@ It must return a string." search-string (nth (if replaced 4 3) elt) next-replacement (nth (if replaced 3 4) elt) search-string-replaced search-string - next-replacement-replaced next-replacement) + next-replacement-replaced next-replacement + last-was-act-and-show nil) (when (and (= stack-idx stack-len) - (null replaced) + (and (null replaced) (not last-was-act-and-show)) (zerop num-replacements)) (message "Nothing to undo") (ding 'no-terminate) @@ -2600,7 +2623,7 @@ It must return a string." "replacements")) (ding 'no-terminate) (sit-for 1))) - (setq replaced nil last-was-undo t))) + (setq replaced nil last-was-undo t last-was-act-and-show nil))) ((eq def 'act) (or replaced (setq noedit @@ -2608,7 +2631,7 @@ It must return a string." next-replacement nocasify literal noedit real-match-data backward) replace-count (1+ replace-count))) - (setq done t replaced t)) + (setq done t replaced t update-stack (not last-was-act-and-show))) ((eq def 'act-and-exit) (or replaced (setq noedit @@ -2619,7 +2642,7 @@ It must return a string." (setq keep-going nil) (setq done t replaced t)) ((eq def 'act-and-show) - (if (not replaced) + (unless replaced (setq noedit (replace-match-maybe-edit next-replacement nocasify literal @@ -2627,7 +2650,11 @@ It must return a string." replace-count (1+ replace-count) real-match-data (replace-match-data t real-match-data) - replaced t))) + replaced t last-was-act-and-show t) + (replace--push-stack + replaced + search-string-replaced + next-replacement-replaced stack))) ((or (eq def 'automatic) (eq def 'automatic-all)) (or replaced (setq noedit @@ -2638,7 +2665,7 @@ It must return a string." (setq done t query-flag nil replaced t) (if (eq def 'automatic-all) (setq multi-buffer t))) ((eq def 'skip) - (setq done t)) + (setq done t update-stack (not last-was-act-and-show))) ((eq def 'recenter) ;; `this-command' has the value `query-replace', ;; so we need to bind it to `recenter-top-bottom' @@ -2708,27 +2735,14 @@ It must return a string." ;; Record previous position for ^ when we move on. ;; Change markers to numbers in the match data ;; since lots of markers slow down editing. - (push (list (point) replaced -;;; If the replacement has already happened, all we need is the -;;; current match start and end. We could get this with a trivial -;;; match like -;;; (save-excursion (goto-char (match-beginning 0)) -;;; (search-forward (match-string 0)) -;;; (match-data t)) -;;; if we really wanted to avoid manually constructing match data. -;;; Adding current-buffer is necessary so that match-data calls can -;;; return markers which are appropriate for editing. - (if replaced - (list - (match-beginning 0) - (match-end 0) - (current-buffer)) - (match-data t)) - search-string-replaced - next-replacement-replaced) - stack) + (when update-stack + (replace--push-stack + replaced + search-string-replaced + next-replacement-replaced stack)) (setq next-replacement-replaced nil - search-string-replaced nil)))))) + search-string-replaced nil + last-was-act-and-show nil)))))) (replace-dehighlight)) (or unread-command-events (message "Replaced %d occurrence%s%s" diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index adef5a3f3d..a8bc5407f4 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -358,4 +358,26 @@ Each element has the format: (dotimes (i (length replace-occur-tests)) (replace-occur-test-create i)) +(defun replace-tests--query-replace-undo (&optional comma) + (with-temp-buffer + (insert "111") + (goto-char 1) + (let ((count 0)) + ;; Don't wait for user input. + (cl-letf (((symbol-function 'read-event) + (lambda (&rest args) + (cl-incf count) + (let ((val (pcase count + ('2 (if comma ?, ?\s)) ; replace and: ',' no move; '\s' go next + ('3 ?u) ; undo + ('4 ?q) ; exit + (_ ?\s)))) ; replace current and go next + val)))) + (perform-replace "1" "2" t nil nil))) + (buffer-string))) + +(ert-deftest query-replace--undo () + (should (string= "211" (replace-tests--query-replace-undo))) + (should (string= "211" (replace-tests--query-replace-undo 'comma)))) + ;;; replace-tests.el ends here commit bec5b602597b8b6f596067167f3b3fe0e6eff285 Merge: e6fa08363d 79a74568e9 Author: Noam Postavsky Date: Mon Aug 7 21:09:19 2017 -0400 ; Merge: Fixes for macroexpansion and compilation commit 79a74568e9166f63a12adb30f54edcd57a6405a3 Author: Noam Postavsky Date: Thu Jul 13 00:42:38 2017 -0400 Don't define gv expanders in compiler's runtime (Bug#27016) This prevents definitions being compiled from leaking into the current Emacs doing the compilation. * lisp/emacs-lisp/gv.el (gv-define-expander): Use function-put instead of `put' with `eval-and-compile'. * test/lisp/emacs-lisp/gv-tests.el: New tests. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index 27376fc7f9..a8b8974cb4 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -146,12 +146,7 @@ NAME is a symbol: the name of a function, macro, or special form. HANDLER is a function which takes an argument DO followed by the same arguments as NAME. DO is a function as defined in `gv-get'." (declare (indent 1) (debug (sexp form))) - ;; Use eval-and-compile so the method can be used in the same file as it - ;; is defined. - ;; FIXME: Just like byte-compile-macro-environment, we should have something - ;; like byte-compile-symbolprop-environment so as to handle these things - ;; cleanly without affecting the running Emacs. - `(eval-and-compile (put ',name 'gv-expander ,handler))) + `(function-put ',name 'gv-expander ,handler)) ;;;###autoload (defun gv--defun-declaration (symbol name args handler &optional fix) diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el new file mode 100644 index 0000000000..f19af024b5 --- /dev/null +++ b/test/lisp/emacs-lisp/gv-tests.el @@ -0,0 +1,147 @@ +;;; gv-tests.el --- tests for gv.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; 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 . + +;;; Code: + +(require 'ert) +(eval-when-compile (require 'cl-lib)) + +(cl-defmacro gv-tests--in-temp-dir ((elvar elcvar) + (&rest filebody) + &rest body) + (declare (indent 2)) + `(let ((default-directory (make-temp-file "gv-test" t))) + (unwind-protect + (let ((,elvar "gv-test-deffoo.el") + (,elcvar "gv-test-deffoo.elc")) + (with-temp-file ,elvar + (insert ";; -*- lexical-binding: t; -*-\n") + (dolist (form ',filebody) + (pp form (current-buffer)))) + ,@body) + (delete-directory default-directory t)))) + +(ert-deftest gv-define-expander-in-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-define-expander-in-file-twice () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (gv-define-setter gv-test-foo (newval cons) + `(setcdr ,cons ,newval)) + (setf (gv-test-foo gv-test-pair) 42) + (message "%S" gv-test-pair)) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "(99 . 42)\n"))))) + +(ert-deftest gv-dont-define-expander-in-file () + ;; The expander is defined while we are compiling the file, even + ;; though it's inside (when nil ...) because the compiler won't + ;; analyze the conditional. + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((when nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +(ert-deftest gv-define-expander-in-function () + ;; The expander is not defined while we are compiling the file, the + ;; compiler won't handle gv definitions not at top-level. + :expected-result :failed + (gv-tests--in-temp-dir (el elc) + ((defun foo () + (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + t) + (defvar gv-test-pair (cons 1 2)) + (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-define-expander-out-of-file () + (gv-tests--in-temp-dir (el elc) + ((gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval)) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) "99\n"))))) + +(ert-deftest gv-dont-define-expander-other-file () + (gv-tests--in-temp-dir (el elc) + ((if nil (gv-define-setter gv-test-foo (newval cons) + `(setcar ,cons ,newval))) + (defvar gv-test-pair (cons 1 2))) + (with-temp-buffer + (call-process (concat invocation-directory invocation-name) + nil '(t t) nil + "-Q" "-batch" "--eval" (prin1-to-string `(byte-compile-file ,el)) + "-l" elc + "--eval" + (prin1-to-string '(progn (setf (gv-test-foo gv-test-pair) 99) + (message "%d" (car gv-test-pair))))) + (should (equal (buffer-string) + "Symbol's function definition is void: \\(setf\\ gv-test-foo\\)\n"))))) + +;; `ert-deftest' messes up macroexpansion when the test file itself is +;; compiled (see Bug #24402). + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; gv-tests.el ends here commit b5c8e9898d9dbd4145c40d08e8eef84a5e32008a Author: Noam Postavsky Date: Fri Aug 4 19:50:21 2017 -0400 Let the cl-typep effects of defclass work during compilation (Bug#27718) * lisp/emacs-lisp/eieio.el (defclass): Use `define-symbol-prop' instead of `put'. * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-tests--dummy-function): Remove. (eieio-test-25-slot-tests, eieio-test-23-inheritance-check): Don't expect to fail if compiled. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 1a7de55fce..8b92d5b7ac 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -246,7 +246,7 @@ This method is obsolete." ;; test, so we can let typep have the CLOS documented behavior ;; while keeping our above predicate clean. - (put ',name 'cl-deftype-satisfies #',testsym2) + (define-symbol-prop ',name 'cl-deftype-satisfies #',testsym2) (eieio-defclass-internal ',name ',superclasses ',slots ',options-and-doc) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index d824bfc1bb..1a6ab9da08 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -529,15 +529,7 @@ METHOD is the method that was attempting to be called." "This class should break.")) :type 'invalid-slot-type)) -(defun eieio-tests--dummy-function () - ;; Dummy function to see if the file is compiled. - t) - (ert-deftest eieio-test-23-inheritance-check () - ;; This test fails when compiled, see Bug#27718. - :expected-result (if (byte-code-function-p - (symbol-function 'eieio-tests--dummy-function)) - :failed :passed) (should (child-of-class-p 'class-ab 'class-a)) (should (child-of-class-p 'class-ab 'class-b)) (should (object-of-class-p eitest-a 'class-a)) @@ -556,10 +548,6 @@ METHOD is the method that was attempting to be called." (should (not (cl-typep "foo" 'class-a)))) (ert-deftest eieio-test-24-object-predicates () - ;; This test fails when compiled, see Bug#27718. - :expected-result (if (byte-code-function-p - (symbol-function 'eieio-tests--dummy-function)) - :failed :passed) (let ((listooa (list (class-ab) (class-a))) (listoob (list (class-ab) (class-b)))) (should (cl-typep listooa '(list-of class-a))) commit cc30d77ecdd1b9155ade3d0656a84a0839ee2795 Author: Stefan Monnier Date: Fri Jul 14 00:32:34 2017 -0400 Let `define-symbol-prop' take effect during compilation * src/fns.c (syms_of_fns): New variable `overriding-plist-environment'. (Fget): Consult it. * lisp/emacs-lisp/bytecomp.el (byte-compile-close-variables): Let-bind it to nil. (byte-compile-define-symbol-prop): New function, handles compilation of top-level `define-symbol-prop' and `function-put' calls by putting the symbol setting into `overriding-plist-environment'. Co-authored-by: Noam Postavsky diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5fa7389e43..9e14c91c95 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1572,6 +1572,7 @@ extra args." ;; macroenvironment. (copy-alist byte-compile-initial-macro-environment)) (byte-compile--outbuffer nil) + (overriding-plist-environment nil) (byte-compile-function-environment nil) (byte-compile-bound-variables nil) (byte-compile-lexical-variables nil) @@ -4714,6 +4715,34 @@ binding slots have been popped." 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local) (defun byte-compile-form-make-variable-buffer-local (form) (byte-compile-keep-pending form 'byte-compile-normal-call)) + +(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop) +(defun byte-compile-define-symbol-prop (form) + (pcase form + ((and `(,op ,fun ,prop ,val) + (guard (and (macroexp-const-p fun) + (macroexp-const-p prop) + (or (macroexp-const-p val) + ;; Also accept anonymous functions, since + ;; we're at top-level which implies they're + ;; also constants. + (pcase val (`(function (lambda . ,_)) t)))))) + (byte-compile-push-constant op) + (byte-compile-form fun) + (byte-compile-form prop) + (let* ((fun (eval fun)) + (prop (eval prop)) + (val (if (macroexp-const-p val) + (eval val) + (byte-compile-lambda (cadr val))))) + (push `(,fun + . (,prop ,val ,@(alist-get fun overriding-plist-environment))) + overriding-plist-environment) + (byte-compile-push-constant val) + (byte-compile-out 'byte-call 3))) + + (_ (byte-compile-keep-pending form)))) ;;; tags diff --git a/src/fns.c b/src/fns.c index d849618f2b..00b6ed6a28 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1987,6 +1987,10 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */) (Lisp_Object symbol, Lisp_Object propname) { CHECK_SYMBOL (symbol); + Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)), + propname); + if (!NILP (propval)) + return propval; return Fplist_get (XSYMBOL (symbol)->plist, propname); } @@ -5163,6 +5167,13 @@ syms_of_fns (void) DEFSYM (Qcursor_in_echo_area, "cursor-in-echo-area"); DEFSYM (Qwidget_type, "widget-type"); + DEFVAR_LISP ("overriding-plist-environment", Voverriding_plist_environment, + doc: /* An alist overrides the plists of the symbols which it lists. +Used by the byte-compiler to apply `define-symbol-prop' during +compilation. */); + Voverriding_plist_environment = Qnil; + DEFSYM (Qoverriding_plist_environment, "overriding-plist-environment"); + staticpro (&string_char_byte_cache_string); string_char_byte_cache_string = Qnil; diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index d15bd8b6e6..8ef2ce7025 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -545,6 +545,23 @@ literals (Bug#20852)." This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual."))))))) + +(ert-deftest bytecomp-tests-function-put () + "Check `function-put' operates during compilation." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (dolist (form '((function-put 'bytecomp-tests--foo 'foo 1) + (function-put 'bytecomp-tests--foo 'bar 2) + (defmacro bytecomp-tests--foobar () + `(cons ,(function-get 'bytecomp-tests--foo 'foo) + ,(function-get 'bytecomp-tests--foo 'bar))) + (defvar bytecomp-tests--foobar 1) + (setq bytecomp-tests--foobar (bytecomp-tests--foobar)))) + (print form (current-buffer))) + (write-region (point-min) (point-max) source nil 'silent) + (byte-compile-file source t) + (should (equal bytecomp-tests--foobar (cons 1 2))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: commit 00f7e31110a27e568529192d7441d9631b9096bc Author: Gemini Lasswell Date: Thu Jul 20 12:01:42 2017 -0700 Add a test of handling of circular values to testcover-tests * test/lisp/emacs-lisp-testcover-resources/testcases.el (testcover-testcase-cyc1): New function. (testcover-tests-circular-lists-bug-24402): New test. diff --git a/test/lisp/emacs-lisp/testcover-resources/testcases.el b/test/lisp/emacs-lisp/testcover-resources/testcases.el index 1eb791a993..c9a5a6daac 100644 --- a/test/lisp/emacs-lisp/testcover-resources/testcases.el +++ b/test/lisp/emacs-lisp/testcover-resources/testcases.el @@ -490,4 +490,14 @@ edebug spec, so testcover needs to cope with that." (should (eq (testcover-testcase-how-do-i-know-you "Liz") 'unknown)) +;; ==== circular-lists-bug-24402 ==== +"Testcover captures and ignores circular list errors." +;; ==== +(defun testcover-testcase-cyc1 (a) + (let ((ls (make-list 10 a%%%))) + (nconc ls ls) + ls)) +(testcover-testcase-cyc1 1) +(testcover-testcase-cyc1 1) + ;; testcases.el ends here. commit 0508045ed7159bce5b5ea3b5fb72cf78b8b4ee8e Author: Noam Postavsky Date: Wed Jul 19 18:48:50 2017 -0400 Don't error on circular values in testcover * lisp/emacs-lisp/testcover.el (testcover-after, testcover-1value): Consider circular lists to be non-equal instead of signaling error. diff --git a/lisp/emacs-lisp/testcover.el b/lisp/emacs-lisp/testcover.el index 433ad38a14..17891fd609 100644 --- a/lisp/emacs-lisp/testcover.el +++ b/lisp/emacs-lisp/testcover.el @@ -463,7 +463,10 @@ binding `testcover-vector' to the code-coverage vector for TESTCOVER-SYM (cond ((eq (aref testcover-vector idx) 'unknown) (aset testcover-vector idx val)) - ((not (equal (aref testcover-vector idx) val)) + ((not (condition-case () + (equal (aref testcover-vector idx) val) + ;; TODO: Actually check circular lists for equality. + (circular-list nil))) (aset testcover-vector idx 'ok-coverage))) val) @@ -475,7 +478,10 @@ same value during coverage testing." ((eq (aref testcover-vector idx) '1value) (aset testcover-vector idx (cons '1value val))) ((not (and (eq (car-safe (aref testcover-vector idx)) '1value) - (equal (cdr (aref testcover-vector idx)) val))) + (condition-case () + (equal (cdr (aref testcover-vector idx)) val) + ;; TODO: Actually check circular lists for equality. + (circular-list nil)))) (error "Value of form marked with `1value' does vary: %s" val))) val) commit 95a04fd26c91e6c6c9191a629d26886f136e30fc Author: Noam Postavsky Date: Sun Jul 16 19:12:10 2017 -0400 ; Avoid test failures when running from compiled test files * test/lisp/dom-tests.el: Require `subr-x' during runtime as well. * test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-defstruct-record): * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-23-inheritance-check, eieio-test-25-slot-tests): Mark as expected to fail when byte-compiled. diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el index 32d231a47e..24d4b93245 100644 --- a/test/lisp/dom-tests.el +++ b/test/lisp/dom-tests.el @@ -26,7 +26,10 @@ (require 'dom) (require 'ert) -(eval-when-compile (require 'subr-x)) + +;; `defsubst's are not inlined inside `ert-deftest' (see Bug#24402), +;; therefore we can't use `eval-when-compile' here. +(require 'subr-x) (defun dom-tests--tree () "Return a DOM tree for testing." diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 65bd97f3b2..9e68dceb8f 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -518,7 +518,15 @@ (ert-deftest cl-lib-symbol-macrolet-2 () (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5)))) +(defun cl-lib-tests--dummy-function () + ;; Dummy function to see if the file is compiled. + t) + (ert-deftest cl-lib-defstruct-record () + ;; This test fails when compiled, see Bug#24402/27718. + :expected-result (if (byte-code-function-p + (symbol-function 'cl-lib-tests--dummy-function)) + :failed :passed) (cl-defstruct foo x) (let ((x (make-foo :x 42))) (should (recordp x)) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index 1a6ab9da08..d824bfc1bb 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -529,7 +529,15 @@ METHOD is the method that was attempting to be called." "This class should break.")) :type 'invalid-slot-type)) +(defun eieio-tests--dummy-function () + ;; Dummy function to see if the file is compiled. + t) + (ert-deftest eieio-test-23-inheritance-check () + ;; This test fails when compiled, see Bug#27718. + :expected-result (if (byte-code-function-p + (symbol-function 'eieio-tests--dummy-function)) + :failed :passed) (should (child-of-class-p 'class-ab 'class-a)) (should (child-of-class-p 'class-ab 'class-b)) (should (object-of-class-p eitest-a 'class-a)) @@ -548,6 +556,10 @@ METHOD is the method that was attempting to be called." (should (not (cl-typep "foo" 'class-a)))) (ert-deftest eieio-test-24-object-predicates () + ;; This test fails when compiled, see Bug#27718. + :expected-result (if (byte-code-function-p + (symbol-function 'eieio-tests--dummy-function)) + :failed :passed) (let ((listooa (list (class-ab) (class-a))) (listoob (list (class-ab) (class-b)))) (should (cl-typep listooa '(list-of class-a))) commit 054c198c120c1f01a8ff753892d52710b740acc6 Author: Alexander Gramiak Date: Thu Jul 13 14:54:35 2017 -0600 Catch argument and macroexpansion errors in ert This kludge catches errors caused by evaluating arguments in ert's should, should-not, and should-error macros; it also catches macroexpansion errors inside of the above macros (Bug#24402). * lisp/emacs-lisp/ert.el: (ert--should-signal-hook): New function. (ert--expand-should-1): Catch macroexpansion errors. * test/lisp/emacs-lisp/ert-tests.el (ert-test-should-error-argument) (ert-test-should-error-macroexpansion): Tests for argument and expansion errors. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index d7bd331c11..c232b08bd1 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -260,6 +260,14 @@ DATA is displayed to the user and should state the reason for skipping." (when ert--should-execution-observer (funcall ert--should-execution-observer form-description))) +;; See Bug#24402 for why this exists +(defun ert--should-signal-hook (error-symbol data) + "Stupid hack to stop `condition-case' from catching ert signals. +It should only be stopped when ran from inside ert--run-test-internal." + (when (and (not (symbolp debugger)) ; only run on anonymous debugger + (memq error-symbol '(ert-test-failed ert-test-skipped))) + (funcall debugger 'error data))) + (defun ert--special-operator-p (thing) "Return non-nil if THING is a symbol naming a special operator." (and (symbolp thing) @@ -267,16 +275,22 @@ DATA is displayed to the user and should state the reason for skipping." (and (subrp definition) (eql (cdr (subr-arity definition)) 'unevalled))))) +;; FIXME: Code inside of here should probably be evaluated like it is +;; outside of tests, with the sole exception of error handling (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - (macroexpand form (append (bound-and-true-p - byte-compile-macro-environment) - (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment)))))) + ;; catch macroexpansion errors + (condition-case err + (macroexpand-all form + (append (bound-and-true-p + byte-compile-macro-environment) + (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment)))) + (error `(signal ',(car err) ',(cdr err)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (cl-gensym "value-"))) @@ -297,8 +311,13 @@ DATA is displayed to the user and should state the reason for skipping." (args (cl-gensym "args-")) (value (cl-gensym "value-")) (default-value (cl-gensym "ert-form-evaluation-aborted-"))) - `(let ((,fn (function ,fn-name)) - (,args (list ,@arg-forms))) + `(let* ((,fn (function ,fn-name)) + (,args (condition-case err + (let ((signal-hook-function #'ert--should-signal-hook)) + (list ,@arg-forms)) + (error (progn (setq ,fn #'signal) + (list (car err) + (cdr err))))))) (let ((,value ',default-value)) ,(funcall inner-expander `(setq ,value (apply ,fn ,args)) @@ -760,6 +779,10 @@ This mainly sets up debugger-related bindings." ;; too expensive, we can remove it. (with-temp-buffer (save-window-excursion + ;; FIXME: Use `signal-hook-function' instead of `debugger' to + ;; handle ert errors. Once that's done, remove + ;; `ert--should-signal-hook'. See Bug#24402 and Bug#11218 for + ;; details. (let ((debugger (lambda (&rest args) (ert--run-test-debugger test-execution-info args))) diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 57463ad932..2fbc188dcb 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -294,6 +294,15 @@ failed or if there was a problem." "the error signaled was a subtype of the expected type"))))) )) +(ert-deftest ert-test-should-error-argument () + "Errors due to evaluating arguments should not break tests." + (should-error (identity (/ 1 0)))) + +(ert-deftest ert-test-should-error-macroexpansion () + "Errors due to expanding macros should not break tests." + (cl-macrolet ((test () (error "Foo"))) + (should-error (test)))) + (ert-deftest ert-test-skip-unless () ;; Don't skip. (let ((test (make-ert-test :body (lambda () (skip-unless t))))) commit e6fa08363dc950e48d72d41fd0f65444d2755ce3 Author: Reuben Thomas Date: Mon Aug 7 21:59:06 2017 +0100 Revert "Add Enchant support to ispell.el (Bug#17742)" This reverts commit 7136e6723d87b51ae3089f5ceef6b14621bfaf87. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 9ca4389558..773023a34a 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -208,10 +208,6 @@ Must be greater than 1." :type 'integer :group 'ispell) -;; XXX Add enchant to this list once enchant >= 1.6.1 is widespread. -;; Before that, adding it is useless, as if it is found, it will just -;; cause an error; and one of the other spelling engines below is -;; almost certainly installed in any case, for enchant to use. (defcustom ispell-program-name (or (executable-find "aspell") (executable-find "ispell") @@ -609,8 +605,6 @@ english.aff). Aspell and Hunspell don't have this limitation.") "Non-nil if we can use Aspell extensions.") (defvar ispell-really-hunspell nil "Non-nil if we can use Hunspell extensions.") -(defvar ispell-really-enchant nil - "Non-nil if we can use Enchant extensions.") (defvar ispell-encoding8-command nil "Command line option prefix to select encoding if supported, nil otherwise. If setting the encoding is supported by spellchecker and is selectable from @@ -745,26 +739,17 @@ Otherwise returns the library directory name, if that is defined." (and (search-forward-regexp "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t) - (match-string 1))) - (setq ispell-really-enchant - (and (search-forward-regexp - "(but really Enchant \\([0-9]+\\.[0-9\\.-]+\\)?)" - nil t) (match-string 1))))) (let* ((aspell8-minver "0.60") (ispell-minver "3.1.12") (hunspell8-minver "1.1.6") - (enchant-minver "1.6.1") (minver (cond ((not (version<= ispell-minver ispell-program-version)) ispell-minver) ((and ispell-really-aspell (not (version<= aspell8-minver ispell-really-aspell))) - aspell8-minver) - ((and ispell-really-enchant - (not (version<= enchant-minver ispell-really-enchant))) - enchant-minver)))) + aspell8-minver)))) (if minver (error "%s release %s or greater is required" @@ -1198,36 +1183,6 @@ dictionary from that list was found." (list dict)) ispell-hunspell-dictionary-alist :test #'equal)))) -;; Make ispell.el work better with enchant. - -(defvar ispell-enchant-dictionary-alist nil - "An alist of parsed Enchant dicts and associated parameters. -Internal use.") - -(defun ispell-find-enchant-dictionaries () - "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'." - (let* ((dictionaries - (split-string - (with-temp-buffer - (ispell-call-process - (concat ispell-program-name "-lsmod") nil t nil "-list-dicts") - (buffer-string)) - " ([^)]+)\n")) - (found - (mapcar #'(lambda (lang) - `(,lang "[[:alpha:]]" "[^[:alpha:]]" "['.’-]" t nil nil utf-8)) - dictionaries))) - ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist - ;; which have no element in FOUND at all. - (dolist (dict ispell-dictionary-base-alist) - (unless (assoc (car dict) found) - (setq found (nconc found (list dict))))) - (setq ispell-enchant-dictionary-alist found) - ;; Add a default entry - (let ((default-dict - '(nil "[[:alpha:]]" "[^[:alpha:]]" "['.’-]" t nil nil utf-8))) - (push default-dict ispell-enchant-dictionary-alist)))) - ;; Set params according to the selected spellchecker (defvar ispell-last-program-name nil @@ -1253,7 +1208,7 @@ aspell is used along with Emacs).") (setq ispell-library-directory (ispell-check-version)) t) (error nil)) - (or ispell-encoding8-command ispell-really-enchant)) + ispell-encoding8-command) ;; auto-detection will only be used if spellchecker is not ;; ispell and supports a way to set communication to UTF-8. (if ispell-really-aspell @@ -1261,14 +1216,11 @@ aspell is used along with Emacs).") (ispell-find-aspell-dictionaries)) (if ispell-really-hunspell (or ispell-hunspell-dictionary-alist - (ispell-find-hunspell-dictionaries)) - (if ispell-really-enchant - (or ispell-enchant-dictionary-alist - (ispell-find-enchant-dictionaries)))))) + (ispell-find-hunspell-dictionaries))))) ;; Substitute ispell-dictionary-alist with the list of ;; dictionaries corresponding to the given spellchecker. - ;; With programs that support it, use the list of really + ;; If a recent aspell or hunspell, use the list of really ;; installed dictionaries and add to it elements of the original ;; list that are not present there. Allow distro info. (let ((found-dicts-alist @@ -1277,19 +1229,17 @@ aspell is used along with Emacs).") ispell-aspell-dictionary-alist (if ispell-really-hunspell ispell-hunspell-dictionary-alist)) - (if ispell-really-enchant - ispell-enchant-dictionary-alist - nil))) + nil)) (ispell-dictionary-base-alist ispell-dictionary-base-alist) ispell-base-dicts-override-alist ; Override only base-dicts-alist all-dicts-alist) ;; While ispell and aspell (through aliases) use the traditional - ;; dict naming originally expected by ispell.el, hunspell & Enchant - ;; use locale-based names with no alias. We need to map + ;; dict naming originally expected by ispell.el, hunspell + ;; uses locale based names with no alias. We need to map ;; standard names to locale based names to make default dict - ;; definitions available to these programs. - (if (or ispell-really-hunspell ispell-really-enchant) + ;; definitions available for hunspell. + (if ispell-really-hunspell (let (tmp-dicts-alist) (dolist (adict ispell-dictionary-base-alist) (let* ((dict-name (nth 0 adict)) @@ -1314,7 +1264,7 @@ aspell is used along with Emacs).") (setq ispell-args (nconc ispell-args (list "-d" dict-equiv))) (message - "ispell-set-spellchecker-params: Missing equivalent for \"%s\". Skipping." + "ispell-set-spellchecker-params: Missing Hunspell equiv for \"%s\". Skipping." dict-name) (setq skip-dict t))) @@ -1356,7 +1306,7 @@ aspell is used along with Emacs).") (nth 4 adict) ; many-otherchars-p (nth 5 adict) ; ispell-args (nth 6 adict) ; extended-character-mode - (if (or ispell-encoding8-command ispell-really-enchant) + (if ispell-encoding8-command 'utf-8 (nth 7 adict))) adict) @@ -1792,10 +1742,9 @@ and pass it the output of the last Ispell invocation." (erase-buffer))))))) (defun ispell-send-replacement (misspelled replacement) - "Notify spell checker that MISSPELLED should be spelled REPLACEMENT. -This allows improving the suggestion list based on actual misspellings. -Only works for Aspell and Enchant." - (and (or ispell-really-aspell ispell-really-enchant) + "Notify Aspell that MISSPELLED should be spelled REPLACEMENT. +This allows improving the suggestion list based on actual misspellings." + (and ispell-really-aspell (ispell-send-string (concat "$$ra " misspelled "," replacement "\n")))) commit 89187e93d220ac5e2177c7c769ae6a0e9966d0f5 Author: Reuben Thomas Date: Mon Aug 7 21:58:55 2017 +0100 Revert "Add support for arguments in ALTERNATE_EDITOR to emacsclient" This reverts commit 28f1fe97daa13e13714e6c43c9a6fbb0c0e99a26. diff --git a/etc/NEWS b/etc/NEWS index f18837adfc..58b08348b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -505,10 +505,6 @@ Linum mode and all similar packages are henceforth becoming obsolete. Users and developers are encouraged to switch to this new feature instead. -+++ -** emacsclient now accepts command-line options in ALTERNATE_EDITOR -and --alternate-editor. For example, ALTERNATE_EDITOR="emacs -Q -nw". - * Editing Changes in Emacs 26.1 diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 32b8c034ae..f1d4e8976d 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -110,9 +110,6 @@ char *w32_getenv (const char *); /* Name used to invoke this program. */ const char *progname; -/* The first argument to main. */ -int main_argc; - /* The second argument to main. */ char **main_argv; @@ -204,35 +201,6 @@ xmalloc (size_t size) return result; } -/* Like realloc but get fatal error if memory is exhausted. */ - -static void * -xrealloc (void *ptr, size_t size) -{ - void *result = realloc (ptr, size); - if (result == NULL) - { - perror ("realloc"); - exit (EXIT_FAILURE); - } - return result; -} - -/* Like strdup but get a fatal error if memory is exhausted. */ -char *xstrdup (const char *); - -char * -xstrdup (const char *s) -{ - char *result = strdup (s); - if (result == NULL) - { - perror ("strdup"); - exit (EXIT_FAILURE); - } - return result; -} - /* From sysdep.c */ #if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME) @@ -296,6 +264,21 @@ get_current_dir_name (void) #ifdef WINDOWSNT +/* Like strdup but get a fatal error if memory is exhausted. */ +char *xstrdup (const char *); + +char * +xstrdup (const char *s) +{ + char *result = strdup (s); + if (result == NULL) + { + perror ("strdup"); + exit (EXIT_FAILURE); + } + return result; +} + #define REG_ROOT "SOFTWARE\\GNU\\Emacs" char *w32_get_resource (HKEY, const char *, LPDWORD); @@ -690,7 +673,7 @@ Report bugs with M-x report-emacs-bug.\n"); } /* Try to run a different command, or --if no alternate editor is - defined-- exit with an decoderde. + defined-- exit with an errorcode. Uses argv, but gets it from the global variable main_argv. */ static _Noreturn void @@ -698,27 +681,9 @@ fail (void) { if (alternate_editor) { - size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *); - size_t new_argv_size = extra_args_size; - char **new_argv = NULL; - /* Needed because strtok overwrites its input. */ - char *s = xstrdup (alternate_editor); - unsigned toks = 0; - char *tok = strtok(s, " "); - - /* Unpack alternate_editor's space-separated tokens into new_argv. */ - do - { - toks++; - new_argv = xrealloc (new_argv, new_argv_size + toks * sizeof (char *)); - new_argv[toks - 1] = tok; - } - while ((tok = strtok (NULL, " "))); - - /* Append main_argv arguments to new_argv. */ - memcpy (&new_argv[toks], main_argv + optind, extra_args_size); + int i = optind - 1; - execvp (s, new_argv); + execvp (alternate_editor, main_argv + i); message (true, "%s: error executing alternate editor \"%s\"\n", progname, alternate_editor); } @@ -731,7 +696,6 @@ fail (void) int main (int argc, char **argv) { - main_argc = argc; main_argv = argv; progname = argv[0]; message (true, "%s: Sorry, the Emacs server is supported only\n" @@ -1665,7 +1629,6 @@ main (int argc, char **argv) int start_daemon_if_needed; int exit_status = EXIT_SUCCESS; - main_argc = argc; main_argv = argv; progname = argv[0]; diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el deleted file mode 100644 index b06a6f57fe..0000000000 --- a/test/lib-src/emacsclient-tests.el +++ /dev/null @@ -1,33 +0,0 @@ -;;; process-tests.el --- Test emacsclient - -;; Copyright (C) 2016 Free Software Foundation, Inc. - -;; This program 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. - -;; This program 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 this program. If not, see . - -;;; Commentary: - -;; - -;;; Code: - -(require 'ert) - -(ert-deftest emacsclient-test-alternate-editor-allows-arguments () - (setenv "ALTERNATE_EDITOR" "emacs --batch") - (should - (= 0 - (call-process "emacsclient" nil nil nil "foo")))) - -(provide 'emacsclient-tests) -;; emacsclient-tests.el ends here. commit 28f1fe97daa13e13714e6c43c9a6fbb0c0e99a26 Author: Reuben Thomas Date: Thu Dec 1 15:21:57 2016 +0000 Add support for arguments in ALTERNATE_EDITOR to emacsclient * lib-src/emacsclient.c (fail): Parse ALTERNATE_EDITOR, or corresponding command-line argument, into space-separated tokens. * etc/NEWS: Document. * test/lib-src/emacsclient-tests.el: Add a test. diff --git a/etc/NEWS b/etc/NEWS index 58b08348b1..f18837adfc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -505,6 +505,10 @@ Linum mode and all similar packages are henceforth becoming obsolete. Users and developers are encouraged to switch to this new feature instead. ++++ +** emacsclient now accepts command-line options in ALTERNATE_EDITOR +and --alternate-editor. For example, ALTERNATE_EDITOR="emacs -Q -nw". + * Editing Changes in Emacs 26.1 diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index f1d4e8976d..32b8c034ae 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -110,6 +110,9 @@ char *w32_getenv (const char *); /* Name used to invoke this program. */ const char *progname; +/* The first argument to main. */ +int main_argc; + /* The second argument to main. */ char **main_argv; @@ -201,6 +204,35 @@ xmalloc (size_t size) return result; } +/* Like realloc but get fatal error if memory is exhausted. */ + +static void * +xrealloc (void *ptr, size_t size) +{ + void *result = realloc (ptr, size); + if (result == NULL) + { + perror ("realloc"); + exit (EXIT_FAILURE); + } + return result; +} + +/* Like strdup but get a fatal error if memory is exhausted. */ +char *xstrdup (const char *); + +char * +xstrdup (const char *s) +{ + char *result = strdup (s); + if (result == NULL) + { + perror ("strdup"); + exit (EXIT_FAILURE); + } + return result; +} + /* From sysdep.c */ #if !defined (HAVE_GET_CURRENT_DIR_NAME) || defined (BROKEN_GET_CURRENT_DIR_NAME) @@ -264,21 +296,6 @@ get_current_dir_name (void) #ifdef WINDOWSNT -/* Like strdup but get a fatal error if memory is exhausted. */ -char *xstrdup (const char *); - -char * -xstrdup (const char *s) -{ - char *result = strdup (s); - if (result == NULL) - { - perror ("strdup"); - exit (EXIT_FAILURE); - } - return result; -} - #define REG_ROOT "SOFTWARE\\GNU\\Emacs" char *w32_get_resource (HKEY, const char *, LPDWORD); @@ -673,7 +690,7 @@ Report bugs with M-x report-emacs-bug.\n"); } /* Try to run a different command, or --if no alternate editor is - defined-- exit with an errorcode. + defined-- exit with an decoderde. Uses argv, but gets it from the global variable main_argv. */ static _Noreturn void @@ -681,9 +698,27 @@ fail (void) { if (alternate_editor) { - int i = optind - 1; + size_t extra_args_size = (main_argc - optind + 1) * sizeof (char *); + size_t new_argv_size = extra_args_size; + char **new_argv = NULL; + /* Needed because strtok overwrites its input. */ + char *s = xstrdup (alternate_editor); + unsigned toks = 0; + char *tok = strtok(s, " "); + + /* Unpack alternate_editor's space-separated tokens into new_argv. */ + do + { + toks++; + new_argv = xrealloc (new_argv, new_argv_size + toks * sizeof (char *)); + new_argv[toks - 1] = tok; + } + while ((tok = strtok (NULL, " "))); + + /* Append main_argv arguments to new_argv. */ + memcpy (&new_argv[toks], main_argv + optind, extra_args_size); - execvp (alternate_editor, main_argv + i); + execvp (s, new_argv); message (true, "%s: error executing alternate editor \"%s\"\n", progname, alternate_editor); } @@ -696,6 +731,7 @@ fail (void) int main (int argc, char **argv) { + main_argc = argc; main_argv = argv; progname = argv[0]; message (true, "%s: Sorry, the Emacs server is supported only\n" @@ -1629,6 +1665,7 @@ main (int argc, char **argv) int start_daemon_if_needed; int exit_status = EXIT_SUCCESS; + main_argc = argc; main_argv = argv; progname = argv[0]; diff --git a/test/lib-src/emacsclient-tests.el b/test/lib-src/emacsclient-tests.el new file mode 100644 index 0000000000..b06a6f57fe --- /dev/null +++ b/test/lib-src/emacsclient-tests.el @@ -0,0 +1,33 @@ +;;; process-tests.el --- Test emacsclient + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) + +(ert-deftest emacsclient-test-alternate-editor-allows-arguments () + (setenv "ALTERNATE_EDITOR" "emacs --batch") + (should + (= 0 + (call-process "emacsclient" nil nil nil "foo")))) + +(provide 'emacsclient-tests) +;; emacsclient-tests.el ends here. commit 7136e6723d87b51ae3089f5ceef6b14621bfaf87 Author: Reuben Thomas Date: Sun Dec 4 22:39:27 2016 +0000 Add Enchant support to ispell.el (Bug#17742) * lisp/textmodes/ispell.el (ispell-program-name): Add “enchant”. (ispell-really-enchant): Add variable. (ispell-check-version): If using Enchant, check it’s new enough (at least 1.6.1). (Like the ispell check, this is absolute: cannot work without.) (ispell-enchant-dictionary-alist): Add variable. (ispell-find-enchant-dictionaries): Add function, based on ispell-find-aspell-dictionaries. (ispell-set-spellchecker-params): Allow dictionary auto-detection for Enchant, and call ispell-find-enchant-dictionaries to find them. Use old ispell name to locale mapping code for Enchant too. (ispell-send-replacement): Make it work with Enchant. diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 773023a34a..9ca4389558 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -208,6 +208,10 @@ Must be greater than 1." :type 'integer :group 'ispell) +;; XXX Add enchant to this list once enchant >= 1.6.1 is widespread. +;; Before that, adding it is useless, as if it is found, it will just +;; cause an error; and one of the other spelling engines below is +;; almost certainly installed in any case, for enchant to use. (defcustom ispell-program-name (or (executable-find "aspell") (executable-find "ispell") @@ -605,6 +609,8 @@ english.aff). Aspell and Hunspell don't have this limitation.") "Non-nil if we can use Aspell extensions.") (defvar ispell-really-hunspell nil "Non-nil if we can use Hunspell extensions.") +(defvar ispell-really-enchant nil + "Non-nil if we can use Enchant extensions.") (defvar ispell-encoding8-command nil "Command line option prefix to select encoding if supported, nil otherwise. If setting the encoding is supported by spellchecker and is selectable from @@ -739,17 +745,26 @@ Otherwise returns the library directory name, if that is defined." (and (search-forward-regexp "(but really Hunspell \\([0-9]+\\.[0-9\\.-]+\\)?)" nil t) + (match-string 1))) + (setq ispell-really-enchant + (and (search-forward-regexp + "(but really Enchant \\([0-9]+\\.[0-9\\.-]+\\)?)" + nil t) (match-string 1))))) (let* ((aspell8-minver "0.60") (ispell-minver "3.1.12") (hunspell8-minver "1.1.6") + (enchant-minver "1.6.1") (minver (cond ((not (version<= ispell-minver ispell-program-version)) ispell-minver) ((and ispell-really-aspell (not (version<= aspell8-minver ispell-really-aspell))) - aspell8-minver)))) + aspell8-minver) + ((and ispell-really-enchant + (not (version<= enchant-minver ispell-really-enchant))) + enchant-minver)))) (if minver (error "%s release %s or greater is required" @@ -1183,6 +1198,36 @@ dictionary from that list was found." (list dict)) ispell-hunspell-dictionary-alist :test #'equal)))) +;; Make ispell.el work better with enchant. + +(defvar ispell-enchant-dictionary-alist nil + "An alist of parsed Enchant dicts and associated parameters. +Internal use.") + +(defun ispell-find-enchant-dictionaries () + "Find Enchant's dictionaries, and record in `ispell-enchant-dictionary-alist'." + (let* ((dictionaries + (split-string + (with-temp-buffer + (ispell-call-process + (concat ispell-program-name "-lsmod") nil t nil "-list-dicts") + (buffer-string)) + " ([^)]+)\n")) + (found + (mapcar #'(lambda (lang) + `(,lang "[[:alpha:]]" "[^[:alpha:]]" "['.’-]" t nil nil utf-8)) + dictionaries))) + ;; Merge into FOUND any elements from the standard ispell-dictionary-base-alist + ;; which have no element in FOUND at all. + (dolist (dict ispell-dictionary-base-alist) + (unless (assoc (car dict) found) + (setq found (nconc found (list dict))))) + (setq ispell-enchant-dictionary-alist found) + ;; Add a default entry + (let ((default-dict + '(nil "[[:alpha:]]" "[^[:alpha:]]" "['.’-]" t nil nil utf-8))) + (push default-dict ispell-enchant-dictionary-alist)))) + ;; Set params according to the selected spellchecker (defvar ispell-last-program-name nil @@ -1208,7 +1253,7 @@ aspell is used along with Emacs).") (setq ispell-library-directory (ispell-check-version)) t) (error nil)) - ispell-encoding8-command) + (or ispell-encoding8-command ispell-really-enchant)) ;; auto-detection will only be used if spellchecker is not ;; ispell and supports a way to set communication to UTF-8. (if ispell-really-aspell @@ -1216,11 +1261,14 @@ aspell is used along with Emacs).") (ispell-find-aspell-dictionaries)) (if ispell-really-hunspell (or ispell-hunspell-dictionary-alist - (ispell-find-hunspell-dictionaries))))) + (ispell-find-hunspell-dictionaries)) + (if ispell-really-enchant + (or ispell-enchant-dictionary-alist + (ispell-find-enchant-dictionaries)))))) ;; Substitute ispell-dictionary-alist with the list of ;; dictionaries corresponding to the given spellchecker. - ;; If a recent aspell or hunspell, use the list of really + ;; With programs that support it, use the list of really ;; installed dictionaries and add to it elements of the original ;; list that are not present there. Allow distro info. (let ((found-dicts-alist @@ -1229,17 +1277,19 @@ aspell is used along with Emacs).") ispell-aspell-dictionary-alist (if ispell-really-hunspell ispell-hunspell-dictionary-alist)) - nil)) + (if ispell-really-enchant + ispell-enchant-dictionary-alist + nil))) (ispell-dictionary-base-alist ispell-dictionary-base-alist) ispell-base-dicts-override-alist ; Override only base-dicts-alist all-dicts-alist) ;; While ispell and aspell (through aliases) use the traditional - ;; dict naming originally expected by ispell.el, hunspell - ;; uses locale based names with no alias. We need to map + ;; dict naming originally expected by ispell.el, hunspell & Enchant + ;; use locale-based names with no alias. We need to map ;; standard names to locale based names to make default dict - ;; definitions available for hunspell. - (if ispell-really-hunspell + ;; definitions available to these programs. + (if (or ispell-really-hunspell ispell-really-enchant) (let (tmp-dicts-alist) (dolist (adict ispell-dictionary-base-alist) (let* ((dict-name (nth 0 adict)) @@ -1264,7 +1314,7 @@ aspell is used along with Emacs).") (setq ispell-args (nconc ispell-args (list "-d" dict-equiv))) (message - "ispell-set-spellchecker-params: Missing Hunspell equiv for \"%s\". Skipping." + "ispell-set-spellchecker-params: Missing equivalent for \"%s\". Skipping." dict-name) (setq skip-dict t))) @@ -1306,7 +1356,7 @@ aspell is used along with Emacs).") (nth 4 adict) ; many-otherchars-p (nth 5 adict) ; ispell-args (nth 6 adict) ; extended-character-mode - (if ispell-encoding8-command + (if (or ispell-encoding8-command ispell-really-enchant) 'utf-8 (nth 7 adict))) adict) @@ -1742,9 +1792,10 @@ and pass it the output of the last Ispell invocation." (erase-buffer))))))) (defun ispell-send-replacement (misspelled replacement) - "Notify Aspell that MISSPELLED should be spelled REPLACEMENT. -This allows improving the suggestion list based on actual misspellings." - (and ispell-really-aspell + "Notify spell checker that MISSPELLED should be spelled REPLACEMENT. +This allows improving the suggestion list based on actual misspellings. +Only works for Aspell and Enchant." + (and (or ispell-really-aspell ispell-really-enchant) (ispell-send-string (concat "$$ra " misspelled "," replacement "\n")))) commit 85512e752191091d38cd5e34e7bed80eac1e9013 Author: Reuben Thomas Date: Wed Jun 28 22:40:33 2017 +0100 Allow async command output buffer to be shown only on output * lisp/simple.el (async-shell-command-display-buffer): Add defcustom. (shell-command): Use the new defcustom to determine whether to show the buffer immediately, or add a process filter that shows it only when there is some output. * etc/NEWS: Document the new variable. * doc/emacs/misc.texi: Likewise. Thanks to Juri Linkov and Eli Zaretskii for advice and guidance. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 84681f2269..73a6bae767 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -742,6 +742,11 @@ this; e.g., whether to rename the pre-existing output buffer, or to use a different buffer for the new command. Consult the variable's documentation for more possibilities. +@vindex async-shell-command-display-buffer + If you want the output buffer for asynchronous shell commands to be +displayed only when the command generates output, set +@code{async-shell-command-display-buffer} to @code{nil}. + @kindex M-| @findex shell-command-on-region @kbd{M-|} (@code{shell-command-on-region}) is like @kbd{M-!}, but diff --git a/etc/NEWS b/etc/NEWS index b47bf959be..58b08348b1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -205,6 +205,11 @@ When 'shell-command-dont-erase-buffer' is nil, the default value, the behavior of 'shell-command', 'shell-command-on-region' and 'async-shell-command' is as usual. ++++ +** The new user option 'async-shell-command-display-buffer' controls +whether the output buffer of an asynchronous command is shown +immediately, or only when there is output. + +++ ** The new user option 'mouse-select-region-move-to-beginning' controls the position of point when double-clicking mouse-1 on the end diff --git a/lisp/simple.el b/lisp/simple.el index 027ce3959a..9838f1644f 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -3279,6 +3279,17 @@ output buffer and running a new command in the default buffer, :group 'shell :version "24.3") +(defcustom async-shell-command-display-buffer t + "Whether to display the command buffer immediately. +If t, display the buffer immediately; if nil, wait until there +is output." + :type '(choice (const :tag "Display buffer immediately" + t) + (const :tag "Display buffer on output" + nil)) + :group 'shell + :version "26.1") + (defun shell-command--save-pos-or-erase () "Store a buffer position or erase the buffer. See `shell-command-dont-erase-buffer'." @@ -3525,7 +3536,6 @@ the use of a shell (with its need to quote arguments)." (setq buffer (get-buffer-create (or output-buffer "*Async Shell Command*")))))) (with-current-buffer buffer - (display-buffer buffer '(nil (allow-no-window . t))) (shell-command--save-pos-or-erase) (setq default-directory directory) (setq proc (start-process "Shell" buffer shell-file-name @@ -3536,7 +3546,16 @@ the use of a shell (with its need to quote arguments)." ;; Use the comint filter for proper handling of carriage motion ;; (see `comint-inhibit-carriage-motion'),. (set-process-filter proc 'comint-output-filter) - )) + (if async-shell-command-display-buffer + (display-buffer buffer '(nil (allow-no-window . t))) + (add-function :before (process-filter proc) + `(lambda (process string) + (when (and (= 0 (buffer-size (process-buffer process))) + (string= (buffer-name (process-buffer process)) + ,(or output-buffer "*Async Shell Command*"))) + (display-buffer (process-buffer process)))) + )) + )) ;; Otherwise, command is executed synchronously. (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) commit 14ea76af5f3596d48747c2437006f6e1abcb67a7 Author: Eli Zaretskii Date: Mon Aug 7 20:47:53 2017 +0300 Fix infinite recursion under prettify-symbols-mode and linum-mode * src/xdisp.c (get_overlay_strings_1) (handle_single_display_spec, push_prefix_prop): Invalidate the composition information before starting to iterate on a string. Otherwise we might think in set_iterator_to_next that we are delivering characters from a composition, and do all kinds of nonsensical things, like over-step the string end. (Bug#27761) diff --git a/src/xdisp.c b/src/xdisp.c index 422912e57a..ad9b29835e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5248,6 +5248,7 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, it->prev_stop = 0; it->base_level_stop = 0; it->string_from_display_prop_p = true; + it->cmp_it.id = -1; /* Say that we haven't consumed the characters with `display' property yet. The call to pop_it in set_iterator_to_next will clean this up. */ @@ -5966,6 +5967,7 @@ get_overlay_strings_1 (struct it *it, ptrdiff_t charpos, bool compute_stop_p) it->multibyte_p = STRING_MULTIBYTE (it->string); it->method = GET_FROM_STRING; it->from_disp_prop_p = 0; + it->cmp_it.id = -1; /* Force paragraph direction to be that of the parent buffer. */ @@ -20506,6 +20508,7 @@ push_prefix_prop (struct it *it, Lisp_Object prop) it->stop_charpos = 0; it->prev_stop = 0; it->base_level_stop = 0; + it->cmp_it.id = -1; /* Force paragraph direction to be that of the parent buffer/string. */ commit 2d76cf947972ed95519cbb7c2141ed2f414d7179 Author: Stefan Monnier Date: Mon Aug 7 12:16:02 2017 -0400 * lisp/gnus/gnus-bcklg.el (gnus-backlog-request-article): Fix thinko. diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index d85448e109..ff8fcca61f 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -144,8 +144,8 @@ (setq end (next-single-property-change (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (with-current-buffer (or (current-buffer) buffer) - (let ((buffer-read-only nil)) + (with-current-buffer (or buffer (current-buffer)) + (let ((inhibit-read-only t)) (erase-buffer) (insert-buffer-substring gnus-backlog-buffer beg end))) t)))) commit b6b362c91016473eec97feb3dbb6e0448d48b88e Author: Martin Rudalics Date: Mon Aug 7 09:51:01 2017 +0200 Fix doc-string of `delete-other-windows' * lisp/window.el (delete-other-windows): Fix doc-string. diff --git a/lisp/window.el b/lisp/window.el index 2b979f4663..f1c82c759d 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -4096,17 +4096,17 @@ WINDOW must be a valid window and defaults to the selected one. Return nil. If the variable `ignore-window-parameters' is non-nil or the -`delete-other-windows' parameter of WINDOW equals t, do not -process any parameters of WINDOW. Otherwise, if the +`delete-other-windows' parameter of WINDOW equals t, do not pay +attention to any other parameters of WINDOW. Otherwise, if the `delete-other-windows' parameter of WINDOW specifies a function, call that function with WINDOW as its sole argument and return the value returned by that function. -Otherwise, if WINDOW is part of an atomic window, call this -function with the root of the atomic window as its argument. If -WINDOW is a non-side window, make WINDOW the only non-side window -on the frame. Side windows are not deleted. If WINDOW is a side -window signal an error." +Else, if WINDOW is part of an atomic window, call this function +with the root of the atomic window as its argument. Signal an +error if that root window is the root window of WINDOW's frame. +Also signal an error if WINDOW is a side window. Do not delete +any window whose `no-delete-other-window' parameter is non-nil." (interactive) (setq window (window-normalize-window window)) (let* ((frame (window-frame window)) @@ -4152,8 +4152,8 @@ window signal an error." t) (setq main (window-main-window frame))) (t - ;; Delete other windows via `delete-window' because either a - ;; side window is or a non-side-window is not deletable. + ;; Delete windows via `delete-window' because we found either a + ;; deletable side window or a non-deletable non-side-window. (dolist (other (window-list frame)) (when (and (window-live-p other) (not (eq other window)) commit 446e92548f932f18d57924573b49b5e6f4ae70c4 Author: Paul Eggert Date: Sun Aug 6 23:53:40 2017 -0700 Fix a couple more make-temp-file races * lisp/files.el (basic-save-buffer-2, move-file-to-trash): Use make-temp-name, not make-temp-file with retry. (basic-save-buffer-2): Use condition-case, instead of unwind-protect with a success flag. diff --git a/lisp/files.el b/lisp/files.el index c9114be55a..f2758ab18c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -5090,48 +5090,33 @@ Before and after saving the buffer, this function runs ;; This requires write access to the containing dir, ;; which is why we don't try it if we don't have that access. (let ((realname buffer-file-name) - tempname succeed - (umask (default-file-modes)) + tempname (old-modtime (visited-file-modtime))) ;; Create temp files with strict access rights. It's easy to ;; loosen them later, whereas it's impossible to close the ;; time-window of loose permissions otherwise. - (unwind-protect + (condition-case err (progn (clear-visited-file-modtime) - (set-default-file-modes ?\700) - ;; Try various temporary names. - ;; This code follows the example of make-temp-file, - ;; but it calls write-region in the appropriate way + ;; Call write-region in the appropriate way ;; for saving the buffer. - (while (condition-case () - (progn - (setq tempname - (make-temp-name - (expand-file-name "tmp" dir))) - ;; Pass in nil&nil rather than point-min&max - ;; cause we're saving the whole buffer. - ;; write-region-annotate-functions may use it. - (write-region nil nil - tempname nil realname - buffer-file-truename 'excl) - (when save-silently (message nil)) - nil) - (file-already-exists t)) - ;; The file was somehow created by someone else between - ;; `make-temp-name' and `write-region', let's try again. - nil) - (setq succeed t)) - ;; Reset the umask. - (set-default-file-modes umask) + (setq tempname + (make-temp-file + (expand-file-name "tmp" dir))) + ;; Pass in nil&nil rather than point-min&max + ;; cause we're saving the whole buffer. + ;; write-region-annotate-functions may use it. + (write-region nil nil tempname nil realname + buffer-file-truename) + (when save-silently (message nil))) ;; If we failed, restore the buffer's modtime. - (unless succeed - (set-visited-file-modtime old-modtime))) + (error (set-visited-file-modtime old-modtime) + (signal (car err) (cdr err)))) ;; Since we have created an entirely new file, ;; make sure it gets the right permission bits set. (setq setmodes (or setmodes (list (or (file-modes buffer-file-name) - (logand ?\666 umask)) + (logand ?\666 (default-file-modes))) (file-extended-attributes buffer-file-name) buffer-file-name))) ;; We succeeded in writing the temp file, @@ -7330,37 +7315,25 @@ Otherwise, trash FILENAME using the freedesktop.org conventions, (format-time-string "%Y-%m-%dT%T") "\n") - ;; Attempt to make .trashinfo file, trying up to 5 - ;; times. The .trashinfo file is opened with O_EXCL, - ;; as per trash-spec 0.7, even if that can be a problem - ;; on old NFS versions... - (let* ((tries 5) - (base-fn (expand-file-name - (file-name-nondirectory fn) - trash-files-dir)) - (new-fn base-fn) - success info-fn) - (while (> tries 0) - (setq info-fn (expand-file-name - (concat (file-name-nondirectory new-fn) - ".trashinfo") - trash-info-dir)) - (unless (condition-case nil - (progn - (write-region nil nil info-fn nil - 'quiet info-fn 'excl) - (setq tries 0 success t)) - (file-already-exists nil)) - (setq tries (1- tries)) - ;; Uniquify new-fn. (Some file managers do not - ;; like Emacs-style backup file names---e.g. bug - ;; 170956 in Konqueror bug tracker.) - (setq new-fn (make-temp-name (concat base-fn "_"))))) - (unless success - (error "Cannot move %s to trash: Lock failed" filename)) - + ;; Make a .trashinfo file. Use O_EXCL, as per trash-spec 1.0. + (let* ((files-base (file-name-nondirectory fn)) + (info-fn (expand-file-name + (concat files-base ".trashinfo") + trash-info-dir))) + (condition-case nil + (write-region nil nil info-fn nil 'quiet info-fn 'excl) + (file-already-exists + ;; Uniquify new-fn. Some file managers do not + ;; like Emacs-style backup file names. E.g.: + ;; https://bugs.kde.org/170956 + (setq info-fn (make-temp-file + (expand-file-name files-base trash-info-dir) + nil ".trashinfo")) + (setq files-base (file-name-nondirectory info-fn)) + (write-region nil nil info-fn nil 'quiet info-fn))) ;; Finally, try to move the file to the trashcan. - (let ((delete-by-moving-to-trash nil)) + (let ((delete-by-moving-to-trash nil) + (new-fn (expand-file-name files-base trash-files-dir))) (rename-file fn new-fn))))))))) (defsubst file-attribute-type (attributes) commit 6e2c0929bac8d3896d0472222cd3e6b77cb24c35 Merge: df1a71272e c2f1830d69 Author: Michael R. Mauger Date: Sun Aug 6 20:58:08 2017 -0400 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit c2f1830d69f5a5e20dac6fcbf3af4d51afba92bd Author: Noam Postavsky Date: Sun Jul 30 14:47:05 2017 -0400 Merge null and without-null regexp alists (Bug#27840, Bug#27873) * lisp/progmodes/grep.el (grep-mode-font-lock-keywords): Allow for NUL characters following filename in grep context lines. (grep--regexp-alist-column, grep--regexp-alist-bin-matcher) (grep-with-null-regexp-alist, grep-fallback-regexp-alist): Remove. (grep-regexp-alist): Recombine their contents here. (grep-mode): * lisp/cedet/semantic/symref/grep.el (semantic-symref-parse-tool-output-one-line): * lisp/progmodes/xref.el (xref-collect-matches): Use the variable `grep-regexp-alist' rather than the function. diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index df71508da7..f7c72bfb0b 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -193,7 +193,7 @@ This shell should support pipe redirect syntax." "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." (pcase-let - ((`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))) + ((`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))) (cond ((eq (oref tool :resulttype) 'file) ;; Search for files (when (re-search-forward "^\\([^\n]+\\)$" nil t) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 2ddaf884bc..466b524c79 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -31,7 +31,6 @@ (require 'compile) - (defgroup grep nil "Run `grep' and display the results." :group 'tools @@ -366,53 +365,44 @@ A grep buffer becomes most recent when you select Grep mode in it. Notice that using \\[next-error] or \\[compile-goto-error] modifies `compilation-last-buffer' rather than `grep-last-buffer'.") -(defconst grep--regexp-alist-column - ;; Calculate column positions (col . end-col) of first grep match on a line - (cons - (lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) - (when mbeg - (- mbeg beg))))) - (lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) - (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) - (when mend - (- mend beg))))))) -(defconst grep--regexp-alist-bin-matcher - '("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) -(defconst grep-with-null-regexp-alist - `(("^\\([^\0]+\\)\\(\0\\)\\([0-9]+\\):" 1 3 ,grep--regexp-alist-column nil nil - (2 '(face unspecified display ":"))) - ,grep--regexp-alist-bin-matcher) - "Regexp used to match grep hits. -See `compilation-error-regexp-alist'.") -(defconst grep-fallback-regexp-alist - `(;; Use a tight regexp to handle weird file names (with colons - ;; in them) as well as possible. E.g., use [1-9][0-9]* rather - ;; than [0-9]+ so as to accept ":034:" in file names. - ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:" - 1 2 ,grep--regexp-alist-column) - ,grep--regexp-alist-bin-matcher) - "Regexp used to match grep hits when `--null' is not supported. -See `compilation-error-regexp-alist'.") - -(defvaralias 'grep-regex-alist 'grep-with-null-regexp-alist) -(make-obsolete-variable - 'grep-regex-alist "Call `grep-regexp-alist' instead." "26.1") - ;;;###autoload -(defun grep-regexp-alist () - "Return a regexp alist to match grep hits. -The regexp used depends on `grep-use-null-filename-separator'. -See `compilation-error-regexp-alist' for format details." - (if grep-use-null-filename-separator - grep-with-null-regexp-alist grep-fallback-regexp-alist)) +(defconst grep-regexp-alist + `((,(concat "^\\(?:" + ;; Parse using NUL characters when `--null' is used. + ;; Note that we must still assume no newlines in + ;; filenames due to "foo: Is a directory." type + ;; messages. + "\\(?1:[^\0\n]+\\)\\(?3:\0\\)\\(?2:[0-9]+\\):" + "\\|" + ;; Fallback if `--null' is not used, use a tight regexp + ;; to handle weird file names (with colons in them) as + ;; well as possible. E.g., use [1-9][0-9]* rather than + ;; [0-9]+ so as to accept ":034:" in file names. + "\\(?1:[^\n:]+?[^\n/:]\\):[\t ]*\\(?2:[1-9][0-9]*\\)[\t ]*:" + "\\)") + 1 2 + ;; Calculate column positions (col . end-col) of first grep match on a line + (,(lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) + (when mbeg + (- mbeg beg))))) + . + ,(lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) + (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) + (when mend + (- mend beg)))))) + nil nil + (3 '(face nil display ":"))) + ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) + "Regexp used to match grep hits. +See `compilation-error-regexp-alist' for format details.") (defvar grep-first-column 0 ; bug#10594 "Value to use for `compilation-first-column' in grep buffers.") @@ -451,7 +441,9 @@ See `compilation-error-regexp-alist' for format details." (2 grep-error-face nil t)) ;; "filename-linenumber-" format is used for context lines in GNU grep, ;; "filename=linenumber=" for lines with function names in "git grep -p". - ("^.+?[-=][0-9]+[-=].*\n" (0 grep-context-face))) + ("^.+?\\([-=\0]\\)[0-9]+\\([-=]\\).*\n" (0 grep-context-face) + (1 (if (eq (char-after (match-beginning 1)) ?\0) + `(face nil display ,(match-string 2)))))) "Additional things to highlight in grep output. This gets tacked on the end of the generated expressions.") @@ -781,7 +773,7 @@ This function is called from `compilation-filter-hook'." (set (make-local-variable 'compilation-error-face) grep-hit-face) (set (make-local-variable 'compilation-error-regexp-alist) - (grep-regexp-alist)) + grep-regexp-alist) ;; compilation-directory-matcher can't be nil, so we set it to a regexp that ;; can never match. (set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`")) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index cc9b794c5a..35a5c8862f 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -929,7 +929,7 @@ IGNORES is a list of glob patterns." (expand-file-name dir) ignores)) (buf (get-buffer-create " *xref-grep*")) - (`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist))) + (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) (status nil) (hits nil)) (with-current-buffer buf commit 93511e94735de5862880f5ea9bf12705c1440363 Author: Paul Eggert Date: Sun Aug 6 16:57:08 2017 -0700 Fix some crashes on self-modifying Elisp code Prompted by a problem report by Alex in: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00143.html * src/eval.c (For, Fprogn, Fsetq, FletX, eval_sub): Compute XCDR (x) near XCAR (x); although this doesn't fix any bugs, it is likely to run a bit faster with typical hardware caches. (Fif): Use Fcdr instead of XCDR, to avoid crashing on self-modifying S-expressions. (Fsetq, Flet, eval_sub): Count the number of arguments as we go instead of trusting an Flength prepass, to avoid problems when the code is self-modifying. (Fquote, Ffunction, Fdefvar, Fdefconst): Prefer !NILP to CONSP where either will do. This is mostly to document the fact that the value must be a proper list. It's also a tiny bit faster on typical machines nowadays. (Fdefconst, FletX): Prefer XCAR+XCDR to Fcar+Fcdr when either will do. (eval_sub): Check that the args are a list as opposed to some other object that has a length. This prevents e.g. (if . "string") from making Emacs dump core in some cases. * test/src/eval-tests.el (eval-tests--if-dot-string) (eval-tests--let-with-circular-defs, eval-tests--mutating-cond): New tests. diff --git a/src/eval.c b/src/eval.c index e5900382de..fe2708b1bb 100644 --- a/src/eval.c +++ b/src/eval.c @@ -354,10 +354,11 @@ usage: (or CONDITIONS...) */) while (CONSP (args)) { - val = eval_sub (XCAR (args)); + Lisp_Object arg = XCAR (args); + args = XCDR (args); + val = eval_sub (arg); if (!NILP (val)) break; - args = XCDR (args); } return val; @@ -374,10 +375,11 @@ usage: (and CONDITIONS...) */) while (CONSP (args)) { - val = eval_sub (XCAR (args)); + Lisp_Object arg = XCAR (args); + args = XCDR (args); + val = eval_sub (arg); if (NILP (val)) break; - args = XCDR (args); } return val; @@ -397,7 +399,7 @@ usage: (if COND THEN ELSE...) */) if (!NILP (cond)) return eval_sub (Fcar (XCDR (args))); - return Fprogn (XCDR (XCDR (args))); + return Fprogn (Fcdr (XCDR (args))); } DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0, @@ -439,8 +441,9 @@ usage: (progn BODY...) */) while (CONSP (body)) { - val = eval_sub (XCAR (body)); + Lisp_Object form = XCAR (body); body = XCDR (body); + val = eval_sub (form); } return val; @@ -488,35 +491,26 @@ The return value of the `setq' form is the value of the last VAL. usage: (setq [SYM VAL]...) */) (Lisp_Object args) { - Lisp_Object val, sym, lex_binding; + Lisp_Object val = args, tail = args; - val = args; - if (CONSP (args)) + for (EMACS_INT nargs = 0; CONSP (tail); nargs += 2) { - Lisp_Object args_left = args; - Lisp_Object numargs = Flength (args); - - if (XINT (numargs) & 1) - xsignal2 (Qwrong_number_of_arguments, Qsetq, numargs); - - do - { - val = eval_sub (Fcar (XCDR (args_left))); - sym = XCAR (args_left); - - /* Like for eval_sub, we do not check declared_special here since - it's been done when let-binding. */ - if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ - && SYMBOLP (sym) - && !NILP (lex_binding - = Fassq (sym, Vinternal_interpreter_environment))) - XSETCDR (lex_binding, val); /* SYM is lexically bound. */ - else - Fset (sym, val); /* SYM is dynamically bound. */ - - args_left = Fcdr (XCDR (args_left)); - } - while (CONSP (args_left)); + Lisp_Object sym = XCAR (tail), lex_binding; + tail = XCDR (tail); + if (!CONSP (tail)) + xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1)); + Lisp_Object arg = XCAR (tail); + tail = XCDR (tail); + val = eval_sub (arg); + /* Like for eval_sub, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + && SYMBOLP (sym) + && !NILP (lex_binding + = Fassq (sym, Vinternal_interpreter_environment))) + XSETCDR (lex_binding, val); /* SYM is lexically bound. */ + else + Fset (sym, val); /* SYM is dynamically bound. */ } return val; @@ -535,7 +529,7 @@ of unexpected results when a quoted object is modified. usage: (quote ARG) */) (Lisp_Object args) { - if (CONSP (XCDR (args))) + if (!NILP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qquote, Flength (args)); return XCAR (args); } @@ -549,7 +543,7 @@ usage: (function ARG) */) { Lisp_Object quoted = XCAR (args); - if (CONSP (XCDR (args))) + if (!NILP (XCDR (args))) xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args)); if (!NILP (Vinternal_interpreter_environment) @@ -734,9 +728,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) sym = XCAR (args); tail = XCDR (args); - if (CONSP (tail)) + if (!NILP (tail)) { - if (CONSP (XCDR (tail)) && CONSP (XCDR (XCDR (tail)))) + if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail)))) error ("Too many arguments"); tem = Fdefault_boundp (sym); @@ -803,20 +797,24 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) Lisp_Object sym, tem; sym = XCAR (args); - if (CONSP (Fcdr (XCDR (XCDR (args))))) - error ("Too many arguments"); + Lisp_Object docstring = Qnil; + if (!NILP (XCDR (XCDR (args)))) + { + if (!NILP (XCDR (XCDR (XCDR (args))))) + error ("Too many arguments"); + docstring = XCAR (XCDR (XCDR (args))); + } - tem = eval_sub (Fcar (XCDR (args))); + tem = eval_sub (XCAR (XCDR (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); XSYMBOL (sym)->declared_special = 1; - tem = Fcar (XCDR (XCDR (args))); - if (!NILP (tem)) + if (!NILP (docstring)) { if (!NILP (Vpurify_flag)) - tem = Fpurecopy (tem); - Fput (sym, Qvariable_documentation, tem); + docstring = Fpurecopy (docstring); + Fput (sym, Qvariable_documentation, docstring); } Fput (sym, Qrisky_local_variable, Qt); LOADHIST_ATTACH (sym); @@ -844,27 +842,29 @@ Each VALUEFORM can refer to the symbols already bound by this VARLIST. usage: (let* VARLIST BODY...) */) (Lisp_Object args) { - Lisp_Object varlist, var, val, elt, lexenv; + Lisp_Object var, val, elt, lexenv; ptrdiff_t count = SPECPDL_INDEX (); lexenv = Vinternal_interpreter_environment; - for (varlist = XCAR (args); CONSP (varlist); varlist = XCDR (varlist)) + Lisp_Object varlist = XCAR (args); + while (CONSP (varlist)) { maybe_quit (); elt = XCAR (varlist); + varlist = XCDR (varlist); if (SYMBOLP (elt)) { var = elt; val = Qnil; } - else if (! NILP (Fcdr (Fcdr (elt)))) - signal_error ("`let' bindings can have only one value-form", elt); else { var = Fcar (elt); - val = eval_sub (Fcar (Fcdr (elt))); + if (! NILP (Fcdr (XCDR (elt)))) + signal_error ("`let' bindings can have only one value-form", elt); + val = eval_sub (Fcar (XCDR (elt))); } if (!NILP (lexenv) && SYMBOLP (var) @@ -911,33 +911,37 @@ usage: (let VARLIST BODY...) */) CHECK_LIST (varlist); /* Make space to hold the values to give the bound variables. */ - elt = Flength (varlist); - SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); + EMACS_INT varlist_len = XFASTINT (Flength (varlist)); + SAFE_ALLOCA_LISP (temps, varlist_len); + ptrdiff_t nvars = varlist_len; /* Compute the values and store them in `temps'. */ - for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) + for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++) { maybe_quit (); elt = XCAR (varlist); + varlist = XCDR (varlist); if (SYMBOLP (elt)) - temps [argnum++] = Qnil; + temps[argnum] = Qnil; else if (! NILP (Fcdr (Fcdr (elt)))) signal_error ("`let' bindings can have only one value-form", elt); else - temps [argnum++] = eval_sub (Fcar (Fcdr (elt))); + temps[argnum] = eval_sub (Fcar (Fcdr (elt))); } + nvars = argnum; lexenv = Vinternal_interpreter_environment; varlist = XCAR (args); - for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist)) + for (argnum = 0; argnum < nvars && CONSP (varlist); argnum++) { Lisp_Object var; elt = XCAR (varlist); + varlist = XCDR (varlist); var = SYMBOLP (elt) ? elt : Fcar (elt); - tem = temps[argnum++]; + tem = temps[argnum]; if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special @@ -2135,6 +2139,7 @@ eval_sub (Lisp_Object form) original_fun = XCAR (form); original_args = XCDR (form); + CHECK_LIST (original_args); /* This also protects them from gc. */ count = record_in_backtrace (original_fun, &original_args, UNEVALLED); @@ -2176,15 +2181,16 @@ eval_sub (Lisp_Object form) SAFE_ALLOCA_LISP (vals, XINT (numargs)); - while (!NILP (args_left)) + while (CONSP (args_left) && argnum < XINT (numargs)) { - vals[argnum++] = eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + Lisp_Object arg = XCAR (args_left); + args_left = XCDR (args_left); + vals[argnum++] = eval_sub (arg); } - set_backtrace_args (specpdl + count, vals, XINT (numargs)); + set_backtrace_args (specpdl + count, vals, argnum); - val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); + val = XSUBR (fun)->function.aMANY (argnum, vals); check_cons_list (); lisp_eval_depth--; diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index 03f408716b..b98de0aa65 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -59,4 +59,24 @@ Bug#24912 and Bug#24913." (should-error (,form ,arg) :type 'wrong-type-argument)) t))) +(ert-deftest eval-tests--if-dot-string () + "Check that Emacs rejects (if . \"string\")." + (should-error (eval '(if . "abc")) :type 'wrong-type-argument) + (let ((if-tail (list '(setcdr if-tail "abc") t))) + (should-error (eval (cons 'if if-tail)))) + (let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t))) + (should-error (eval (cons 'if if-tail))))) + +(ert-deftest eval-tests--let-with-circular-defs () + "Check that Emacs reports an error for (let VARS ...) when VARS is circular." + (let ((vars (list 'v))) + (setcdr vars vars) + (dolist (let-sym '(let let*)) + (should-error (eval (list let-sym vars)))))) + +(ert-deftest eval-tests--mutating-cond () + "Check that Emacs doesn't crash on a cond clause that mutates during eval." + (let ((clauses (list '((progn (setcdr clauses "ouch") nil))))) + (should-error (eval (cons 'cond clauses))))) + ;;; eval-tests.el ends here commit 8a406d1185b6c87f6647c141a1cc06786cd9480d Author: Eli Zaretskii Date: Sun Aug 6 22:02:08 2017 +0300 * etc/tutorials/TUTORIAL.he: Update to match recent changes to TUTORIAL. diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index 4999716463..beac4b71af 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -17,13 +17,18 @@ לדוגמה: <<שורות ריקות תתווספנה סביב השורה הבאה ע״י help-with-tutorial>> [אמצע העמוד הושאר ריק למטרות לימודיות. הטקסט ממשיך להלן] ->> הקישו עתה C-v (הצג העמוד הבא) על־מנת להתקדם לעמוד הבא. (קדימה, נסו - זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.) +>> הקישו עתה C-v (הצג העמוד הבא) על־מנת לגלול תצוגה לעמוד הבא. (קדימה, + נסו זאת ע״י לחיצה והחזקה של מקש CONTROL והקשה על v.) מעתה והלאה, עליכם לעשות זאת בכל פעם שתסיימו לקרוא את המוצג על המסך. -שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למשך, מה שמבטיח רציפות +שימו לב לחפיפה של שתי שורות כאשר אתם עוברים ממסך למסך, מה שמבטיח רציפות מסוימת בעת קריאת הטקסט. +הטקסט שלפניכם הינו עותק של שיעור בשימוש ב־‫Emacs‬ שהותאם קלות עבורכם. +בהמשך תקבלו הוראות לנסות פקודות שונות כדי לבצע שינויים בטקסט הזה. אם +במקרה תשנו את הטקסט לפני שנבקש, אל דאגה: זוהי "עריכה" שהיא יעודו של +Emacs. + דבר ראשון שעליכם ללמוד הוא כיצד לנוע ממקום אחד למשנהו בתוך הטקסט. אתם כבר יודעים כיצד להתקדם לעמוד הבא, עם C-v. לחזרה לעמוד הקודם הקישו M-v (החזיקו מקש META והקישו v או הקישו ‪v‬ אם אין במקלדת מקש META @@ -31,6 +36,7 @@ >> נסו עתה כמה פעמים להקיש M-v ואחר־כך C-v. +אפשר לגלול טקסט גם באמצעים אחרים, אם אתם יודעים כיצד לעשות זאת. * סיכום עד כאן -------------- commit c2a8cffe8044cc38c4cf1b5c3d1c9571ddeec623 Author: Mark Oteiza Date: Sun Aug 6 10:15:17 2017 -0400 ; Fix previous commit The mailcap minibuffer completion used dynamic binding. Locally set a dynamic variable. * lisp/dired-aux.el: Store list of files in `minibuffer-completion-table'. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 0a8ec26f7c..2b89e527c3 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -619,8 +619,9 @@ with a prefix argument." This function is used to add all related commands retrieved by `mailcap' to the end of the list of defaults just after the default value." (interactive) - (let ((commands (and (boundp 'files) (require 'mailcap nil t) - (mailcap-file-default-commands files)))) + (let* ((files minibuffer-completion-table) + (commands (and (require 'mailcap nil t) + (mailcap-file-default-commands files)))) (if (listp minibuffer-default) (append minibuffer-default commands) (cons minibuffer-default commands)))) @@ -638,6 +639,7 @@ This normally reads using `read-shell-command', but if the offer a smarter default choice of shell command." (minibuffer-with-setup-hook (lambda () + (set (make-local-variable 'minibuffer-completion-table) files) (set (make-local-variable 'minibuffer-default-add-function) 'minibuffer-default-add-dired-shell-commands)) (setq prompt (format prompt (dired-mark-prompt arg files))) commit b1b99edd3ee587a5154106d4d16547eac4916c55 Author: Tino Calancha Date: Sun Aug 6 22:16:56 2017 +0900 Minor tweak in a dired test * test/lisp/dired-tests.el (dired-test-bug27968): Ensure the new header has different length than the original one. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 105a79f001..981afdd929 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -333,9 +333,13 @@ (save-excursion (goto-char 1) (forward-line 1) - (let ((inhibit-read-only t)) + (let ((inhibit-read-only t) + (new-header " test-bug27968")) (delete-region (point) (point-at-eol)) - (insert " test-bug27968"))) + (when (= orig-len (length new-header)) + ;; Wow lucky guy! I must buy lottery today. + (setq new-header (concat new-header " :-)"))) + (insert new-header))) (setq len (funcall header-len-fn) diff (- len orig-len)) (should-not (zerop diff)) ; Header length has changed. commit e7aabd8b1ced130c8bf5abecf2fa14b962a9b012 Author: Tino Calancha Date: Sun Aug 6 21:53:07 2017 +0900 dired-delete-file: Do not TAB complete the user answer This action might delete directories containing valuable information. Before previous commit, we prompted users with `yes-or-no-p' which doesn't TAB complete the user answer. Let's play safe and keep requiring full answers. * emacs-master/lisp/dired.el (dired-delete-file): Use `read-string' instead of `completing-read' to read the user answers. diff --git a/lisp/dired.el b/lisp/dired.el index 0bad2562eb..54bc621703 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -3011,27 +3011,32 @@ TRASH non-nil means to trash the file instead of deleting, provided (delete-file file trash) (let* ((valid-answers (list "yes" "no" "all" "quit" "help")) (answer "") - (input-fn (lambda () - (setq answer - (completing-read - (format "Recursively %s %s? [yes, no, all, quit, help] " - (if (and trash - delete-by-moving-to-trash) - "trash" - "delete") - (dired-make-relative file)) - valid-answers nil t)) - (when (string= answer "help") - (setq answer "") - (with-help-window "*Help*" - (with-current-buffer "*Help*" (insert dired-delete-help)))) - answer))) + (input-fn + (lambda () + (setq answer + (read-string + (format "Recursively %s %s? [yes, no, all, quit, help] " + (if (and trash + delete-by-moving-to-trash) + "trash" + "delete") + (dired-make-relative file)))) + (when (string= answer "help") + (with-help-window "*Help*" + (with-current-buffer "*Help*" (insert dired-delete-help)))) + answer))) (if (and recursive (directory-files file t dired-re-no-dot) ; Not empty. (eq recursive 'always)) (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. ;; Otherwise prompt user: - (while (string= "" answer) (funcall input-fn)) + (funcall input-fn) + (while (not (member answer valid-answers)) + (unless (string= answer "help") + (beep) + (message "Please answer `yes' or `no' or `all' or `quit'") + (sleep-for 2)) + (funcall input-fn)) (pcase answer ('"all" (setq recursive 'always dired-recursive-deletes recursive)) ('"yes" (if (eq recursive 'top) (setq recursive 'always))) commit cbea38e5c4af5386192fb9a48ef4fca5080d6561 Author: Tino Calancha Date: Sun Aug 6 13:46:51 2017 +0900 dired-do-delete: Allow to delete dirs recursively without prompts * lisp/dired.el (dired-delete-file): Accept 2 additional answers: 'all', to delete all directories recursively and no prompt anymore. 'quit', to cancel directory deletions (Bug#27940). Show help message when user inputs 'help'. (dired-do-flagged-delete): Bind locally dired-recursive-deletes so that we can overwrite its global value. Wrapp the loop within a catch '--delete-cancel to catch when the user abort the directtry deletion. * doc/emacs/dired.texi (Dired Deletion): Update manual. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.1): Announce this change. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 150ac8427a..c1cc2f8cf9 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -236,6 +236,14 @@ Dired cannot delete directories that are nonempty. If the variable @code{dired-recursive-deletes} is non-@code{nil}, then Dired can delete nonempty directories including all their contents. That can be somewhat risky. +Even if you have set @code{dired-recursive-deletes} to @code{nil}, +you might want sometimes to delete recursively directories +without being asked for confirmation for all of them. This is handy +when you have marked many directories for deletion and you are very +sure that all of them can safely being deleted. For every nonempty +directory you are asked for confirmation; if you answer @code{all}, +then all the remaining directories will be deleted without more +questions. @vindex delete-by-moving-to-trash If you change the variable @code{delete-by-moving-to-trash} to diff --git a/etc/NEWS b/etc/NEWS index b72793dec0..b47bf959be 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -610,6 +610,10 @@ paragraphs, for the purposes of bidirectional display. ** Dired ++++ +*** You can answer 'all' in 'dired-do-delete' to delete recursively all +remaining directories without more prompts. + +++ *** Dired supports wildcards in the directory part of the file names. diff --git a/lisp/dired.el b/lisp/dired.el index d04bd6fe03..0bad2562eb 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2981,6 +2981,14 @@ Any other value means to ask for each directory." ;; Match anything but `.' and `..'. (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*") +(defconst dired-delete-help + "Type: +`yes' to delete recursively the current directory, +`no' to skip to next, +`all' to delete all remaining directories with no more questions, +`quit' to exit, +`help' to show this help message.") + ;; Delete file, possibly delete a directory and all its files. ;; This function is useful outside of dired. One could change its name ;; to e.g. recursive-delete-file and put it somewhere else. @@ -2996,23 +3004,40 @@ its possible values is: TRASH non-nil means to trash the file instead of deleting, provided `delete-by-moving-to-trash' (which see) is non-nil." - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (not (eq t (car (file-attributes file)))) - (delete-file file trash) - (if (and recursive - (directory-files file t dired-re-no-dot) ; Not empty. - (or (eq recursive 'always) - (yes-or-no-p (format "Recursively %s %s? " - (if (and trash - delete-by-moving-to-trash) - "trash" - "delete") - (dired-make-relative file))))) - (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. - (setq recursive nil)) - (delete-directory file recursive trash))) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (not (eq t (car (file-attributes file)))) + (delete-file file trash) + (let* ((valid-answers (list "yes" "no" "all" "quit" "help")) + (answer "") + (input-fn (lambda () + (setq answer + (completing-read + (format "Recursively %s %s? [yes, no, all, quit, help] " + (if (and trash + delete-by-moving-to-trash) + "trash" + "delete") + (dired-make-relative file)) + valid-answers nil t)) + (when (string= answer "help") + (setq answer "") + (with-help-window "*Help*" + (with-current-buffer "*Help*" (insert dired-delete-help)))) + answer))) + (if (and recursive + (directory-files file t dired-re-no-dot) ; Not empty. + (eq recursive 'always)) + (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again. + ;; Otherwise prompt user: + (while (string= "" answer) (funcall input-fn)) + (pcase answer + ('"all" (setq recursive 'always dired-recursive-deletes recursive)) + ('"yes" (if (eq recursive 'top) (setq recursive 'always))) + ('"no" (setq recursive nil)) + ('"quit" (keyboard-quit)))) + (delete-directory file recursive trash)))) (defun dired-do-flagged-delete (&optional nomessage) "In Dired, delete the files flagged for deletion. @@ -3061,6 +3086,9 @@ non-empty directories is allowed." (let* ((files (mapcar #'car l)) (count (length l)) (succ 0) + ;; Bind `dired-recursive-deletes' so that we can change it + ;; locally according with the user answer within `dired-delete-file'. + (dired-recursive-deletes dired-recursive-deletes) (trashing (and trash delete-by-moving-to-trash))) ;; canonicalize file list for pop up (setq files (nreverse (mapcar #'dired-make-relative files))) @@ -3070,6 +3098,7 @@ non-empty directories is allowed." (if trashing "Trash" "Delete") (dired-mark-prompt arg files))) (save-excursion + (catch '--delete-cancel (let ((progress-reporter (make-progress-reporter (if trashing "Trashing..." "Deleting...") @@ -3087,6 +3116,7 @@ non-empty directories is allowed." (dired-fun-in-all-buffers (file-name-directory fn) (file-name-nondirectory fn) #'dired-delete-entry fn)) + (quit (throw '--delete-cancel (message "OK, canceled"))) (error ;; catch errors from failed deletions (dired-log "%s\n" err) (setq failures (cons (car (car l)) failures))))) @@ -3097,7 +3127,7 @@ non-empty directories is allowed." (format "%d of %d deletion%s failed" (length failures) count (dired-plural-s count)) - failures)))) + failures))))) (message "(No deletions performed)"))) (dired-move-to-filename)) commit 785a4a1d52fd7da3f3169fda26841341667c1661 Author: Paul Eggert Date: Sat Aug 5 21:27:45 2017 -0700 Fix a couple of make-temp-file races * lisp/emacs-lisp/autoload.el (autoload--save-buffer): * lisp/emacs-lisp/bytecomp.el (byte-compile-file): Use make-temp-file, not make-temp-name, to avoid an unlikely race that could lose data. Remove the deletion hook as quickly as possible after the file is renamed; though a race still remains here, it is smaller than before. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 8fe9401370..4a9bd6d06b 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -875,16 +875,16 @@ FILE's modification time." "Save current buffer to its file, atomically." ;; Copied from byte-compile-file. (let* ((version-control 'never) - (tempfile (make-temp-name buffer-file-name)) + (tempfile (make-temp-file buffer-file-name)) (kill-emacs-hook (cons (lambda () (ignore-errors (delete-file tempfile))) kill-emacs-hook))) (write-region (point-min) (point-max) tempfile nil 1) (backup-buffer) - (rename-file tempfile buffer-file-name t) - (set-buffer-modified-p nil) - (set-visited-file-modtime) - (or noninteractive (message "Wrote %s" buffer-file-name)))) + (rename-file tempfile buffer-file-name t)) + (set-buffer-modified-p nil) + (set-visited-file-modtime) + (or noninteractive (message "Wrote %s" buffer-file-name))) (defun autoload-save-buffers () (while autoload-modified-buffers diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index fdd4276e4e..5fa7389e43 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1888,25 +1888,27 @@ The value is non-nil if there were no errors, nil if errors." (insert "\n") ; aaah, unix. (if (file-writable-p target-file) ;; We must disable any code conversion here. - (let* ((coding-system-for-write 'no-conversion) - ;; Write to a tempfile so that if another Emacs - ;; process is trying to load target-file (eg in a - ;; parallel bootstrap), it does not risk getting a - ;; half-finished file. (Bug#4196) - (tempfile (make-temp-name target-file)) - (kill-emacs-hook - (cons (lambda () (ignore-errors (delete-file tempfile))) - kill-emacs-hook))) - (write-region (point-min) (point-max) tempfile nil 1) - ;; This has the intentional side effect that any - ;; hard-links to target-file continue to - ;; point to the old file (this makes it possible - ;; for installed files to share disk space with - ;; the build tree, without causing problems when - ;; emacs-lisp files in the build tree are - ;; recompiled). Previously this was accomplished by - ;; deleting target-file before writing it. - (rename-file tempfile target-file t) + (progn + (let* ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile (make-temp-file target-file)) + (kill-emacs-hook + (cons (lambda () (ignore-errors + (delete-file tempfile))) + kill-emacs-hook))) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t)) (or noninteractive (message "Wrote %s" target-file))) ;; This is just to give a better error message than write-region (let ((exists (file-exists-p target-file))) commit c0df64db08b58cdac37cb38c16f2ba2f097fae92 Author: Tino Calancha Date: Sun Aug 6 13:23:05 2017 +0900 Dired w/ eshell-ls: Handle shell wildcards in file name * lisp/eshell/em-ls.el (eshell-ls--insert-directory): Use eshell-extended-glob (Bug#27844). * test/lisp/dired-tests.el (dired-test-bug27844): Add test. diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 39f03ffb79..38e38132bf 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -243,6 +243,9 @@ scope during the evaluation of TEST-SEXP." ;;; Functions: +(declare-function eshell-extended-glob "em-glob" (glob)) +(defvar eshell-error-if-no-glob) + (defun eshell-ls--insert-directory (orig-fun file switches &optional wildcard full-directory-p) "Insert directory listing for FILE, formatted according to SWITCHES. @@ -275,14 +278,22 @@ instead." (set 'font-lock-buffers (delq (current-buffer) (symbol-value 'font-lock-buffers))))) - (let ((insert-func 'insert) - (error-func 'insert) - (flush-func 'ignore) - (switches - (append eshell-ls-dired-initial-args - (and (or (consp dired-directory) wildcard) (list "-d")) - switches))) - (eshell-do-ls (nconc switches (list file))))))))) + (require 'em-glob) + (let* ((insert-func 'insert) + (error-func 'insert) + (flush-func 'ignore) + (eshell-error-if-no-glob t) + (target ; Expand the shell wildcards if any. + (if (and (atom file) + (string-match "[[?*]" file) + (not (file-exists-p file))) + (mapcar #'file-relative-name (eshell-extended-glob file)) + (file-relative-name file))) + (switches + (append eshell-ls-dired-initial-args + (and (or (consp dired-directory) wildcard) (list "-d")) + switches))) + (eshell-do-ls (nconc switches (list target))))))))) (declare-function eshell-extended-glob "em-glob" (glob)) diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el index 71a555d1ea..8e7b91d979 100644 --- a/test/lisp/eshell/em-ls-tests.el +++ b/test/lisp/eshell/em-ls-tests.el @@ -75,6 +75,24 @@ (customize-set-variable 'eshell-ls-use-in-dired orig) (and (buffer-live-p buf) (kill-buffer))))) +(ert-deftest em-ls-test-bug27844 () + "Test for http://debbugs.gnu.org/27844 ." + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (setq buf (dired (expand-file-name "lisp/*.el" source-directory))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files))) + (kill-buffer buf) + (setq buf (dired (expand-file-name "lisp/subr.el" source-directory))) + (should (looking-at "subr\\.el"))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (and (buffer-live-p buf) (kill-buffer))))) + + (provide 'em-ls-test) ;;; em-ls-tests.el ends here commit 7c3593f81724d0c7a2ee2f90797db0e705adc859 Author: Tino Calancha Date: Sun Aug 6 13:05:16 2017 +0900 dired-revert: save line numbers instead of positions Positions might change if the length of one dired header line changes; this happen, for instance, if we add new files. Instead, line numbers are invariant under shrinks/enlargements of the file header. https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg01092.html * lisp/dired.el (dired-save-positions): Save the line numbers at point. (dired-restore-positions): Use forward-line to restore the original position (Bug#27968). * test/lisp/dired-tests.el (dired-test-bug27968): Add test. diff --git a/lisp/dired.el b/lisp/dired.el index 24759c6c9b..d04bd6fe03 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1444,18 +1444,22 @@ ARG and NOCONFIRM, passed from `revert-buffer', are ignored." The positions have the form (BUFFER-POSITION WINDOW-POSITIONS). BUFFER-POSITION is the point position in the current Dired buffer. -It has the form (BUFFER DIRED-FILENAME BUFFER-POINT). +It has the form (BUFFER DIRED-FILENAME BUFFER-LINE-NUMBER). WINDOW-POSITIONS are current positions in all windows displaying this dired buffer. The window positions have the form (WINDOW -DIRED-FILENAME WINDOW-POINT)." +DIRED-FILENAME WINDOW-LINE-NUMBER). + +We store line numbers instead of point positions because the header +lines might change as well: when this happen the line number doesn't +change; the point does." (list - (list (current-buffer) (dired-get-filename nil t) (point)) + (list (current-buffer) (dired-get-filename nil t) (line-number-at-pos)) (mapcar (lambda (w) - (list w - (with-selected-window w - (dired-get-filename nil t)) - (window-point w))) + (with-selected-window w + (list w + (dired-get-filename nil t) + (line-number-at-pos (window-point w))))) (get-buffer-window-list nil 0 t)))) (defun dired-restore-positions (positions) @@ -1464,7 +1468,8 @@ DIRED-FILENAME WINDOW-POINT)." (buffer (nth 0 buf-file-pos))) (unless (and (nth 1 buf-file-pos) (dired-goto-file (nth 1 buf-file-pos))) - (goto-char (nth 2 buf-file-pos)) + (goto-char (point-min)) + (forward-line (1- (nth 2 buf-file-pos))) (dired-move-to-filename)) (dolist (win-file-pos (nth 1 positions)) ;; Ensure that window still displays the original buffer. @@ -1472,7 +1477,8 @@ DIRED-FILENAME WINDOW-POINT)." (with-selected-window (nth 0 win-file-pos) (unless (and (nth 1 win-file-pos) (dired-goto-file (nth 1 win-file-pos))) - (goto-char (nth 2 win-file-pos)) + (goto-char (point-min)) + (forward-line (1- (nth 2 win-file-pos))) (dired-move-to-filename))))))) (defun dired-remember-marks (beg end) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index b14bbc6360..105a79f001 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -308,5 +308,51 @@ (should (eq 2 (current-column)))) (dired-hide-details-mode orig)))) +(ert-deftest dired-test-bug27968 () + "Test for http://debbugs.gnu.org/27968 ." + (let* ((top-dir (make-temp-file "top-dir" t)) + (subdir (expand-file-name "subdir" top-dir)) + (header-len-fn (lambda () + (save-excursion + (goto-char 1) + (forward-line 1) + (- (point-at-eol) (point))))) + orig-len len diff pos line-nb) + (make-directory subdir 'parents) + (unwind-protect + (with-current-buffer (dired-noselect subdir) + (setq orig-len (funcall header-len-fn) + pos (point) + line-nb (line-number-at-pos)) + ;; Bug arises when the header line changes its length; this may + ;; happen if the used space has changed: for instance, with the + ;; creation of additional files. + (make-directory "subdir" t) + (dired-revert) + ;; Change the header line. + (save-excursion + (goto-char 1) + (forward-line 1) + (let ((inhibit-read-only t)) + (delete-region (point) (point-at-eol)) + (insert " test-bug27968"))) + (setq len (funcall header-len-fn) + diff (- len orig-len)) + (should-not (zerop diff)) ; Header length has changed. + ;; If diff > 0, then the point moves back. + ;; If diff < 0, then the point moves forward. + ;; If diff = 0, then the point doesn't move. + ;; Sometimes this point movement causes + ;; line-nb != (line-number-at-pos pos), so that we get + ;; an unexpected file at point if we store buffer points. + ;; Note that the line number before/after revert + ;; doesn't change. + (should (= line-nb + (line-number-at-pos) + (line-number-at-pos (+ pos diff)))) + ;; After revert, the point must be in 'subdir' line. + (should (equal "subdir" (dired-get-filename 'local t)))) + (delete-directory top-dir t)))) + (provide 'dired-tests) ;; dired-tests.el ends here commit 9b463fa8648b7baed95a44f4317cb7402fd8bf1c Author: Tom Tromey Date: Sat Aug 5 18:30:52 2017 -0600 Respect comment-auto-fill-only-comments Respect comment-auto-fill-only-comments when auto-filling and a comment syntax is defined. * lisp/newcomment.el (comment-indent-new-line): Do not check comment-auto-fill-only-comments. * lisp/simple.el (internal-auto-fill): New defun. * src/cmds.c (internal_self_insert): Call Qinternal_auto_fill, not auto_fill_function. (syms_of_cmds): Define Qinternal_auto_fill. diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 8772b52376..e3ee4dfab1 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1382,10 +1382,9 @@ unless optional argument SOFT is non-nil." (interactive) (comment-normalize-vars t) (let (compos comin) - ;; If we are not inside a comment and we only auto-fill comments, - ;; don't do anything (unless no comment syntax is defined). + ;; If we are not inside a comment don't do anything (unless no + ;; comment syntax is defined). (unless (and comment-start - comment-auto-fill-only-comments (not (called-interactively-p 'interactive)) (not (save-excursion (prog1 (setq compos (comment-beginning)) diff --git a/lisp/simple.el b/lisp/simple.el index e3d86abe87..027ce3959a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -7219,6 +7219,13 @@ unless optional argument SOFT is non-nil." ;; If we're not inside a comment, just try to indent. (t (indent-according-to-mode)))))) +(defun internal-auto-fill () + "The function called by `self-insert-command' to perform auto-filling." + (when (or (not comment-start) + (not comment-auto-fill-only-comments) + (nth 4 (syntax-ppss))) + (do-auto-fill))) + (defvar normal-auto-fill-function 'do-auto-fill "The function to use for `auto-fill-function' if Auto Fill mode is turned on. Some major modes set this.") diff --git a/src/cmds.c b/src/cmds.c index 51652d542a..6f2db8696e 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -268,9 +268,10 @@ Whichever character you type to run this command is inserted. The numeric prefix argument N says how many times to repeat the insertion. Before insertion, `expand-abbrev' is executed if the inserted character does not have word syntax and the previous character in the buffer does. -After insertion, the value of `auto-fill-function' is called if the -`auto-fill-chars' table has a non-nil value for the inserted character. -At the end, it runs `post-self-insert-hook'. */) +After insertion, `internal-auto-fill' is called if +`auto-fill-function' is non-nil and if the `auto-fill-chars' table has +a non-nil value for the inserted character. At the end, it runs +`post-self-insert-hook'. */) (Lisp_Object n) { CHECK_NUMBER (n); @@ -475,7 +476,7 @@ internal_self_insert (int c, EMACS_INT n) that. Must have the newline in place already so filling and justification, if any, know where the end is going to be. */ SET_PT_BOTH (PT - 1, PT_BYTE - 1); - auto_fill_result = call0 (BVAR (current_buffer, auto_fill_function)); + auto_fill_result = call0 (Qinternal_auto_fill); /* Test PT < ZV in case the auto-fill-function is strange. */ if (c == '\n' && PT < ZV) SET_PT_BOTH (PT + 1, PT_BYTE + 1); @@ -494,6 +495,8 @@ internal_self_insert (int c, EMACS_INT n) void syms_of_cmds (void) { + DEFSYM (Qinternal_auto_fill, "internal-auto-fill"); + DEFSYM (Qundo_auto_amalgamate, "undo-auto-amalgamate"); DEFSYM (Qundo_auto__this_command_amalgamating, "undo-auto--this-command-amalgamating"); commit 0bd08c00751a9deee66d304d3f18aa45ef1276db Author: Richard Stallman Date: Sat Aug 5 14:01:59 2017 -0700 * etc/tutorials/TUTORIAL: Update. diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index 3419c63c1f..a41e7b01cd 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL @@ -17,15 +17,19 @@ The characters ">>" at the left margin indicate directions for you to try using a command. For instance: <> [Middle of page left blank for didactic purposes. Text continues below] ->> Now type C-v (View next screen) to move to the next screen. +>> Now type C-v (View next screen) to scroll down in the tutorial. (go ahead, do it by holding down the CONTROL key while typing v). - From now on, you should do this again whenever you finish - reading the screen. + From now on, please do this whenever you reach the end of the screen. -Note that there is an overlap of two lines when you move from screen -to screen; this provides some continuity so you can continue reading +Note that there is an overlap of two lines when you scroll a whole +screenful; this provides some continuity so you can continue reading the text. +This is a copy of the Emacs tutorial text, customized slightly for +you. Later on we will instruct you to try various commands to alter +this text. Don't worry if you change this text before we tell you to; +that is called "editing" and that's what Emacs is for. + The first thing that you need to know is how to move around from place to place in the text. You already know how to move forward one screen, with C-v. To move backwards one screen, type M-v (hold down the META key @@ -33,6 +37,7 @@ and type v, or type v if you do not have a META, EDIT, or ALT key). >> Try typing M-v and then C-v, a few times. +It is ok to scroll this text in other ways, if you know how. * SUMMARY --------- @@ -56,7 +61,6 @@ You can also use the PageUp and PageDn keys to move by screenfuls, if your terminal has them, but you can edit more efficiently if you use C-v and M-v. - * BASIC CURSOR CONTROL ---------------------- commit 9df49cddae382d775122b52f19276963dfc6d670 Author: Eli Zaretskii Date: Sat Aug 5 16:47:14 2017 +0300 Unify CNS11643-15 in a way that avoids segfaults * lisp/international/mule-conf.el: Redo unification of cns11643-15. (Bug#27964) (chinese-cns11643-15): Add the missing :unify-map attribute. diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 15f7c0f9ff..a7764b6a53 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1175,7 +1175,8 @@ :short-name "CNS11643-15" :long-name "CNS11643-15 (Chinese traditional)" :code-space [33 126 33 126] - :code-offset #x27A000) + :code-offset #x27A000 + :unify-map "CNS-F") (unify-charset 'chinese-gb2312) (unify-charset 'chinese-gbk) @@ -1186,8 +1187,7 @@ (unify-charset 'chinese-cns11643-5) (unify-charset 'chinese-cns11643-6) (unify-charset 'chinese-cns11643-7) -;; Doing the below causes Emacs to segfault during Punct.el production. -;; (unify-charset 'chinese-cns11643-15) +(unify-charset 'chinese-cns11643-15) (unify-charset 'big5) (unify-charset 'chinese-big5-1) (unify-charset 'chinese-big5-2) commit 5840399b7610544bbc4eb006a6cd79c0f7c71612 Author: Eli Zaretskii Date: Sat Aug 5 16:28:09 2017 +0300 Avoid segfaults while producing Punct.el * lisp/international/mule-conf.el: Undo unification of cns11643-15, as that causes segfaults during bootstrap. (Bug#27964) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 06cb395a5f..15f7c0f9ff 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1186,7 +1186,8 @@ (unify-charset 'chinese-cns11643-5) (unify-charset 'chinese-cns11643-6) (unify-charset 'chinese-cns11643-7) -(unify-charset 'chinese-cns11643-15) +;; Doing the below causes Emacs to segfault during Punct.el production. +;; (unify-charset 'chinese-cns11643-15) (unify-charset 'big5) (unify-charset 'chinese-big5-1) (unify-charset 'chinese-big5-2) commit c3ac93bb9ff8b1fe1fc32f99c725e6cc209aa6ca Author: Eli Zaretskii Date: Sat Aug 5 14:22:04 2017 +0300 Make header line in some modes be sensitive to display-line-numbers * lisp/ruler-mode.el (ruler-mode-ruler, ruler-mode-window-col): * lisp/emacs-lisp/tabulated-list.el (tabulated-list-init-header) (tabulated-list-print-entry): Account for the width taken by line-number display. (Bug#27895) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index b6b49b1bfa..8ff5cdf18e 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -194,6 +194,8 @@ Populated by `tabulated-list-init-header'.") mouse-face highlight keymap ,tabulated-list-sort-button-map)) (cols nil)) + (if display-line-numbers + (setq x (+ x (line-number-display-width) 2))) (push (propertize " " 'display `(space :align-to ,x)) cols) (dotimes (n (length tabulated-list-format)) (let* ((col (aref tabulated-list-format n)) @@ -410,6 +412,8 @@ of column descriptors." (x (max tabulated-list-padding 0)) (ncols (length tabulated-list-format)) (inhibit-read-only t)) + (if display-line-numbers + (setq x (+ x (line-number-display-width) 2))) (if (> tabulated-list-padding 0) (insert (make-string x ?\s))) (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506). diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index fdfd5c61be..16277973d6 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -304,7 +304,10 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or (defsubst ruler-mode-window-col (n) "Return a column number relative to the selected window. -N is a column number relative to selected frame." +N is a column number relative to selected frame. +If required, account for screen estate taken by `display-line-numbers'." + (if display-line-numbers + (setq n (- n (line-number-display-width) 2))) (- n (or (car (window-margins)) 0) (fringe-columns 'left) @@ -665,7 +668,7 @@ Optional argument PROPS specifies other text properties to apply." (let* ((w (ruler-mode-text-scaled-window-width)) (m (window-margins)) (f (window-fringes)) - (i 0) + (i (if display-line-numbers (+ (line-number-display-width) 2) 0)) (j (ruler-mode-text-scaled-window-hscroll)) ;; Setup the scrollbar, fringes, and margins areas. (lf (ruler-mode-space @@ -701,7 +704,15 @@ Optional argument PROPS specifies other text properties to apply." ;; hence the need for `string-to-multibyte'. ;; http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00841.html (string-to-multibyte - (make-string w ruler-mode-basic-graduation-char)) + ;; Make the part of header-line corresponding to the + ;; line-number display be blank, not filled with + ;; ruler-mode-basic-graduation-char. + (if display-line-numbers + (let* ((lndw (+ (line-number-display-width) 2)) + (s (make-string lndw ?\s))) + (concat s (make-string (- w lndw) + ruler-mode-basic-graduation-char))) + (make-string w ruler-mode-basic-graduation-char))) 'face 'ruler-mode-default 'local-map ruler-mode-map 'help-echo (cond commit 885c512603f946dfb7a45c181e94b8677be2678d Author: Eli Zaretskii Date: Sat Aug 5 12:52:55 2017 +0300 Fix a bug in 'generate-new-buffer-name' * src/buffer.c (Fgenerate_new_buffer_name): Test IGNORE for being nil before calling string-equal, since the latter will compare "nil and 'nil' as equal. (Bug#27966) * test/src/buffer-tests.el (test-generate-new-buffer-name-bug27966): New test. diff --git a/src/buffer.c b/src/buffer.c index 649ddbe183..0d0f43e937 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1077,7 +1077,8 @@ is first appended to NAME, to speed up finding a non-existent buffer. */) CHECK_STRING (name); - if (!NILP (Fstring_equal (name, ignore)) || NILP (Fget_buffer (name))) + if ((!NILP (ignore) && !NILP (Fstring_equal (name, ignore))) + || NILP (Fget_buffer (name))) return name; if (SREF (name, 0) != ' ') /* See bug#1229. */ diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 793dddd8bd..87406740a7 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -45,4 +45,9 @@ with parameters from the *Messages* buffer modification." (should (eq buf (current-buffer)))) (when msg-ov (delete-overlay msg-ov)))))) +(ert-deftest test-generate-new-buffer-name-bug27966 () + (should-not (string-equal "nil" + (progn (get-buffer-create "nil") + (generate-new-buffer-name "nil"))))) + ;;; buffer-tests.el ends here commit 2cb9805702a4f15ca7ee4ef4edb6e6048b1d3320 Author: Eli Zaretskii Date: Sat Aug 5 12:23:08 2017 +0300 Unify CNS11643-15 * lisp/international/mule-conf.el (chinese-cns11643-15): Add a unify-charset form for it. (Bug#27964) diff --git a/lisp/international/mule-conf.el b/lisp/international/mule-conf.el index 68a412f206..06cb395a5f 100644 --- a/lisp/international/mule-conf.el +++ b/lisp/international/mule-conf.el @@ -1186,6 +1186,7 @@ (unify-charset 'chinese-cns11643-5) (unify-charset 'chinese-cns11643-6) (unify-charset 'chinese-cns11643-7) +(unify-charset 'chinese-cns11643-15) (unify-charset 'big5) (unify-charset 'chinese-big5-1) (unify-charset 'chinese-big5-2) commit a0aef7cd02154ebf616c894475e6ca72243b9094 Author: Eli Zaretskii Date: Sat Aug 5 12:00:31 2017 +0300 Improve test of error message when Emacs cannot be suspended * lisp/term/x-win.el (x-win-suspend-error): * lisp/term/ns-win.el (ns-suspend-error): Improve the error message. (Bug#27901) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 4df5f0abe2..8848360655 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -774,7 +774,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (defun ns-suspend-error () ;; Don't allow suspending if any of the frames are NS frames. (if (memq 'ns (mapcar 'window-system (frame-list))) - (error "Cannot suspend Emacs while running under NS"))) + (error "Cannot suspend Emacs while an NS GUI frame exists"))) ;; Set some options to be as Nextstep-like as possible. diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 532d0395cf..dd42dda106 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1182,7 +1182,7 @@ as returned by `x-server-vendor'." This returns an error if any Emacs frames are X frames." ;; Don't allow suspending if any of the frames are X frames. (if (memq 'x (mapcar #'window-system (frame-list))) - (error "Cannot suspend Emacs while running under X"))) + (error "Cannot suspend Emacs while an X GUI frame exists"))) (defvar x-initialized nil "Non-nil if the X window system has been initialized.") commit 8a577e9468136c7bbcb1627917c4b8c124547f6c Author: Alexander Gramiak Date: Sat Aug 5 11:51:05 2017 +0300 Make "C-h o" show faces as well as variables * lisp/faces.el (describe-face): Return (buffer-string). Reorder the placement of variables/faces in describe-symbol, to put more emphasis on the variable entry rather than the face. (Bug#24543) diff --git a/lisp/faces.el b/lisp/faces.el index c0c1c7b59f..5ed11d11ce 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1454,7 +1454,7 @@ If FRAME is omitted or nil, use the selected frame." (setq face (list face))) (with-help-window (help-buffer) (with-current-buffer standard-output - (dolist (f face) + (dolist (f face (buffer-string)) (if (stringp f) (setq f (intern f))) ;; We may get called for anonymous faces (i.e., faces ;; expressed using prop-value plists). Those can't be diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 3fb793e7aa..24dfb9120b 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -393,12 +393,12 @@ it does not already exist." (defvar describe-symbol-backends `((nil ,#'fboundp ,(lambda (s _b _f) (describe-function s))) - ("face" ,#'facep ,(lambda (s _b _f) (describe-face s))) (nil ,(lambda (symbol) (or (and (boundp symbol) (not (keywordp symbol))) (get symbol 'variable-documentation))) - ,#'describe-variable))) + ,#'describe-variable) + ("face" ,#'facep ,(lambda (s _b _f) (describe-face s))))) ;;;###autoload (defun help-make-xrefs (&optional buffer) commit 2441d0118b498dfde9144a86628bdc6974324e49 Author: Eli Zaretskii Date: Sat Aug 5 11:38:04 2017 +0300 Fix files-tests.el for MS-Windows * test/lisp/files-tests.el (files-tests--file-name-non-special--subprocess): Fix this test for MS-Windows. diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 59c1dbcbcc..7bfdca53e0 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -247,10 +247,11 @@ be $HOME." (ert-deftest files-tests--file-name-non-special--subprocess () "Check that Bug#25949 is fixed." (skip-unless (executable-find "true")) - (should (eq (let ((default-directory "/:/")) (process-file "true")) 0)) - (should (processp (let ((default-directory "/:/")) - (start-file-process "foo" nil "true")))) - (should (eq (let ((default-directory "/:/")) (shell-command "true")) 0))) + (let ((defdir (if (memq system-type '(ms-dos windows-nt)) "/:c:/" "/:/"))) + (should (eq (let ((default-directory defdir)) (process-file "true")) 0)) + (should (processp (let ((default-directory defdir)) + (start-file-process "foo" nil "true")))) + (should (eq (let ((default-directory defdir)) (shell-command "true")) 0)))) (defmacro files-tests--with-advice (symbol where function &rest body) (declare (indent 3)) commit 19a41ce2dea79b4e5fb8baf1060b615bc03af63b Author: Eli Zaretskii Date: Sat Aug 5 11:03:24 2017 +0300 Improve documentation of 'region-extract-function' * lisp/simple.el (region-extract-function): Rename the argument to METHOD. Doc fix. (Bug#27927) diff --git a/lisp/simple.el b/lisp/simple.el index 3d23fc3559..e3d86abe87 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -996,23 +996,24 @@ instead of deleted." :version "24.1") (defvar region-extract-function - (lambda (delete) + (lambda (method) (when (region-beginning) (cond - ((eq delete 'bounds) + ((eq method 'bounds) (list (cons (region-beginning) (region-end)))) - ((eq delete 'delete-only) + ((eq method 'delete-only) (delete-region (region-beginning) (region-end))) (t - (filter-buffer-substring (region-beginning) (region-end) delete))))) + (filter-buffer-substring (region-beginning) (region-end) method))))) "Function to get the region's content. -Called with one argument DELETE. -If DELETE is `delete-only', then only delete the region and the return value -is undefined. If DELETE is nil, just return the content as a string. -If DELETE is `bounds', then don't delete, but just return the -boundaries of the region as a list of (START . END) positions. -If anything else, delete the region and return its content as a string, -after filtering it with `filter-buffer-substring'.") +Called with one argument METHOD. +If METHOD is `delete-only', then delete the region; the return value +is undefined. If METHOD is nil, then return the content as a string. +If METHOD is `bounds', then return the boundaries of the region +as a list of the form (START . END). +If METHOD is anything else, delete the region and return its content +as a string, after filtering it with `filter-buffer-substring', which +is called with METHOD as its 3rd argument.") (defvar region-insert-function (lambda (lines) commit b8748dd0932cbcf44bcbde8591f5cebad7eebfb1 Author: Paul Eggert Date: Fri Aug 4 22:46:31 2017 -0700 Merge from gnulib This incorporates: 2017-08-04 manywarnings: port to 64-bit GCC builds of Emacs 2017-08-01 manywarnings: port to 32-bit GCC bug * lib/gnulib.mk.in: Regenerate. * m4/manywarnings.m4: Copy from gnulib. diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 11c1ecf05a..a385c8c838 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -546,8 +546,6 @@ LD_SWITCH_SYSTEM_TEMACS = @LD_SWITCH_SYSTEM_TEMACS@ LD_SWITCH_X_SITE = @LD_SWITCH_X_SITE@ LD_SWITCH_X_SITE_RPATH = @LD_SWITCH_X_SITE_RPATH@ LIBGIF = @LIBGIF@ -LIBGNUTLS3_CFLAGS = @LIBGNUTLS3_CFLAGS@ -LIBGNUTLS3_LIBS = @LIBGNUTLS3_LIBS@ LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@ LIBGNU_LIBDEPS = @LIBGNU_LIBDEPS@ diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4 index 2d35eff6a2..6a8939b2c1 100644 --- a/m4/manywarnings.m4 +++ b/m4/manywarnings.m4 @@ -1,4 +1,4 @@ -# manywarnings.m4 serial 8 +# manywarnings.m4 serial 10 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -258,9 +258,20 @@ AC_DEFUN([gl_MANYWARN_ALL_GCC], # gcc --help=warnings outputs an unusual form for these options; list # them here so that the above 'comm' command doesn't report a false match. - # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal: - ptrdiff_max_max=9223372036854775807 - gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$ptrdiff_max_max" + # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal + # and AC_COMPUTE_INT requires it to fit in a long: + AC_MSG_CHECKING([max safe object size]) + AC_COMPUTE_INT([gl_alloc_max], + [(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1 + ? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) + : (size_t) -1], + [[#include + #include + #include + ]], + [gl_alloc_max=2147483647]) + AC_MSG_RESULT([$gl_alloc_max]) + gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max" gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2" gl_manywarn_set="$gl_manywarn_set -Wformat-overflow=2" gl_manywarn_set="$gl_manywarn_set -Wformat-truncation=2" commit 0a24f47f0eeba688f92043ef8733e0f7d9836c18 Author: Paul Eggert Date: Fri Aug 4 22:34:45 2017 -0700 Port recent rename changes to Ubuntu 14.04 * src/sysdep.c (renameat_noreplace) [!RENAME_NOREPLACE]: Don’t use syscall. Problem reported by Tino Calancha (Bug#27946#10). diff --git a/src/sysdep.c b/src/sysdep.c index 22446b25d1..9eb733221e 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2691,7 +2691,7 @@ set_file_times (int fd, const char *filename, int renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) { -#ifdef SYS_renameat2 +#if defined SYS_renameat2 && defined RENAME_NOREPLACE return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); #else errno = ENOSYS; commit 055e2a1906a2f02c7b77537cbb4df858b00b39d9 Author: Tino Calancha Date: Sat Aug 5 14:04:56 2017 +0900 insert-directory-wildcard-in-dir-p: Tweak regexp This function must return non-nil for a wildcard like '/*/*.txt'. * lisp/files.el (insert-directory-wildcard-in-dir-p): Adjust regexp. * test/lisp/files-tests.el (files-tests--insert-directory-wildcard-in-dir-p): Add test. diff --git a/lisp/files.el b/lisp/files.el index 89f6f9f44d..c9114be55a 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6566,7 +6566,7 @@ Valid wildcards are '*', '?', '[abc]' and '[a-z]'." ls-lisp-support-shell-wildcards) (string-match (concat "[" wildcards "]") (file-name-directory dir)) (not (file-exists-p dir))) ; Prefer an existing file to wildcards. - (let ((regexp (format "\\`\\([^%s]+/\\)\\([^%s]*[%s].*\\)" + (let ((regexp (format "\\`\\([^%s]*/\\)\\([^%s]*[%s].*\\)" wildcards wildcards wildcards))) (string-match regexp dir) (cons (match-string 1 dir) (match-string 2 dir)))))) diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 4583b1af3c..59c1dbcbcc 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -313,5 +313,23 @@ be invoked with the right arguments." `((verify-visited-file-modtime ,buffer-visiting-file) (verify-visited-file-modtime nil)))))))) +(ert-deftest files-tests--insert-directory-wildcard-in-dir-p () + (let ((alist (list (cons "/home/user/*/.txt" (cons "/home/user/" "*/.txt")) + (cons "/home/user/.txt" nil) + (cons "/home/*/.txt" (cons "/home/" "*/.txt")) + (cons "/home/*/" (cons "/home/" "*/")) + (cons "/*/.txt" (cons "/" "*/.txt")) + ;; + (cons "c:/tmp/*/*.txt" (cons "c:/tmp/" "*/*.txt")) + (cons "c:/tmp/*.txt" nil) + (cons "c:/tmp/*/" (cons "c:/tmp/" "*/")) + (cons "c:/*/*.txt" (cons "c:/" "*/*.txt"))))) + (dolist (path-res alist) + (should + (equal + (cdr path-res) + (insert-directory-wildcard-in-dir-p (car path-res))))))) + + (provide 'files-tests) ;;; files-tests.el ends here commit 12d7757a794edaf6ad81ee468dc99998ecf5d4ac Author: Noam Postavsky Date: Fri Aug 4 18:36:05 2017 -0400 ; * lisp/emacs-lisp/re-builder.el: Fix commentary (Bug#27947). diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index f60d723a88..2eff1d1ab3 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -64,8 +64,8 @@ ;; syntax and string syntax are both delimited by `"'s and behave ;; according to their name. With the `string' syntax there's no need ;; to escape the backslashes and double quotes simplifying the editing -;; somewhat. The other three allow editing of symbolic regular -;; expressions supported by the packages of the same name. +;; somewhat. The `rx' syntax allows editing of symbolic regular +;; expressions supported by the package of the same name. ;; Editing symbolic expressions is done through a major mode derived ;; from `emacs-lisp-mode' so you'll get all the good stuff like commit 3a0f2dfa79611d5f3789a1127603d3798e83b9f8 Author: Noam Postavsky Date: Fri Aug 4 17:55:50 2017 -0400 ; Fix map-tests when compiled * test/lisp/emacs-lisp/map-tests.el (test-map-elt-testfn) (test-map-put-testfn-alist): Make sure the lookup key is really non-eq to the map's key, even if the code is compiled. diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 15b0655040..fc0a6a57c7 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -64,9 +64,11 @@ Evaluate BODY for each created map. (should (= 5 (map-elt map 7 5))))) (ert-deftest test-map-elt-testfn () - (let ((map (list (cons "a" 1) (cons "b" 2)))) - (should-not (map-elt map "a")) - (should (map-elt map "a" nil 'equal)))) + (let ((map (list (cons "a" 1) (cons "b" 2))) + ;; Make sure to use a non-eq "a", even when compiled. + (noneq-key (string ?a))) + (should-not (map-elt map noneq-key)) + (should (map-elt map noneq-key nil 'equal)))) (ert-deftest test-map-elt-with-nil-value () (should (null (map-elt '((a . 1) @@ -100,10 +102,12 @@ Evaluate BODY for each created map. 'b)))) (ert-deftest test-map-put-testfn-alist () - (let ((alist (list (cons "a" 1) (cons "b" 2)))) - (map-put alist "a" 3 'equal) + (let ((alist (list (cons "a" 1) (cons "b" 2))) + ;; Make sure to use a non-eq "a", even when compiled. + (noneq-key (string ?a))) + (map-put alist noneq-key 3 'equal) (should-not (cddr alist)) - (map-put alist "a" 9) + (map-put alist noneq-key 9) (should (cddr alist)))) (ert-deftest test-map-put-return-value () commit 4b7f822cd53a50e83008ab4f561563d8977a74ec Author: Toby S. Cubitt Date: Fri Aug 4 20:34:28 2017 +0100 Implement iterator generator for avl-trees. * lisp/emacs-lisp/avl-tree.el (avl-tree-iter): New iter-defun. diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el index 17f1ffa9f6..32f7d2c6d8 100644 --- a/lisp/emacs-lisp/avl-tree.el +++ b/lisp/emacs-lisp/avl-tree.el @@ -52,7 +52,7 @@ ;;; Code: (eval-when-compile (require 'cl-lib)) - +(require 'generator) ;; ================================================================ @@ -670,6 +670,21 @@ a null element stored in the AVL tree.)" (null (avl-tree--stack-store avl-tree-stack))) +(iter-defun avl-tree-iter (tree &optional reverse) + "Return an AVL tree iterator object. + +Calling `iter-next' on this object will retrieve the next element +from TREE. If REVERSE is non-nil, elements are returned in +reverse order. + +Note that any modification to TREE *immediately* invalidates all +iterators created from TREE before the modification (in +particular, calling `iter-next' will give unpredictable results)." + (let ((stack (avl-tree-stack tree reverse))) + (while (not (avl-tree-stack-empty-p stack)) + (iter-yield (avl-tree-stack-pop stack))))) + + (provide 'avl-tree) ;;; avl-tree.el ends here commit 929c60603ca19574159c78f12f5f953c31188bc6 Author: Tino Calancha Date: Sat Aug 5 00:53:48 2017 +0900 ls-lisp: Drop eshell dependencies Use 'file-expand-wildcards' instead of 'eshell-extended-glob' to expand the wildcards. Suggested by Fabrice Popineau in: https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00108.html * lisp/ls-lisp.el (ls-lisp--dired): Use file-expand-wildcards. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 9a4fc19744..9a81ef07ad 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -479,14 +479,6 @@ not contain `d', so that a full listing is expected." (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! -;; We cannot require 'em-glob' in the top of the file: -;; ls-lisp is compiled before than eshell, and esh-groups.el -;; wouldn't be created yet. If we require 'em-glob' inside -;; `ls-lisp--dired', then this function cannot be called -;; before eshell is compiled. -;; So instead we add an autoload call here. -;; (https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg01083.html). -(autoload 'eshell-extended-glob "em-glob") (declare-function dired-read-dir-and-switches "dired" (str)) (declare-function dired-goto-next-file "dired" ()) @@ -499,7 +491,7 @@ not contain `d', so that a full listing is expected." (if (not dir-wildcard) (funcall orig-fun dir-or-list switches) (let* ((default-directory (car dir-wildcard)) - (files (eshell-extended-glob (cdr dir-wildcard))) + (files (file-expand-wildcards (cdr dir-wildcard))) (dir (car dir-wildcard))) (if files (let ((inhibit-read-only t) commit d32d8d0ceaa05939bbf56a246707aed05a53385c Author: Eli Zaretskii Date: Fri Aug 4 16:44:02 2017 +0300 ; Improve commentary of Info-default-directory-list * lisp/info.el (Info-default-directory-list): Describe in the commentary when it is initialized. (Bug#27933) diff --git a/lisp/info.el b/lisp/info.el index a2071533d8..c7f0bbf08d 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -171,7 +171,11 @@ A header-line does not scroll with the rest of the buffer." ;; defvar and explicitly give it a standard-value property, and ;; call custom-initialize-delay on it. ;; The progn forces the autoloader to include the whole thing, not -;; just an abbreviated version. +;; just an abbreviated version. The value is initialized at startup +;; time, when command-line calls custom-reevaluate-setting on all +;; the defcustoms in custom-delayed-init-variables. This is +;; somewhat sub-optimal, as ideally this should be done when Info +;; mode is first invoked. ;;;###autoload (progn (defcustom Info-default-directory-list commit 5ae7dda5603c0191d62862b6c347b830f822af48 Author: Tino Calancha Date: Fri Aug 4 22:35:29 2017 +0900 Fix dired-test-bug27631 on MS-Windows Skip the test if Dired use 'ls' emulation with lisp. The same bug is tested in their respective test suites: ls-lisp-tests.el and em-ls-tests.el. * test/lisp/dired-tests.el (dired-test-bug27631): Skip test if 'ls-lisp' or 'eshell' features are enabled. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 02dbf263b9..b14bbc6360 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -271,6 +271,10 @@ (ert-deftest dired-test-bug27631 () "Test for http://debbugs.gnu.org/27631 ." + ;; For dired using 'ls' emulation we test for this bug in + ;; ls-lisp-tests.el and em-ls-tests.el. + (skip-unless (and (not (featurep 'ls-lisp)) + (not (featurep 'eshell)))) (let* ((dir (make-temp-file "bug27631" 'dir)) (dir1 (expand-file-name "dir1" dir)) (dir2 (expand-file-name "dir2" dir)) commit bc6ab63653fe2c07743ab4c6d864a4975bbf55ec Author: Eli Zaretskii Date: Fri Aug 4 16:10:06 2017 +0300 Fix dired-test-bug25609 on MS-Windows * test/lisp/dired-tests.el (dired-test-bug25609): On MS-Windows, pass temporary files through file-truename, to avoid bogus failures due to file-name comparison as strings. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 79333705c5..02dbf263b9 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -58,7 +58,16 @@ (ert-deftest dired-test-bug25609 () "Test for http://debbugs.gnu.org/25609 ." (let* ((from (make-temp-file "foo" 'dir)) + ;; Make sure we have long file-names in 'from' and 'to', not + ;; their 8+3 short aliases, because the latter will confuse + ;; Dired commands invoked below. + (from (if (memq system-type '(ms-dos windows-nt)) + (file-truename from) + from)) (to (make-temp-file "bar" 'dir)) + (to (if (memq system-type '(ms-dos windows-nt)) + (file-truename to) + to)) (target (expand-file-name (file-name-nondirectory from) to)) (nested (expand-file-name (file-name-nondirectory from) target)) (dired-dwim-target t) commit db5d38ddb0de83d8f920b7a128fe3fd5156fdf85 Author: Tino Calancha Date: Fri Aug 4 14:15:51 2017 +0900 Fix 2 tests that fail in MS-Windows https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00018.html * test/lisp/vc/ediff-ptch-tests.el (ediff-ptch-test-bug26084): Add comments to explain the test logic. Pass '--binary' option to 'patch' program in windows environments. Check explicitely that a backup is created before compare file contents. * test/lisp/dired-tests.el (dired-test-bug25609): Declare variable 'dired-dwim-target' right before the test. Add comments to explain the test logic. Ensure, before test the bug condition, that we are displaying the 2 dired buffers created in this test, and no other dired buffer is shown. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 1ae47a92f8..79333705c5 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -54,6 +54,7 @@ (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory dir 'recursive)))) +(defvar dired-dwim-target) (ert-deftest dired-test-bug25609 () "Test for http://debbugs.gnu.org/25609 ." (let* ((from (make-temp-file "foo" 'dir)) @@ -67,20 +68,30 @@ :override (lambda (_sym _prompt &rest _args) (setq dired-query t)) '((name . "advice-dired-query"))) - (advice-add 'completing-read ; Just return init. + (advice-add 'completing-read ; Don't prompt me: just return init. :override (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) init) '((name . "advice-completing-read"))) + (delete-other-windows) ; We don't want to display any other dired buffers. (push (dired to) buffers) (push (dired-other-window temporary-file-directory) buffers) - (dired-goto-file from) - (dired-do-copy) - (dired-do-copy); Again. (unwind-protect - (progn - (should (file-exists-p target)) - (should-not (file-exists-p nested))) + (let ((ok-fn + (lambda () + (let ((win-buffers (mapcar #'window-buffer (window-list)))) + (and (memq (car buffers) win-buffers) + (memq (cadr buffers) win-buffers)))))) + (dired-goto-file from) + ;; Right before `dired-do-copy' call, to reproduce the bug conditions, + ;; ensure we have windows displaying the two dired buffers. + (and (funcall ok-fn) (dired-do-copy)) + ;; Call `dired-do-copy' again: this must overwrite `target'; if the bug + ;; still exists, then it creates `nested' instead. + (when (funcall ok-fn) + (dired-do-copy) + (should (file-exists-p target)) + (should-not (file-exists-p nested)))) (dolist (buf buffers) (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory from 'recursive) diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el index 387786ced0..6fbc1b0a8b 100644 --- a/test/lisp/vc/ediff-ptch-tests.el +++ b/test/lisp/vc/ediff-ptch-tests.el @@ -66,41 +66,55 @@ index 6a07f80..6e8e947 100644 (write-region nil nil bar nil 'silent)) (call-process git-program nil `(:file ,patch) nil "diff") (call-process git-program nil nil nil "reset" "--hard" "HEAD") + ;; Visit the diff file i.e., patch; extract from it the parts + ;; affecting just each of the files: store in patch-bar the part + ;; affecting 'bar', and in patch-qux the part affecting 'qux'. (find-file patch) (unwind-protect (let* ((info (progn (ediff-map-patch-buffer (current-buffer)) ediff-patch-map)) - (patch1 + (patch-bar (buffer-substring-no-properties (car (nth 3 (car info))) (car (nth 4 (car info))))) - (patch2 + (patch-qux (buffer-substring-no-properties (car (nth 3 (cadr info))) (car (nth 4 (cadr info)))))) ;; Apply both patches. - (dolist (x (list (cons patch1 bar) (cons patch2 qux))) + (dolist (x (list (cons patch-bar bar) (cons patch-qux qux))) (with-temp-buffer - (insert (car x)) - (call-process-region (point-min) - (point-max) - ediff-patch-program - nil nil nil - "-b" (cdr x)))) - ;; Check backup files were saved correctly. + ;; Some windows variants require the option '--binary' + ;; in order to 'patch' create backup files. + (let ((opts (format "--backup%s" + (if (memq system-type '(windows-nt ms-dos)) + " --binary" "")))) + (insert (car x)) + (call-process-region (point-min) + (point-max) + ediff-patch-program + nil nil nil + opts (cdr x))))) + ;; Check backup files were saved correctly; in Bug#26084 some + ;; of the backup files are overwritten with the actual content + ;; of the updated file. To ensure that the bug is fixed we just + ;; need to check that every backup file produced has different + ;; content that the current updated file. (dolist (x (list qux bar)) (let ((backup (car (directory-files tmpdir 'full (concat (file-name-nondirectory x) "."))))) - (should-not - (string= (with-temp-buffer - (insert-file-contents x) - (buffer-string)) - (with-temp-buffer - (insert-file-contents backup) - (buffer-string)))))) + ;; Compare files only if the backup has being created. + (when backup + (should-not + (string= (with-temp-buffer + (insert-file-contents x) + (buffer-string)) + (with-temp-buffer + (insert-file-contents backup) + (buffer-string))))))) (delete-directory tmpdir 'recursive) (delete-file patch))))) commit 28e000435e1dfdc071cd4b68afe8514dcf9b3aa2 Author: Stefan Monnier Date: Fri Aug 4 00:05:00 2017 -0400 * lisp/shell.el (explicit-shell-file-name): Mention shell-file-name * lisp/files.el (insert-directory): Don't hardcode "-c". * lisp/term.el (term, ansi-term): Use shell-file-name. diff --git a/lisp/files.el b/lisp/files.el index 96647fb262..89f6f9f44d 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6701,7 +6701,7 @@ normally equivalent short `-D' option is just passed on to ;; See eg dired-safe-switches-p. (call-process shell-file-name nil t nil - "-c" + shell-command-switch (concat (if (memq system-type '(ms-dos windows-nt)) "" "\\") ; Disregard Unix shell aliases! diff --git a/lisp/shell.el b/lisp/shell.el index c5e5cbbee7..ea7f0beebb 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -264,7 +264,9 @@ see the function `dirtrack-mode'." :group 'shell-directories) (defcustom explicit-shell-file-name nil - "If non-nil, is file name to use for explicitly requested inferior shell." + "If non-nil, is file name to use for explicitly requested inferior shell. +When nil, such interactive shell sessions fallback to using either +the shell specified in $ESHELL or in `shell-file-name'." :type '(choice (const :tag "None" nil) file) :group 'shell) diff --git a/lisp/term.el b/lisp/term.el index 063a6ea592..5eb7b3e8ed 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1354,8 +1354,7 @@ commands to use in that buffer. (interactive (list (read-from-minibuffer "Run program: " (or explicit-shell-file-name (getenv "ESHELL") - (getenv "SHELL") - "/bin/sh")))) + shell-file-name)))) (set-buffer (make-term "terminal" program)) (term-mode) (term-char-mode) @@ -4149,8 +4148,7 @@ the process. Any more args are arguments to PROGRAM." (interactive (list (read-from-minibuffer "Run program: " (or explicit-shell-file-name (getenv "ESHELL") - (getenv "SHELL") - "/bin/sh")))) + shell-file-name)))) ;; Pick the name of the new buffer. (setq term-ansi-buffer-name commit e8ca0c5e16a6887691ee3db739abfdba25e0d578 Author: Paul Eggert Date: Thu Aug 3 17:57:24 2017 -0700 Fix version numbers for some GnuTLS features Problem reported by Glenn Morris (Bug#27708#58). * src/gnutls.c (HAVE_GNUTLS_X509_SYSTEM_TRUST): New macro. Use it instead of low-level version number checks. (HAVE_GNUTLS_AEAD): Move here from gnutls.h, and rename from HAVE_GNUTLS3_AEAD. All uses changed. Indent preprocessor lines. * src/gnutls.h (HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_DIGEST) (HAVE_GNUTLS3_HMAC): Remove, since these were available before GnuTLS 3.0.0 and the code checks them only if HAVE_GNUTLS3 is defined. Remove all uses; this simplifies the code a bit. diff --git a/src/gnutls.c b/src/gnutls.c index 59694074e1..188f995979 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -26,22 +26,36 @@ along with GNU Emacs. If not, see . */ #include "coding.h" #include "buffer.h" -#ifdef HAVE_GNUTLS +#if 0x030014 <= GNUTLS_VERSION_NUMBER +# define HAVE_GNUTLS_X509_SYSTEM_TRUST +#endif -#ifdef WINDOWSNT -#include -#include "w32.h" +/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, + it was broken through at least GnuTLS 3.4.10; see: + https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00992.html + The relevant fix seems to have been made in GnuTLS 3.5.1; see: + https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d + So, require 3.5.1. */ +#if 0x030501 <= GNUTLS_VERSION_NUMBER +# define HAVE_GNUTLS_AEAD #endif +#ifdef HAVE_GNUTLS + +# ifdef WINDOWSNT +# include +# include "w32.h" +# endif + static bool emacs_gnutls_handle_error (gnutls_session_t, int); static bool gnutls_global_initialized; static void gnutls_log_function (int, const char *); static void gnutls_log_function2 (int, const char *, const char *); -#ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 static void gnutls_audit_log_function (gnutls_session_t, const char *); -#endif +# endif enum extra_peer_verification { @@ -49,7 +63,7 @@ enum extra_peer_verification }; -#ifdef WINDOWSNT +# ifdef WINDOWSNT DEF_DLL_FN (gnutls_alert_description_t, gnutls_alert_get, (gnutls_session_t)); @@ -74,12 +88,10 @@ DEF_DLL_FN (int, gnutls_certificate_set_x509_crl_file, DEF_DLL_FN (int, gnutls_certificate_set_x509_key_file, (gnutls_certificate_credentials_t, const char *, const char *, gnutls_x509_crt_fmt_t)); -# if ((GNUTLS_VERSION_MAJOR \ - + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \ - > 3) +# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST DEF_DLL_FN (int, gnutls_certificate_set_x509_system_trust, (gnutls_certificate_credentials_t)); -# endif +# endif DEF_DLL_FN (int, gnutls_certificate_set_x509_trust_file, (gnutls_certificate_credentials_t, const char *, gnutls_x509_crt_fmt_t)); @@ -96,9 +108,9 @@ DEF_DLL_FN (int, gnutls_dh_get_prime_bits, (gnutls_session_t)); DEF_DLL_FN (int, gnutls_error_is_fatal, (int)); DEF_DLL_FN (int, gnutls_global_init, (void)); DEF_DLL_FN (void, gnutls_global_set_log_function, (gnutls_log_func)); -# ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 DEF_DLL_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func)); -# endif +# endif DEF_DLL_FN (void, gnutls_global_set_log_level, (int)); DEF_DLL_FN (int, gnutls_handshake, (gnutls_session_t)); DEF_DLL_FN (int, gnutls_init, (gnutls_session_t *, unsigned int)); @@ -172,14 +184,13 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); -# ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); -# ifdef HAVE_GNUTLS3_CIPHER DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); @@ -194,7 +205,7 @@ DEF_DLL_FN (int, gnutls_cipher_encrypt2, DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); DEF_DLL_FN (int, gnutls_cipher_decrypt2, (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); -# ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS_AEAD DEF_DLL_FN (int, gnutls_aead_cipher_init, (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *)); @@ -205,25 +216,20 @@ DEF_DLL_FN (int, gnutls_aead_cipher_encrypt, DEF_DLL_FN (int, gnutls_aead_cipher_decrypt, (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, size_t, size_t, const void *, size_t, void *, size_t *)); -# endif /* HAVE_GNUTLS3_AEAD */ -# ifdef HAVE_GNUTLS3_HMAC +# endif DEF_DLL_FN (int, gnutls_hmac_init, (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *)); -# endif /* HAVE_GNUTLS3_HMAC */ -# endif /* HAVE_GNUTLS3_CIPHER */ -# ifdef HAVE_GNUTLS3_DIGEST DEF_DLL_FN (int, gnutls_hash_init, (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); -# endif /* HAVE_GNUTLS3_DIGEST */ -# endif /* HAVE_GNUTLS3 */ +# endif /* HAVE_GNUTLS3 */ static bool @@ -249,11 +255,9 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_certificate_set_verify_flags); LOAD_DLL_FN (library, gnutls_certificate_set_x509_crl_file); LOAD_DLL_FN (library, gnutls_certificate_set_x509_key_file); -# if ((GNUTLS_VERSION_MAJOR \ - + (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20)) \ - > 3) +# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST LOAD_DLL_FN (library, gnutls_certificate_set_x509_system_trust); -# endif +# endif LOAD_DLL_FN (library, gnutls_certificate_set_x509_trust_file); LOAD_DLL_FN (library, gnutls_certificate_type_get); LOAD_DLL_FN (library, gnutls_certificate_verify_peers2); @@ -264,9 +268,9 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_error_is_fatal); LOAD_DLL_FN (library, gnutls_global_init); LOAD_DLL_FN (library, gnutls_global_set_log_function); -# ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 LOAD_DLL_FN (library, gnutls_global_set_audit_log_function); -# endif +# endif LOAD_DLL_FN (library, gnutls_global_set_log_level); LOAD_DLL_FN (library, gnutls_handshake); LOAD_DLL_FN (library, gnutls_init); @@ -309,14 +313,13 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_get_name); LOAD_DLL_FN (library, gnutls_mac_get); LOAD_DLL_FN (library, gnutls_mac_get_name); -# ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 LOAD_DLL_FN (library, gnutls_rnd); LOAD_DLL_FN (library, gnutls_mac_list); LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); LOAD_DLL_FN (library, gnutls_mac_get_key_size); LOAD_DLL_FN (library, gnutls_digest_list); LOAD_DLL_FN (library, gnutls_digest_get_name); -# ifdef HAVE_GNUTLS3_CIPHER LOAD_DLL_FN (library, gnutls_cipher_list); LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); LOAD_DLL_FN (library, gnutls_cipher_get_key_size); @@ -327,28 +330,23 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_encrypt2); LOAD_DLL_FN (library, gnutls_cipher_deinit); LOAD_DLL_FN (library, gnutls_cipher_decrypt2); -# ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS_AEAD LOAD_DLL_FN (library, gnutls_aead_cipher_init); LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); # endif -# ifdef HAVE_GNUTLS3_HMAC LOAD_DLL_FN (library, gnutls_hmac_init); LOAD_DLL_FN (library, gnutls_hmac_get_len); LOAD_DLL_FN (library, gnutls_hmac); LOAD_DLL_FN (library, gnutls_hmac_deinit); LOAD_DLL_FN (library, gnutls_hmac_output); -# endif /* HAVE_GNUTLS3_HMAC */ -# endif /* HAVE_GNUTLS3_CIPHER */ -# ifdef HAVE_GNUTLS3_DIGEST LOAD_DLL_FN (library, gnutls_hash_init); LOAD_DLL_FN (library, gnutls_hash_get_len); LOAD_DLL_FN (library, gnutls_hash); LOAD_DLL_FN (library, gnutls_hash_deinit); LOAD_DLL_FN (library, gnutls_hash_output); -# endif -# endif /* HAVE_GNUTLS3 */ +# endif /* HAVE_GNUTLS3 */ max_log_level = global_gnutls_log_level; @@ -361,111 +359,105 @@ init_gnutls_functions (void) return 1; } -# define gnutls_alert_get fn_gnutls_alert_get -# define gnutls_alert_get_name fn_gnutls_alert_get_name -# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials -# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials -# define gnutls_bye fn_gnutls_bye -# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials -# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials -# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers -# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags -# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file -# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file -# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust -# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file -# define gnutls_certificate_type_get fn_gnutls_certificate_type_get -# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2 -# define gnutls_cipher_get fn_gnutls_cipher_get -# define gnutls_cipher_get_name fn_gnutls_cipher_get_name -# define gnutls_credentials_set fn_gnutls_credentials_set -# define gnutls_deinit fn_gnutls_deinit -# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits -# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits -# define gnutls_error_is_fatal fn_gnutls_error_is_fatal -# define gnutls_global_init fn_gnutls_global_init -# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function -# define gnutls_global_set_log_function fn_gnutls_global_set_log_function -# define gnutls_global_set_log_level fn_gnutls_global_set_log_level -# define gnutls_handshake fn_gnutls_handshake -# define gnutls_init fn_gnutls_init -# define gnutls_kx_get fn_gnutls_kx_get -# define gnutls_kx_get_name fn_gnutls_kx_get_name -# define gnutls_mac_get fn_gnutls_mac_get -# define gnutls_mac_get_name fn_gnutls_mac_get_name -# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name -# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param -# define gnutls_priority_set_direct fn_gnutls_priority_set_direct -# define gnutls_protocol_get_name fn_gnutls_protocol_get_name -# define gnutls_protocol_get_version fn_gnutls_protocol_get_version -# define gnutls_record_check_pending fn_gnutls_record_check_pending -# define gnutls_record_recv fn_gnutls_record_recv -# define gnutls_record_send fn_gnutls_record_send -# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name -# define gnutls_server_name_set fn_gnutls_server_name_set -# define gnutls_sign_get_name fn_gnutls_sign_get_name -# define gnutls_strerror fn_gnutls_strerror -# define gnutls_transport_set_errno fn_gnutls_transport_set_errno -# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2 -# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function -# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function -# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname -# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer -# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit -# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time -# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn -# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time -# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint -# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn -# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id -# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id -# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm -# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial -# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm -# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id -# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version -# define gnutls_x509_crt_import fn_gnutls_x509_crt_import -# define gnutls_x509_crt_init fn_gnutls_x509_crt_init -# ifdef HAVE_GNUTLS3 -# define gnutls_rnd fn_gnutls_rnd -# define gnutls_mac_list fn_gnutls_mac_list -# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size -# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# define gnutls_digest_list fn_gnutls_digest_list -# define gnutls_digest_get_name fn_gnutls_digest_get_name -# ifdef HAVE_GNUTLS3_CIPHER -# define gnutls_cipher_list fn_gnutls_cipher_list -# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size -# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size -# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size -# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size -# define gnutls_cipher_init fn_gnutls_cipher_init -# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv -# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 -# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 -# define gnutls_cipher_deinit fn_gnutls_cipher_deinit -# ifdef HAVE_GNUTLS3_AEAD -# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt -# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt -# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init -# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit -# endif /* HAVE_GNUTLS3_AEAD */ -# ifdef HAVE_GNUTLS3_HMAC -# define gnutls_hmac_init fn_gnutls_hmac_init -# define gnutls_hmac_get_len fn_gnutls_hmac_get_len -# define gnutls_hmac fn_gnutls_hmac -# define gnutls_hmac_deinit fn_gnutls_hmac_deinit -# define gnutls_hmac_output fn_gnutls_hmac_output -# endif /* HAVE_GNUTLS3_HMAC */ -# endif /* HAVE_GNUTLS3_CIPHER */ -# ifdef HAVE_GNUTLS3_DIGEST -# define gnutls_hash_init fn_gnutls_hash_init -# define gnutls_hash_get_len fn_gnutls_hash_get_len -# define gnutls_hash fn_gnutls_hash -# define gnutls_hash_deinit fn_gnutls_hash_deinit -# define gnutls_hash_output fn_gnutls_hash_output -# endif -# endif /* HAVE_GNUTLS3 */ +# define gnutls_alert_get fn_gnutls_alert_get +# define gnutls_alert_get_name fn_gnutls_alert_get_name +# define gnutls_anon_allocate_client_credentials fn_gnutls_anon_allocate_client_credentials +# define gnutls_anon_free_client_credentials fn_gnutls_anon_free_client_credentials +# define gnutls_bye fn_gnutls_bye +# define gnutls_certificate_allocate_credentials fn_gnutls_certificate_allocate_credentials +# define gnutls_certificate_free_credentials fn_gnutls_certificate_free_credentials +# define gnutls_certificate_get_peers fn_gnutls_certificate_get_peers +# define gnutls_certificate_set_verify_flags fn_gnutls_certificate_set_verify_flags +# define gnutls_certificate_set_x509_crl_file fn_gnutls_certificate_set_x509_crl_file +# define gnutls_certificate_set_x509_key_file fn_gnutls_certificate_set_x509_key_file +# define gnutls_certificate_set_x509_system_trust fn_gnutls_certificate_set_x509_system_trust +# define gnutls_certificate_set_x509_trust_file fn_gnutls_certificate_set_x509_trust_file +# define gnutls_certificate_type_get fn_gnutls_certificate_type_get +# define gnutls_certificate_verify_peers2 fn_gnutls_certificate_verify_peers2 +# define gnutls_cipher_get fn_gnutls_cipher_get +# define gnutls_cipher_get_name fn_gnutls_cipher_get_name +# define gnutls_credentials_set fn_gnutls_credentials_set +# define gnutls_deinit fn_gnutls_deinit +# define gnutls_dh_get_prime_bits fn_gnutls_dh_get_prime_bits +# define gnutls_dh_set_prime_bits fn_gnutls_dh_set_prime_bits +# define gnutls_error_is_fatal fn_gnutls_error_is_fatal +# define gnutls_global_init fn_gnutls_global_init +# define gnutls_global_set_audit_log_function fn_gnutls_global_set_audit_log_function +# define gnutls_global_set_log_function fn_gnutls_global_set_log_function +# define gnutls_global_set_log_level fn_gnutls_global_set_log_level +# define gnutls_handshake fn_gnutls_handshake +# define gnutls_init fn_gnutls_init +# define gnutls_kx_get fn_gnutls_kx_get +# define gnutls_kx_get_name fn_gnutls_kx_get_name +# define gnutls_mac_get fn_gnutls_mac_get +# define gnutls_mac_get_name fn_gnutls_mac_get_name +# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name +# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param +# define gnutls_priority_set_direct fn_gnutls_priority_set_direct +# define gnutls_protocol_get_name fn_gnutls_protocol_get_name +# define gnutls_protocol_get_version fn_gnutls_protocol_get_version +# define gnutls_record_check_pending fn_gnutls_record_check_pending +# define gnutls_record_recv fn_gnutls_record_recv +# define gnutls_record_send fn_gnutls_record_send +# define gnutls_sec_param_get_name fn_gnutls_sec_param_get_name +# define gnutls_server_name_set fn_gnutls_server_name_set +# define gnutls_sign_get_name fn_gnutls_sign_get_name +# define gnutls_strerror fn_gnutls_strerror +# define gnutls_transport_set_errno fn_gnutls_transport_set_errno +# define gnutls_transport_set_ptr2 fn_gnutls_transport_set_ptr2 +# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function +# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function +# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname +# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer +# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit +# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time +# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn +# define gnutls_x509_crt_get_expiration_time fn_gnutls_x509_crt_get_expiration_time +# define gnutls_x509_crt_get_fingerprint fn_gnutls_x509_crt_get_fingerprint +# define gnutls_x509_crt_get_issuer_dn fn_gnutls_x509_crt_get_issuer_dn +# define gnutls_x509_crt_get_issuer_unique_id fn_gnutls_x509_crt_get_issuer_unique_id +# define gnutls_x509_crt_get_key_id fn_gnutls_x509_crt_get_key_id +# define gnutls_x509_crt_get_pk_algorithm fn_gnutls_x509_crt_get_pk_algorithm +# define gnutls_x509_crt_get_serial fn_gnutls_x509_crt_get_serial +# define gnutls_x509_crt_get_signature_algorithm fn_gnutls_x509_crt_get_signature_algorithm +# define gnutls_x509_crt_get_subject_unique_id fn_gnutls_x509_crt_get_subject_unique_id +# define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version +# define gnutls_x509_crt_import fn_gnutls_x509_crt_import +# define gnutls_x509_crt_init fn_gnutls_x509_crt_init +# ifdef HAVE_GNUTLS3 +# define gnutls_rnd fn_gnutls_rnd +# define gnutls_mac_list fn_gnutls_mac_list +# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size +# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size +# define gnutls_digest_list fn_gnutls_digest_list +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# define gnutls_cipher_list fn_gnutls_cipher_list +# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size +# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size +# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size +# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size +# define gnutls_cipher_init fn_gnutls_cipher_init +# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv +# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 +# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 +# define gnutls_cipher_deinit fn_gnutls_cipher_deinit +# ifdef HAVE_GNUTLS_AEAD +# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt +# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt +# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init +# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit +# endif +# define gnutls_hmac_init fn_gnutls_hmac_init +# define gnutls_hmac_get_len fn_gnutls_hmac_get_len +# define gnutls_hmac fn_gnutls_hmac +# define gnutls_hmac_deinit fn_gnutls_hmac_deinit +# define gnutls_hmac_output fn_gnutls_hmac_output +# define gnutls_hash_init fn_gnutls_hash_init +# define gnutls_hash_get_len fn_gnutls_hash_get_len +# define gnutls_hash fn_gnutls_hash +# define gnutls_hash_deinit fn_gnutls_hash_deinit +# define gnutls_hash_output fn_gnutls_hash_output +# endif /* HAVE_GNUTLS3 */ /* This wrapper is called from fns.c, which doesn't know about the LOAD_DLL_FN stuff above. */ @@ -475,7 +467,7 @@ w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len) return gnutls_rnd (level, data, len); } -#endif /* WINDOWSNT */ +# endif /* WINDOWSNT */ /* Report memory exhaustion if ERR is an out-of-memory indication. */ @@ -489,7 +481,7 @@ check_memory_full (int err) memory_full (0); } -#ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 /* Log a simple audit message. */ static void gnutls_audit_log_function (gnutls_session_t session, const char *string) @@ -499,7 +491,7 @@ gnutls_audit_log_function (gnutls_session_t session, const char *string) message ("gnutls.c: [audit] %s", string); } } -#endif +# endif /* Log a simple message. */ static void @@ -552,7 +544,7 @@ gnutls_try_handshake (struct Lisp_Process *proc) return ret; } -#ifndef WINDOWSNT +# ifndef WINDOWSNT static int emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) { @@ -560,13 +552,13 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) switch (err) { -# ifdef _AIX +# ifdef _AIX /* This is taken from the GnuTLS system_errno function circa 2016; see . */ case 0: errno = EAGAIN; /* Fall through. */ -# endif +# endif case EINPROGRESS: case ENOTCONN: return EAGAIN; @@ -575,7 +567,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) return err; } } -#endif /* !WINDOWSNT */ +# endif /* !WINDOWSNT */ static int emacs_gnutls_handshake (struct Lisp_Process *proc) @@ -587,7 +579,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) { -#ifdef WINDOWSNT +# ifdef WINDOWSNT /* On W32 we cannot transfer socket handles between different runtime libraries, so we tell GnuTLS to use our special push/pull functions. */ @@ -596,7 +588,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) (gnutls_transport_ptr_t) proc); gnutls_transport_set_push_function (state, &emacs_gnutls_push); gnutls_transport_set_pull_function (state, &emacs_gnutls_pull); -#else +# else /* This is how GnuTLS takes sockets: as file descriptors passed in. For an Emacs process socket, infd and outfd are the same but we use this two-argument version for clarity. */ @@ -606,7 +598,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) if (proc->is_non_blocking_client) gnutls_transport_set_errno_function (state, emacs_gnutls_nonblock_errno); -#endif +# endif proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET; } @@ -620,13 +612,13 @@ emacs_gnutls_record_check_pending (gnutls_session_t state) return gnutls_record_check_pending (state); } -#ifdef WINDOWSNT +# ifdef WINDOWSNT void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err) { gnutls_transport_set_errno (state, err); } -#endif +# endif ptrdiff_t emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte) @@ -732,10 +724,10 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) /* Mostly ignore "The TLS connection was non-properly terminated" message which just means that the peer closed the connection. */ -#ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 if (err == GNUTLS_E_PREMATURE_TERMINATION) level = 3; -#endif +# endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); ret = false; @@ -1300,7 +1292,7 @@ gnutls_ip_address_p (char *string) return true; } -#if 0 +# if 0 /* Deinitialize global GnuTLS state. See also `gnutls-global-init'. */ static Lisp_Object @@ -1313,7 +1305,7 @@ emacs_gnutls_global_deinit (void) return gnutls_make_error (GNUTLS_E_SUCCESS); } -#endif +# endif static void ATTRIBUTE_FORMAT_PRINTF (2, 3) boot_error (struct Lisp_Process *p, const char *m, ...) @@ -1585,9 +1577,9 @@ one trustfile (usually a CA bundle). */) if (TYPE_RANGED_INTEGERP (int, loglevel)) { gnutls_global_set_log_function (gnutls_log_function); -#ifdef HAVE_GNUTLS3 +# ifdef HAVE_GNUTLS3 gnutls_global_set_audit_log_function (gnutls_audit_log_function); -#endif +# endif gnutls_global_set_log_level (XINT (loglevel)); max_log_level = XINT (loglevel); XPROCESS (proc)->gnutls_log_level = max_log_level; @@ -1649,8 +1641,7 @@ one trustfile (usually a CA bundle). */) int file_format = GNUTLS_X509_FMT_PEM; Lisp_Object tail; -#if GNUTLS_VERSION_MAJOR + \ - (GNUTLS_VERSION_MINOR > 0 || GNUTLS_VERSION_PATCH >= 20) > 3 +# ifdef HAVE_GNUTLS_X509_SYSTEM_TRUST ret = gnutls_certificate_set_x509_system_trust (x509_cred); if (ret < GNUTLS_E_SUCCESS) { @@ -1658,7 +1649,7 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG2i (4, max_log_level, "setting system trust failed with code ", ret); } -#endif +# endif for (tail = trustfiles; CONSP (tail); tail = XCDR (tail)) { @@ -1668,12 +1659,12 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ", SSDATA (trustfile)); trustfile = ENCODE_FILE (trustfile); -#ifdef WINDOWSNT +# ifdef WINDOWSNT /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded file names on Windows, we need to re-encode the file name using the current ANSI codepage. */ trustfile = ansi_encode_filename (trustfile); -#endif +# endif ret = gnutls_certificate_set_x509_trust_file (x509_cred, SSDATA (trustfile), @@ -1698,9 +1689,9 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ", SSDATA (crlfile)); crlfile = ENCODE_FILE (crlfile); -#ifdef WINDOWSNT +# ifdef WINDOWSNT crlfile = ansi_encode_filename (crlfile); -#endif +# endif ret = gnutls_certificate_set_x509_crl_file (x509_cred, SSDATA (crlfile), file_format); @@ -1727,10 +1718,10 @@ one trustfile (usually a CA bundle). */) SSDATA (certfile)); keyfile = ENCODE_FILE (keyfile); certfile = ENCODE_FILE (certfile); -#ifdef WINDOWSNT +# ifdef WINDOWSNT keyfile = ansi_encode_filename (keyfile); certfile = ansi_encode_filename (certfile); -#endif +# endif ret = gnutls_certificate_set_x509_key_file (x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format); @@ -1755,10 +1746,10 @@ one trustfile (usually a CA bundle). */) GNUTLS_LOG (1, max_log_level, "gnutls_init"); int gnutls_flags = GNUTLS_CLIENT; -#ifdef GNUTLS_NONBLOCK +# ifdef GNUTLS_NONBLOCK if (XPROCESS (proc)->is_non_blocking_client) gnutls_flags |= GNUTLS_NONBLOCK; -#endif +# endif ret = gnutls_init (&state, gnutls_flags); XPROCESS (proc)->gnutls_state = state; if (ret < GNUTLS_E_SUCCESS) @@ -1852,7 +1843,6 @@ The alist key is the cipher name. */) { Lisp_Object ciphers = Qnil; -#ifdef HAVE_GNUTLS3_CIPHER const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++) { @@ -1886,7 +1876,6 @@ The alist key is the cipher name. */) ciphers = Fcons (cp, ciphers); } -#endif return ciphers; } @@ -1899,7 +1888,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, const char *idata, ptrdiff_t isize, Lisp_Object aead_auth) { -#ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS_AEAD const char *desc = encrypting ? "encrypt" : "decrypt"; Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); @@ -1969,10 +1958,10 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, SAFE_FREE (); return list2 (output, actual_iv); -#else +# else printmax_t print_gca = gca; error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca); -#endif +# endif } static Lisp_Object @@ -2181,7 +2170,6 @@ name. */) (void) { Lisp_Object mac_algorithms = Qnil; -#ifdef HAVE_GNUTLS3_HMAC const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { @@ -2204,7 +2192,6 @@ name. */) make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); } -#endif return mac_algorithms; } @@ -2218,7 +2205,6 @@ method name. */) (void) { Lisp_Object digest_algorithms = Qnil; -#ifdef HAVE_GNUTLS3_DIGEST const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { @@ -2236,7 +2222,6 @@ method name. */) digest_algorithms = Fcons (mp, digest_algorithms); } -#endif return digest_algorithms; } @@ -2423,25 +2408,17 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) # ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); - -# ifdef HAVE_GNUTLS3_DIGEST capabilities = Fcons (intern("digests"), capabilities); -# endif - -# ifdef HAVE_GNUTLS3_CIPHER capabilities = Fcons (intern("ciphers"), capabilities); -# ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS_AEAD capabilities = Fcons (intern("AEAD-ciphers"), capabilities); -# endif +# endif -# ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); -# endif -# endif /* HAVE_GNUTLS3_CIPHER */ # endif /* HAVE_GNUTLS3 */ -#ifdef WINDOWSNT +# ifdef WINDOWSNT Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); if (CONSP (found)) return XCDR (found); @@ -2452,15 +2429,10 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); return status; } -#else /* !WINDOWSNT */ +# endif /* WINDOWSNT */ +#endif /* HAVE_GNUTLS */ return capabilities; - -#endif /* WINDOWSNT */ - -#else /* !HAVE_GNUTLS */ - return Qnil; -#endif /* HAVE_GNUTLS */ } void diff --git a/src/gnutls.h b/src/gnutls.h index 8fe4ac3e42..9323cd1aef 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -28,22 +28,6 @@ along with GNU Emacs. If not, see . */ # include #endif -#if 0x030400 <= GNUTLS_VERSION_NUMBER -# define HAVE_GNUTLS3_CIPHER -# define HAVE_GNUTLS3_DIGEST -# define HAVE_GNUTLS3_HMAC -#endif - -/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, - it was broken through at least GnuTLS 3.4.10; see: - https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00992.html - The relevant fix seems to have been made in GnuTLS 3.5.1; see: - https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d - So use 3.5.1 for now. */ -#if 0x030501 <= GNUTLS_VERSION_NUMBER -# define HAVE_GNUTLS3_AEAD -#endif - #include "lisp.h" /* This limits the attempts to handshake per process (connection). It commit ddc1ff58dec92a782b233d97a254fc41c1c887eb Author: Paul Eggert Date: Thu Aug 3 16:18:45 2017 -0700 Port recent rename changes to RHEL 7 + NFS Problem reported by Ted Zlatanov in: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00082.html * src/fileio.c (Frename_file): On RHEL 7 + NFS, renameat2 can fail with errno == EINVAL when it is not supported. So treat that case like errno == ENOSYS. Also, when ok_if_already_exists is neither nil nor an integer, just call plain rename; this avoids an extra syscall to renameat2 when the latter fails with errno == EINVAL or ENOSYS or ENOENT. diff --git a/src/fileio.c b/src/fileio.c index 0264c9fa1d..db760d9b22 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2344,23 +2344,38 @@ This is what happens in interactive use with M-x. */) encoded_file = ENCODE_FILE (file); encoded_newname = ENCODE_FILE (newname); - if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file), - AT_FDCWD, SSDATA (encoded_newname)) - == 0) - return Qnil; - int rename_errno = errno; + /* If the filesystem is case-insensitive and the file names are + identical but for the case, don't worry whether the destination + already exists: the caller simply wants to change the letter-case + of the file name. */ + bool plain_rename + = ((!NILP (ok_if_already_exists) && !INTEGERP (ok_if_already_exists)) + || (file_name_case_insensitive_p (SSDATA (encoded_file)) + && ! NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))); + + int rename_errno; + if (!plain_rename) + { + if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file), + AT_FDCWD, SSDATA (encoded_newname)) + == 0) + return Qnil; + + rename_errno = errno; + switch (rename_errno) + { + case EEXIST: case EINVAL: case ENOSYS: + barf_or_query_if_file_exists (newname, rename_errno == EEXIST, + "rename to it", + INTEGERP (ok_if_already_exists), + false); + plain_rename = true; + break; + } + } - if (rename_errno == EEXIST || rename_errno == ENOSYS) + if (plain_rename) { - /* If the filesystem is case-insensitive and the file names are - identical but for the case, don't ask for confirmation: they - simply want to change the letter-case of the file name. */ - if ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) - && (! file_name_case_insensitive_p (SSDATA (encoded_file)) - || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))) - barf_or_query_if_file_exists (newname, rename_errno == EEXIST, - "rename to it", - INTEGERP (ok_if_already_exists), false); if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0) return Qnil; rename_errno = errno; commit f465efe412607c6b931e3592e96200f2ff3b8d74 Author: Paul Eggert Date: Thu Aug 3 01:00:10 2017 -0700 Port GnuTLS usage to Ubuntu 16.04.2 LTS * src/gnutls.h (HAVE_GNUTLS3_AEAD): Define only if GnuTLS 3.5.1 or later, as opposed to the old 3.4.0 or later. diff --git a/src/gnutls.h b/src/gnutls.h index 19c16867d7..8fe4ac3e42 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -29,12 +29,21 @@ along with GNU Emacs. If not, see . */ #endif #if 0x030400 <= GNUTLS_VERSION_NUMBER -# define HAVE_GNUTLS3_AEAD # define HAVE_GNUTLS3_CIPHER # define HAVE_GNUTLS3_DIGEST # define HAVE_GNUTLS3_HMAC #endif +/* Although AEAD support started in GnuTLS 3.4.0 and works in 3.5.14, + it was broken through at least GnuTLS 3.4.10; see: + https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00992.html + The relevant fix seems to have been made in GnuTLS 3.5.1; see: + https://gitlab.com/gnutls/gnutls/commit/568935848dd6b82b9315d8b6c529d00e2605e03d + So use 3.5.1 for now. */ +#if 0x030501 <= GNUTLS_VERSION_NUMBER +# define HAVE_GNUTLS3_AEAD +#endif + #include "lisp.h" /* This limits the attempts to handshake per process (connection). It commit a8a81df8da1adad2d4feb22b1fd6aac0f7ca98d2 Author: Paul Eggert Date: Wed Aug 2 19:46:41 2017 -0700 Simplify configuration of HAVE_GNUTLS3 etc. There's only one GnuTLS, so configuring these symbols at 'configure' time is overkill. Simplify things by moving their configuration to src/gnutls.h (Bug#27708). * configure.ac (HAVE_GNUTLS3, HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD) (HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_DIGEST): Move these definitions from here ... * src/gnutls.h: ... to here, and simplify. diff --git a/configure.ac b/configure.ac index c9e8c0dd1c..9f80620a80 100644 --- a/configure.ac +++ b/configure.ac @@ -2840,89 +2840,6 @@ if test "${with_gnutls}" = "yes" ; then [HAVE_GNUTLS=yes], [HAVE_GNUTLS=no]) if test "${HAVE_GNUTLS}" = "yes"; then AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) - EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0], - [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], []) - - AC_CACHE_CHECK([for GnuTLS v3 with HMAC], [emacs_cv_gnutls3_hmac], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ - #include - #include - ]], [[ - int - main (void) - { - gnutls_hmac_hd_t handle; - gnutls_hmac_deinit (handle, NULL); - } - ]])], - [emacs_cv_gnutls3_hmac=yes], - [emacs_cv_gnutls3_hmac=no])]) - if test "$emacs_cv_gnutls3_hmac" = yes; then - AC_DEFINE([HAVE_GNUTLS3_HMAC], [1], - [Define if using GnuTLS v3 with HMAC support.]) - fi - - AC_CACHE_CHECK([for GnuTLS v3 with AEAD], [emacs_cv_gnutls3_aead], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ - #include - #include - ]], [[ - int - main (void) - { - gnutls_aead_cipher_hd_t handle; - gnutls_aead_cipher_deinit (handle); - } - ]])], - [emacs_cv_gnutls3_aead=yes], - [emacs_cv_gnutls3_aead=no])]) - if test "$emacs_cv_gnutls3_aead" = yes; then - AC_DEFINE([HAVE_GNUTLS3_AEAD], [1], - [Define if using GnuTLS v3 with AEAD support.]) - fi - - AC_CACHE_CHECK([for GnuTLS v3 with cipher], [emacs_cv_gnutls3_cipher], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ - #include - #include - ]], [[ - int - main (void) - { - gnutls_cipher_hd_t handle; - gnutls_cipher_encrypt2 (handle, NULL, 0, NULL, 0); - gnutls_cipher_deinit (handle); - } - ]])], - [emacs_cv_gnutls3_cipher=yes], - [emacs_cv_gnutls3_cipher=no])]) - if test "$emacs_cv_gnutls3_cipher" = yes; then - AC_DEFINE([HAVE_GNUTLS3_CIPHER], [1], - [Define if using GnuTLS v3 with cipher support.]) - fi - - AC_CACHE_CHECK([for GnuTLS v3 with digest], [emacs_cv_gnutls3_digest], - [AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ - #include - #include - ]], [[ - int - main (void) - { - gnutls_hash_hd_t handle; - gnutls_hash_deinit (handle, NULL); - } - ]])], - [emacs_cv_gnutls3_digest=yes], - [emacs_cv_gnutls3_digest=no])]) - if test "$emacs_cv_gnutls3_digest" = yes; then - AC_DEFINE([HAVE_GNUTLS3_DIGEST], [1], - [Define if using GnuTLS v3 with digest support.]) - fi fi # Windows loads GnuTLS dynamically diff --git a/src/gnutls.h b/src/gnutls.h index 3ec86a8892..19c16867d7 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -23,8 +23,16 @@ along with GNU Emacs. If not, see . */ #include #include -#ifdef HAVE_GNUTLS3 -#include +#if 0x030000 <= GNUTLS_VERSION_NUMBER +# define HAVE_GNUTLS3 +# include +#endif + +#if 0x030400 <= GNUTLS_VERSION_NUMBER +# define HAVE_GNUTLS3_AEAD +# define HAVE_GNUTLS3_CIPHER +# define HAVE_GNUTLS3_DIGEST +# define HAVE_GNUTLS3_HMAC #endif #include "lisp.h" commit 2d2c12fc5f45ff73387efd6241447f3d9cbadf09 Author: Paul Eggert Date: Wed Aug 2 19:13:26 2017 -0700 Default to --with-mailutils if it is installed * configure.ac (with_mailutils): Default to 'yes' if GNU Mailutils is installed. See: http://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00054.html diff --git a/INSTALL b/INSTALL index ea96890432..33084b9da3 100644 --- a/INSTALL +++ b/INSTALL @@ -261,10 +261,10 @@ Emacs with the options '--without-dbus --without-gconf --without-gsettings'. To read email via a network protocol like IMAP or POP, you can configure Emacs with the option '--with-mailutils', so that it always -uses the GNU Mailutils 'movemail' program to retrieve mail. Otherwise -the Emacs build procedure builds and installs an auxiliary 'movemail' -program, a limited and insecure substitute that Emacs can use when -Mailutils is not installed; when this happens, there are several +uses the GNU Mailutils 'movemail' program to retrieve mail; this is +the default if GNU Mailutils is installed. Otherwise the Emacs build +procedure builds and installs an auxiliary 'movemail' program, a +limited and insecure substitute; when this happens, there are several configure options such as --without-pop that provide fine-grained control over Emacs 'movemail' construction. @@ -272,10 +272,9 @@ The Emacs mail reader RMAIL is configured to be able to read mail from a POP3 server by default. Versions of the POP protocol older than POP3 are not supported. While POP3 support is typically enabled, whether Emacs actually uses POP3 is controlled by individual users; -see the Rmail chapter of the Emacs manual. Unless you configure ---with-mailutils, it is a good idea to configure --without-pop so that -users are less likely to inadvertently read email via insecure -channels. +see the Rmail chapter of the Emacs manual. Unless --with-mailutils is +in effect, it is a good idea to configure --without-pop so that users +are less likely to inadvertently read email via insecure channels. For image support you may have to download, build, and install the appropriate image support libraries for image types other than XBM and @@ -550,7 +549,7 @@ information on this. Emacs info files. 8) If your system uses lock files to interlock access to mailer inbox files, -and if you did not configure --with-mailutils, then you might need to +and if --with-mailutils is not in effect, then you might need to make the Emacs-specific 'movemail' program setuid or setgid in order to enable it to write the lock files. We believe this is safe. diff --git a/configure.ac b/configure.ac index c3e440adca..c9e8c0dd1c 100644 --- a/configure.ac +++ b/configure.ac @@ -234,9 +234,16 @@ AC_DEFUN([OPTION_DEFAULT_ON], [dnl # in a movemail implementation that supports only unencrypted POP3 # connections. Encrypted connections should be the default. -OPTION_DEFAULT_OFF([mailutils], - [rely on GNU Mailutils, so that the --without-pop through --with-mailhost - options are irrelevant]) +AC_ARG_WITH([mailutils], + [AS_HELP_STRING([--with-mailutils], + [rely on GNU Mailutils, so that the --without-pop through --with-mailhost + options are irrelevant; this is the default if GNU Mailutils is + installed])], + [], + [with_mailutils=$with_features + if test "$with_mailutils" = yes; then + (movemail --version) >/dev/null 2>&1 || with_mailutils=no + fi]) if test "$with_mailutils" = no; then with_mailutils= fi diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 046087ef45..f2416a0777 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -1382,7 +1382,7 @@ Rmail attempts to locate the @command{movemail} program and determine its version. There are two versions of the @command{movemail} program: the GNU Mailutils version (@pxref{movemail,,,mailutils,GNU mailutils}), and an Emacs-specific version that is built and installed unless Emacs -was configured using the @option{--with-mailutils} option. +was configured @option{--with-mailutils} in effect. The two @command{mailtool} versions support the same command line syntax and the same basic subset of options. However, the Mailutils version offers additional features. diff --git a/etc/NEWS b/etc/NEWS index 44f5ff5bde..b72793dec0 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -31,10 +31,12 @@ Use 'configure --with-gnutls=no' to build even when GnuTLS is missing. version 2.6.6 or later. ** The new option 'configure --with-mailutils' causes Emacs to rely on -GNU Mailutils 'movemail' to retrieve email. By default, the Emacs -build procedure continues to build and install a limited and insecure -'movemail' substitute. Although --with-mailutils is recommended, it -is not yet the default due to backward-compatibility concerns. +GNU Mailutils to retrieve email. It is recommended, and is the +default if GNU Mailutils is installed. When --with-mailutils is not +in effect, the Emacs build procedure by default continues to build and +install a limited 'movemail' substitute that retrieves POP3 email only +via insecure channels; to avoid this problem, use either +--with-mailutils or --without-pop when configuring. ** The new option 'configure --enable-gcc-warnings=warn-only' causes GCC to issue warnings without stopping the build. This behavior is commit 5ed0bf1061cb0b2e70ee1d28f5f3586259ec0f3b Author: Paul Eggert Date: Wed Aug 2 13:01:58 2017 -0700 Clarify when autogen.sh should run only autoconf * Makefile.in (configure, bootstrap): Run ‘./autogen.sh autoconf’, not plain ‘./autogen.sh’, to make it clear that only autoconf-related tools should be run here. diff --git a/Makefile.in b/Makefile.in index a31d416bd7..8a08465c4a 100644 --- a/Makefile.in +++ b/Makefile.in @@ -448,7 +448,7 @@ config.status: ${srcdir}/configure fi $(srcdir)/configure: $(srcdir)/configure.ac $(srcdir)/m4/*.m4 - cd $(srcdir) && ./autogen.sh + cd $(srcdir) && ./autogen.sh autoconf # ==================== Installation ==================== @@ -1094,7 +1094,7 @@ check-info: info # * Rebuild Makefile, to update the build procedure itself. # * Do the actual build. bootstrap: bootstrap-clean - cd $(srcdir) && ./autogen.sh + cd $(srcdir) && ./autogen.sh autoconf $(MAKE) MAKEFILE_NAME=force-Makefile force-Makefile $(MAKE) all commit fe80d58ca4ead89e8887aa726482694888a8ef7f Author: Toon Claes Date: Wed Jul 26 09:19:24 2017 +0200 .gitlab-ci.yml: Use stretch Debian image instead of unstable diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 5fcd54fd94..0b1e8b5d9f 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -24,7 +24,7 @@ # Maintainer: tzz@lifelogs.com # URL: https://gitlab.com/emacs-ci/emacs -image: debian:unstable +image: debian:stretch before_script: - apt update -qq commit 61291201039fa23096a895cb0cb724d35b7b4ed4 Author: Stephen Berman Date: Wed Aug 2 17:25:44 2017 +0200 Add debugging messages to a Dired test * test/lisp/dired-tests.el (dired-test-bug27243-01): Log positions saved and restored by dired-revert to try and find out why the test fails on Hydra. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index c67f37953c..1ae47a92f8 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -122,8 +122,11 @@ (ert-deftest dired-test-bug27243-01 () "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." - (let ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t))) - (dired-auto-revert-buffer t) buffers) + (let* ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t))) + (save-pos (lambda () + (with-current-buffer (car (dired-buffers-for-dir test-dir)) + (dired-save-positions)))) + (dired-auto-revert-buffer t) buffers) ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the ;; corresponding long file names exist, otherwise such names trip ;; dired-buffers-for-dir. @@ -132,10 +135,12 @@ (should-not (dired-buffers-for-dir test-dir)) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) + (message "Saved pos: %S" (funcall save-pos)) ;; Point must be at end-of-buffer. (with-current-buffer (car (dired-buffers-for-dir test-dir)) (should (eobp))) (push (dired test-dir) buffers) + (message "Saved pos: %S" (funcall save-pos)) ;; Previous dired call shouldn't create a new buffer: must visit the one ;; created by `find-file-noselect' above. (should (eq 1 (length (dired-buffers-for-dir test-dir)))) @@ -144,10 +149,13 @@ (pt1 (point)) (test-file (concat (file-name-as-directory "test-subdir") "test-file"))) + (message "Saved pos: %S" (funcall save-pos)) (write-region "Test" nil test-file nil 'silent nil 'excl) + (message "Saved pos: %S" (funcall save-pos)) ;; Sanity check: point should now be on the subdirectory. (should (equal (dired-file-name-at-point) (concat test-dir (file-name-as-directory "test-subdir")))) + (message "Saved pos: %S" (funcall save-pos)) (push (dired-find-file) buffers) (let ((pt2 (point))) ; Point is on test-file. (pop-to-buffer-same-window buf) commit cf1da46761675f1886e54765fa213c7bd7d93437 Author: Tino Calancha Date: Wed Aug 2 18:11:31 2017 +0900 ls-lisp: Autoload call instead of cookie * lisp/ls-lisp.el (eshell-extended-glob): autoload call instead of cookie. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 2f723ca8ac..9a4fc19744 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -479,14 +479,19 @@ not contain `d', so that a full listing is expected." (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! - -(declare-function eshell-extended-glob "em-glob" (glob)) +;; We cannot require 'em-glob' in the top of the file: +;; ls-lisp is compiled before than eshell, and esh-groups.el +;; wouldn't be created yet. If we require 'em-glob' inside +;; `ls-lisp--dired', then this function cannot be called +;; before eshell is compiled. +;; So instead we add an autoload call here. +;; (https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg01083.html). +(autoload 'eshell-extended-glob "em-glob") (declare-function dired-read-dir-and-switches "dired" (str)) (declare-function dired-goto-next-file "dired" ()) (defun ls-lisp--dired (orig-fun dir-or-list &optional switches) (interactive (dired-read-dir-and-switches "")) - (require 'em-glob) (if (consp dir-or-list) (funcall orig-fun dir-or-list switches) (let ((dir-wildcard (insert-directory-wildcard-in-dir-p commit 49d6e59717ad182487910b863656bb6a11080bcf Merge: 4207733f4a 1f9f514e7c Author: Michael Albinus Date: Wed Aug 2 11:01:05 2017 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 4207733f4aefd17fd06e7820775d4c2359daba87 Author: Michael Albinus Date: Wed Aug 2 10:59:57 2017 +0200 ; Extend traces in tramp-test36-asynchronous-requests for hydra diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d76629038f..50dfd6fac2 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3804,6 +3804,7 @@ process sentinels. They shall not disturb each other." ;; seconds, and we send a SIGUSR1 signal after 300 seconds. (with-timeout (300 (tramp--test-timeout-handler)) (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) + (tramp--test-instrument-test-case (if (getenv "EMACS_HYDRA_CI") 10 0) (let* ((watchdog (start-process "*watchdog*" nil shell-file-name shell-command-switch @@ -3917,10 +3918,9 @@ process sentinels. They shall not disturb each other." ;; Give the watchdog a chance. (read-event nil nil 0.01) ;; Regular operation post process action. - (tramp--test-instrument-test-case 10 - (if (= count 2) - (should-not (file-attributes file)) - (should (file-attributes file)))) + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file))) (tramp--test-message "Stop action %d %s %s" count buf (current-time-string)) (process-put proc 'bar (1+ count)) @@ -3945,7 +3945,7 @@ process sentinels. They shall not disturb each other." (ignore-errors (delete-process (get-buffer-process buf))) (ignore-errors (kill-buffer buf))) (ignore-errors (cancel-timer timer)) - (ignore-errors (delete-directory tmp-name 'recursive)))))) + (ignore-errors (delete-directory tmp-name 'recursive))))))) (ert-deftest tramp-test37-recursive-load () "Check that Tramp does not fail due to recursive load." commit 1f9f514e7c2ba41b0954d0141f99652f6a53a107 Author: Paul Eggert Date: Wed Aug 2 01:53:46 2017 -0700 When renaming a file, ask only if EEXIST or ENOSYS * src/fileio.c (Frename_file): Avoid calling Ffile_directory_p more than once on FILE. Use renameat_noreplace, so that we can ask the user (and unlink and retry) only if this fails with errno == EEXIST or ENOSYS. This avoids the need to ask the user for permission to do an operation that will fail anyway. Simplify computation of ok_if_already_exists for subsidiary functions. * src/filelock.c (rename_lock_file): Prefer renameat_noreplace if it works, as this avoids the need to link and unlink. * src/lisp.h (renameat_noreplace): New decl. * src/sysdep.c [HAVE_LINUX_FS_H]: Include linux/fs.h and sys/syscall.h. (renameat_noreplace): New function. diff --git a/src/fileio.c b/src/fileio.c index 96c5639a09..0264c9fa1d 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2311,6 +2311,7 @@ This is what happens in interactive use with M-x. */) { Lisp_Object handler; Lisp_Object encoded_file, encoded_newname, symlink_target; + int dirp = -1; symlink_target = encoded_file = encoded_newname = Qnil; CHECK_STRING (file); @@ -2324,8 +2325,8 @@ This is what happens in interactive use with M-x. */) && (NILP (Ffile_name_case_insensitive_p (file)) || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))) { - Lisp_Object fname = (NILP (Ffile_directory_p (file)) - ? file : Fdirectory_file_name (file)); + dirp = !NILP (Ffile_directory_p (file)); + Lisp_Object fname = dirp ? Fdirectory_file_name (file) : file; newname = Fexpand_file_name (Ffile_name_nondirectory (fname), newname); } else @@ -2343,47 +2344,55 @@ This is what happens in interactive use with M-x. */) encoded_file = ENCODE_FILE (file); encoded_newname = ENCODE_FILE (newname); - /* If the filesystem is case-insensitive and the file names are - identical but for the case, don't ask for confirmation: they - simply want to change the letter-case of the file name. */ - if ((!(file_name_case_insensitive_p (SSDATA (encoded_file))) - || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname)))) - && ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)))) - barf_or_query_if_file_exists (newname, false, "rename to it", - INTEGERP (ok_if_already_exists), false); - if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0) + if (renameat_noreplace (AT_FDCWD, SSDATA (encoded_file), + AT_FDCWD, SSDATA (encoded_newname)) + == 0) + return Qnil; + int rename_errno = errno; + + if (rename_errno == EEXIST || rename_errno == ENOSYS) { - int rename_errno = errno; - if (rename_errno == EXDEV) - { - ptrdiff_t count; - symlink_target = Ffile_symlink_p (file); - if (! NILP (symlink_target)) - Fmake_symbolic_link (symlink_target, newname, - NILP (ok_if_already_exists) ? Qnil : Qt); - else if (!NILP (Ffile_directory_p (file))) - call4 (Qcopy_directory, file, newname, Qt, Qnil); - else - /* We have already prompted if it was an integer, so don't - have copy-file prompt again. */ - Fcopy_file (file, newname, - NILP (ok_if_already_exists) ? Qnil : Qt, - Qt, Qt, Qt); + /* If the filesystem is case-insensitive and the file names are + identical but for the case, don't ask for confirmation: they + simply want to change the letter-case of the file name. */ + if ((NILP (ok_if_already_exists) || INTEGERP (ok_if_already_exists)) + && (! file_name_case_insensitive_p (SSDATA (encoded_file)) + || NILP (Fstring_equal (Fdowncase (file), Fdowncase (newname))))) + barf_or_query_if_file_exists (newname, rename_errno == EEXIST, + "rename to it", + INTEGERP (ok_if_already_exists), false); + if (rename (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0) + return Qnil; + rename_errno = errno; + /* Don't prompt again. */ + ok_if_already_exists = Qt; + } + else if (!NILP (ok_if_already_exists)) + ok_if_already_exists = Qt; - count = SPECPDL_INDEX (); - specbind (Qdelete_by_moving_to_trash, Qnil); + if (rename_errno != EXDEV) + report_file_errno ("Renaming", list2 (file, newname), rename_errno); - if (!NILP (Ffile_directory_p (file)) && NILP (symlink_target)) - call2 (Qdelete_directory, file, Qt); - else - Fdelete_file (file, Qnil); - unbind_to (count, Qnil); - } + symlink_target = Ffile_symlink_p (file); + if (!NILP (symlink_target)) + Fmake_symbolic_link (symlink_target, newname, ok_if_already_exists); + else + { + if (dirp < 0) + dirp = !NILP (Ffile_directory_p (file)); + if (dirp) + call4 (Qcopy_directory, file, newname, Qt, Qnil); else - report_file_errno ("Renaming", list2 (file, newname), rename_errno); + Fcopy_file (file, newname, ok_if_already_exists, Qt, Qt, Qt); } - return Qnil; + ptrdiff_t count = SPECPDL_INDEX (); + specbind (Qdelete_by_moving_to_trash, Qnil); + if (dirp && NILP (symlink_target)) + call2 (Qdelete_directory, file, Qt); + else + Fdelete_file (file, Qnil); + return unbind_to (count, Qnil); } DEFUN ("add-name-to-file", Fadd_name_to_file, Sadd_name_to_file, 2, 3, diff --git a/src/filelock.c b/src/filelock.c index bfa1d63d83..dd8cb28c42 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -339,6 +339,9 @@ rename_lock_file (char const *old, char const *new, bool force) { struct stat st; + int r = renameat_noreplace (AT_FDCWD, old, AT_FDCWD, new); + if (! (r < 0 && errno == ENOSYS)) + return r; if (link (old, new) == 0) return unlink (old) == 0 || errno == ENOENT ? 0 : -1; if (errno != ENOSYS && errno != LINKS_MIGHT_NOT_WORK) diff --git a/src/lisp.h b/src/lisp.h index cffaf954b3..4de6fc85ec 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4298,13 +4298,15 @@ extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); extern ptrdiff_t emacs_write_sig (int, void const *, ptrdiff_t); extern ptrdiff_t emacs_write_quit (int, void const *, ptrdiff_t); extern void emacs_perror (char const *); +extern int renameat_noreplace (int, char const *, int, char const *); +extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); -extern void unlock_all_files (void); +/* Defined in filelock.c. */ extern void lock_file (Lisp_Object); extern void unlock_file (Lisp_Object); +extern void unlock_all_files (void); extern void unlock_buffer (struct buffer *); extern void syms_of_filelock (void); -extern int str_collate (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); /* Defined in sound.c. */ extern void syms_of_sound (void); diff --git a/src/sysdep.c b/src/sysdep.c index db99f53299..22446b25d1 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -37,6 +37,11 @@ along with GNU Emacs. If not, see . */ #include "sysselect.h" #include "blockinput.h" +#ifdef HAVE_LINUX_FS_H +# include +# include +#endif + #if defined DARWIN_OS || defined __FreeBSD__ # include #endif @@ -2678,6 +2683,21 @@ set_file_times (int fd, const char *filename, timespec[1] = mtime; return fdutimens (fd, filename, timespec); } + +/* Rename directory SRCFD's entry SRC to directory DSTFD's entry DST. + This is like renameat except that it fails if DST already exists, + or if this operation is not supported atomically. Return 0 if + successful, -1 (setting errno) otherwise. */ +int +renameat_noreplace (int srcfd, char const *src, int dstfd, char const *dst) +{ +#ifdef SYS_renameat2 + return syscall (SYS_renameat2, srcfd, src, dstfd, dst, RENAME_NOREPLACE); +#else + errno = ENOSYS; + return -1; +#endif +} /* Like strsignal, except async-signal-safe, and this function typically returns a string in the C locale rather than the current locale. */ commit 5656492d04aa1a82747ff167d8063bbd7950597e Author: Paul Eggert Date: Wed Aug 2 01:53:46 2017 -0700 When creating a link, ask only if EEXIST * src/fileio.c (Fadd_name_to_file, Fmake_symbolic_link): Ask the user (and unlink and retry) only if link creation fails with errno == EEXIST. This avoids the need to ask the user for permission to do an operation that will fail anyway. diff --git a/src/fileio.c b/src/fileio.c index 7531214fe4..96c5639a09 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2425,19 +2425,21 @@ This is what happens in interactive use with M-x. */) encoded_file = ENCODE_FILE (file); encoded_newname = ENCODE_FILE (newname); - if (NILP (ok_if_already_exists) - || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (newname, false, "make it a new name", - INTEGERP (ok_if_already_exists), false); + if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0) + return Qnil; - unlink (SSDATA (newname)); - if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) < 0) + if (errno == EEXIST) { - int link_errno = errno; - report_file_errno ("Adding new name", list2 (file, newname), link_errno); + if (NILP (ok_if_already_exists) + || INTEGERP (ok_if_already_exists)) + barf_or_query_if_file_exists (newname, true, "make it a new name", + INTEGERP (ok_if_already_exists), false); + unlink (SSDATA (newname)); + if (link (SSDATA (encoded_file), SSDATA (encoded_newname)) == 0) + return Qnil; } - return Qnil; + report_file_error ("Adding new name", list2 (file, newname)); } DEFUN ("make-symbolic-link", Fmake_symbolic_link, Smake_symbolic_link, 2, 3, @@ -2484,31 +2486,25 @@ This happens for interactive use with M-x. */) encoded_target = ENCODE_FILE (target); encoded_linkname = ENCODE_FILE (linkname); - if (NILP (ok_if_already_exists) - || INTEGERP (ok_if_already_exists)) - barf_or_query_if_file_exists (linkname, false, "make it a link", - INTEGERP (ok_if_already_exists), false); - if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) < 0) - { - /* If we didn't complain already, silently delete existing file. */ - int symlink_errno; - if (errno == EEXIST) - { - unlink (SSDATA (encoded_linkname)); - if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) - >= 0) - return Qnil; - } - if (errno == ENOSYS) - xsignal1 (Qfile_error, - build_string ("Symbolic links are not supported")); + if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0) + return Qnil; - symlink_errno = errno; - report_file_errno ("Making symbolic link", list2 (target, linkname), - symlink_errno); + if (errno == ENOSYS) + xsignal1 (Qfile_error, + build_string ("Symbolic links are not supported")); + + if (errno == EEXIST) + { + if (NILP (ok_if_already_exists) + || INTEGERP (ok_if_already_exists)) + barf_or_query_if_file_exists (linkname, true, "make it a link", + INTEGERP (ok_if_already_exists), false); + unlink (SSDATA (encoded_linkname)); + if (symlink (SSDATA (encoded_target), SSDATA (encoded_linkname)) == 0) + return Qnil; } - return Qnil; + report_file_error ("Making symbolic link", list2 (target, linkname)); } commit ae055834a99b26bf46180b6c78fe7ca24b7c8194 Author: Tino Calancha Date: Wed Aug 2 17:52:57 2017 +0900 dired-align-file: Inherit text properties in inserted spaces * lisp/dired.el (dired-align-file): Inherit text properties in inserted spaces (Bug#27899). * test/lisp/dired-tests.el (dired-test-bug27899): Add test. diff --git a/lisp/dired.el b/lisp/dired.el index e1bedb6c73..24759c6c9b 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1205,7 +1205,7 @@ BEG..END is the line where the file info is located." (setq file-col (+ spaces file-col)) (if (> file-col other-col) (setq spaces (- spaces (- file-col other-col)))) - (insert-char ?\s spaces) + (insert-char ?\s spaces 'inherit) ;; Let's just make really sure we did not mess up. (unless (save-excursion (eq (dired-move-to-filename) (marker-position file))) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 4ab6b37664..c67f37953c 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -260,6 +260,21 @@ (delete-directory dir 'recursive) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest dired-test-bug27899 () + "Test for http://debbugs.gnu.org/27899 ." + (let* ((dir (expand-file-name "src" source-directory)) + (buf (dired (list dir "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c"))) + (orig dired-hide-details-mode)) + (dired-goto-file (expand-file-name "cygw32.c")) + (forward-line 0) + (unwind-protect + (progn + (let ((inhibit-read-only t)) + (dired-align-file (point) (point-max))) + (dired-hide-details-mode t) + (dired-move-to-filename) + (should (eq 2 (current-column)))) + (dired-hide-details-mode orig)))) (provide 'dired-tests) ;; dired-tests.el ends here commit e82c4f56e6f9a6bce4098698b17fa45dcc5bbd25 Author: Tino Calancha Date: Wed Aug 2 16:50:37 2017 +0900 Don't assume /bin/sh as the 'sh' location in the local host * lisp/dired.el (dired-insert-directory): Use executable-find in a local host. diff --git a/lisp/dired.el b/lisp/dired.el index 4f8f615a34..e1bedb6c73 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1276,12 +1276,17 @@ see `dired-use-ls-dired' for more details.") ;; call for wildcards. (when (file-remote-p dir) (setq switches (dired-replace-in-string "--dired" "" switches))) - (let ((default-directory (car dir-wildcard)) - (script (format "ls %s %s" switches (cdr dir-wildcard)))) + (let* ((default-directory (car dir-wildcard)) + (script (format "ls %s %s" switches (cdr dir-wildcard))) + (remotep (file-remote-p dir)) + (sh (or (and remotep "/bin/sh") + (and (bound-and-true-p explicit-shell-file-name) + (executable-find explicit-shell-file-name)) + (executable-find "sh"))) + (switch (if remotep "-c" shell-command-switch))) (unless (zerop - (process-file - "/bin/sh" nil (current-buffer) nil "-c" script)) + (process-file sh nil (current-buffer) nil switch script)) (user-error "%s: No files matching wildcard" (cdr dir-wildcard))) (insert-directory-clean (point) switches))) commit a79671c97fb193ec44ca27e1eeb9e7f5bcf2e9f6 Author: Tino Calancha Date: Wed Aug 2 16:39:11 2017 +0900 Move dired tests using ls emulation to different files Suggested in: https://lists.gnu.org/archive/html/emacs-devel/2017-08/msg00018.html * test/lisp/dired-tests.el (dired-test-bug27693) (dired-test-bug27762, dired-test-bug27817) (dired-test-bug27631, dired-test-bug27843): Delete those parts requiring either ls-lisp or eshell-ls. * test/lisp/ls-lisp-tests.el (ls-lisp-test-bug27762) (ls-lisp-test-bug27631, ls-lisp-test-bug27693): Add all dired tests using ls-lisp here. * test/lisp/eshell/em-ls-tests.el (em-ls-test-bug27631) (em-ls-test-bug27817, em-ls-test-bug27843): New test file. Add all dired tests using eshell-ls here. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 047bfdcf71..4ab6b37664 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -225,23 +225,6 @@ (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory test-dir t)))) -(ert-deftest dired-test-bug27693 () - "Test for http://debbugs.gnu.org/27693 ." - (require 'ls-lisp) - (let ((dir (expand-file-name "lisp" source-directory)) - (size "") - ls-lisp-use-insert-directory-program buf) - (unwind-protect - (progn - (setq buf (dired (list dir "simple.el" "subr.el")) - size (number-to-string - (file-attribute-size - (file-attributes (dired-get-filename))))) - (search-backward-regexp size nil t) - (should (looking-back "[[:space:]]" (1- (point))))) - (unload-feature 'ls-lisp 'force) - (when (buffer-live-p buf) (kill-buffer buf))))) - (ert-deftest dired-test-bug7131 () "Test for http://debbugs.gnu.org/7131 ." (let* ((dir (expand-file-name "lisp" source-directory)) @@ -258,44 +241,6 @@ (should (cdr (dired-get-marked-files)))) (when (buffer-live-p buf) (kill-buffer buf))))) -(ert-deftest dired-test-bug27762 () - "Test for http://debbugs.gnu.org/27762 ." - (require 'ls-lisp) - (let* ((dir source-directory) - (default-directory dir) - (files (mapcar (lambda (f) (concat "src/" f)) - (directory-files - (expand-file-name "src") nil "\\.*\\.c\\'"))) - ls-lisp-use-insert-directory-program buf) - (unwind-protect - (let ((file1 "src/cygw32.c") - (file2 "src/atimer.c")) - (setq buf (dired (nconc (list dir) files))) - (dired-goto-file (expand-file-name file2 default-directory)) - (should-not (looking-at "^ -")) ; Must be 2 spaces not 3. - (setq files (cons file1 (delete file1 files))) - (kill-buffer buf) - (setq buf (dired (nconc (list dir) files))) - (should (looking-at "src")) - (next-line) ; File names must be aligned. - (should (looking-at "src"))) - (unload-feature 'ls-lisp 'force) - (when (buffer-live-p buf) (kill-buffer buf))))) - -(ert-deftest dired-test-bug27817 () - "Test for http://debbugs.gnu.org/27817 ." - (require 'em-ls) - (let ((orig eshell-ls-use-in-dired) - (dired-use-ls-dired 'unspecified) - buf insert-directory-program) - (unwind-protect - (progn - (customize-set-variable 'eshell-ls-use-in-dired t) - (should (setq buf (dired source-directory)))) - (customize-set-variable 'eshell-ls-use-in-dired orig) - (unload-feature 'em-ls 'force) - (and (buffer-live-p buf) (kill-buffer))))) - (ert-deftest dired-test-bug27631 () "Test for http://debbugs.gnu.org/27631 ." (let* ((dir (make-temp-file "bug27631" 'dir)) @@ -311,44 +256,10 @@ (with-temp-file (expand-file-name "b.txt" dir2)) (setq buf (dired (expand-file-name "dir*/*.txt" dir))) (dired-toggle-marks) - (should (cdr (dired-get-marked-files))) - ;; Must work with ls-lisp ... - (require 'ls-lisp) - (kill-buffer buf) - (setq default-directory dir) - (let (ls-lisp-use-insert-directory-program) - (setq buf (dired (expand-file-name "dir*/*.txt" dir))) - (dired-toggle-marks) - (should (cdr (dired-get-marked-files)))) - ;; ... And with em-ls as well. - (kill-buffer buf) - (setq default-directory dir) - (unload-feature 'ls-lisp 'force) - (require 'em-ls) - (let ((orig eshell-ls-use-in-dired)) - (customize-set-value 'eshell-ls-use-in-dired t) - (setq buf (dired (expand-file-name "dir*/*.txt" dir))) - (dired-toggle-marks) - (should (cdr (dired-get-marked-files))))) - (unload-feature 'em-ls 'force) + (should (cdr (dired-get-marked-files)))) (delete-directory dir 'recursive) (when (buffer-live-p buf) (kill-buffer buf))))) -(ert-deftest dired-test-bug27843 () - "Test for http://debbugs.gnu.org/27843 ." - (require 'em-ls) - (let ((orig eshell-ls-use-in-dired) - (dired-use-ls-dired 'unspecified) - buf insert-directory-program) - (unwind-protect - (progn - (customize-set-variable 'eshell-ls-use-in-dired t) - (setq buf (dired (list source-directory "lisp"))) - (dired-toggle-marks) - (should-not (cdr (dired-get-marked-files)))) - (customize-set-variable 'eshell-ls-use-in-dired orig) - (unload-feature 'em-ls 'force) - (and (buffer-live-p buf) (kill-buffer))))) (provide 'dired-tests) ;; dired-tests.el ends here diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el new file mode 100644 index 0000000000..71a555d1ea --- /dev/null +++ b/test/lisp/eshell/em-ls-tests.el @@ -0,0 +1,80 @@ +;;; tests/em-ls-tests.el --- em-ls test suite + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calancha + +;; 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: + + +;;; Code: + +(require 'ert) +(require 'em-ls) + +(ert-deftest em-ls-test-bug27631 () + "Test for http://debbugs.gnu.org/27631 ." + (let* ((dir (make-temp-file "bug27631" 'dir)) + (dir1 (expand-file-name "dir1" dir)) + (dir2 (expand-file-name "dir2" dir)) + (default-directory dir) + (orig eshell-ls-use-in-dired) + buf) + (unwind-protect + (progn + (customize-set-value 'eshell-ls-use-in-dired t) + (make-directory dir1) + (make-directory dir2) + (with-temp-file (expand-file-name "a.txt" dir1)) + (with-temp-file (expand-file-name "b.txt" dir2)) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (delete-directory dir 'recursive) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest em-ls-test-bug27817 () + "Test for http://debbugs.gnu.org/27817 ." + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (should (setq buf (dired source-directory)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (and (buffer-live-p buf) (kill-buffer))))) + +(ert-deftest em-ls-test-bug27843 () + "Test for http://debbugs.gnu.org/27843 ." + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (setq buf (dired (list source-directory "lisp"))) + (dired-toggle-marks) + (should-not (cdr (dired-get-marked-files)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (and (buffer-live-p buf) (kill-buffer))))) + +(provide 'em-ls-test) + +;;; em-ls-tests.el ends here diff --git a/test/lisp/ls-lisp-tests.el b/test/lisp/ls-lisp-tests.el index 5ef7c78f4d..d24b30e5f2 100644 --- a/test/lisp/ls-lisp-tests.el +++ b/test/lisp/ls-lisp-tests.el @@ -25,13 +25,70 @@ ;;; Code: (require 'ert) +(require 'ls-lisp) (ert-deftest ls-lisp-unload () "Test for http://debbugs.gnu.org/xxxxx ." - (require 'ls-lisp) (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) (unload-feature 'ls-lisp 'force) - (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))) + (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) + (require 'ls-lisp)) + +(ert-deftest ls-lisp-test-bug27762 () + "Test for http://debbugs.gnu.org/27762 ." + (let* ((dir source-directory) + (default-directory dir) + (files (mapcar (lambda (f) (concat "src/" f)) + (directory-files + (expand-file-name "src") nil "\\.*\\.c\\'"))) + ls-lisp-use-insert-directory-program buf) + (unwind-protect + (let ((file1 "src/cygw32.c") + (file2 "src/atimer.c")) + (setq buf (dired (nconc (list dir) files))) + (dired-goto-file (expand-file-name file2 default-directory)) + (should-not (looking-at "^ -")) ; Must be 2 spaces not 3. + (setq files (cons file1 (delete file1 files))) + (kill-buffer buf) + (setq buf (dired (nconc (list dir) files))) + (should (looking-at "src")) + (next-line) ; File names must be aligned. + (should (looking-at "src"))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest ls-lisp-test-bug27631 () + "Test for http://debbugs.gnu.org/27631 ." + (let* ((dir (make-temp-file "bug27631" 'dir)) + (dir1 (expand-file-name "dir1" dir)) + (dir2 (expand-file-name "dir2" dir)) + (default-directory dir) + ls-lisp-use-insert-directory-program buf) + (unwind-protect + (progn + (make-directory dir1) + (make-directory dir2) + (with-temp-file (expand-file-name "a.txt" dir1)) + (with-temp-file (expand-file-name "b.txt" dir2)) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files)))) + (delete-directory dir 'recursive) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest ls-lisp-test-bug27693 () + "Test for http://debbugs.gnu.org/27693 ." + (let ((dir (expand-file-name "lisp" source-directory)) + (size "") + ls-lisp-use-insert-directory-program buf) + (unwind-protect + (progn + (setq buf (dired (list dir "simple.el" "subr.el")) + size (number-to-string + (file-attribute-size + (file-attributes (dired-get-filename))))) + (search-backward-regexp size nil t) + (should (looking-back "[[:space:]]" (1- (point))))) + (when (buffer-live-p buf) (kill-buffer buf))))) (provide 'ls-lisp-tests) ;;; ls-lisp-tests.el ends here commit 0668ecc0cd9c2ef7bc0e6f320af454aca1325c25 Author: Tino Calancha Date: Wed Aug 2 16:31:36 2017 +0900 * test/lisp/ls-lisp-tests.el: Rename it from ls-lisp.el diff --git a/test/lisp/ls-lisp.el b/test/lisp/ls-lisp-tests.el similarity index 100% rename from test/lisp/ls-lisp.el rename to test/lisp/ls-lisp-tests.el commit 0fd6de9cb444d6cc553ea67815ccfb7a923012a2 Author: Katsumi Yamaoka Date: Wed Aug 2 03:23:49 2017 +0000 * lisp/gnus/mm-uu.el (mm-uu-org-src-code-block-extract): Say the handle is already decoded. cf. in the info-gnus-english list. diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 10cdeed3fb..177589c5f0 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -393,7 +393,7 @@ apply the face `mm-uu-extract'." (defun mm-uu-org-src-code-block-extract () (mm-make-handle (mm-uu-copy-to-buffer start-point end-point) - '("text/x-org"))) + '("text/x-org" (charset . gnus-decoded)))) (defvar gnus-newsgroup-name) commit 1a65afb7ecc2a52127d6164bad19313440237f9d Author: Paul Eggert Date: Tue Aug 1 17:24:28 2017 -0700 Don’t worry about unlink if errno == ENOENT * src/fileio.c (Fdelete_file): * src/keyboard.c (Fopen_dribble_file): Do not report failure to remove a file if unlink fails with errno == ENOENT. This can happen even if Emacs is the only program removing the file, in case an NFS cache overflows. The file does not exist if errno == ENOENT, so it is OK to proceed. diff --git a/src/fileio.c b/src/fileio.c index a57d50b24e..7531214fe4 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -2216,7 +2216,7 @@ With a prefix argument, TRASH is nil. */) encoded_file = ENCODE_FILE (filename); - if (unlink (SSDATA (encoded_file)) < 0) + if (unlink (SSDATA (encoded_file)) != 0 && errno != ENOENT) report_file_error ("Removing old name", filename); return Qnil; } diff --git a/src/keyboard.c b/src/keyboard.c index 804af85dad..97069a24ac 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10168,7 +10168,8 @@ This may include sensitive information such as passwords. */) file = Fexpand_file_name (file, Qnil); encfile = ENCODE_FILE (file); fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600); - if (fd < 0 && errno == EEXIST && unlink (SSDATA (encfile)) == 0) + if (fd < 0 && errno == EEXIST + && (unlink (SSDATA (encfile)) == 0 || errno == ENOENT)) fd = emacs_open (SSDATA (encfile), O_WRONLY | O_CREAT | O_EXCL, 0600); dribble = fd < 0 ? 0 : fdopen (fd, "w"); if (dribble == 0) commit f74164a845eff579635da0a1267514ef9d040ad2 Author: Tino Calancha Date: Wed Aug 2 00:01:45 2017 +0900 Fix misalignment in Dired when dired-directory is a cons * lisp/dired.el (dired--need-align-p, dired--align-all-files): New defuns. (dired-internal-noselect): Call dired--align-all-files when dired-directory is a cons (Bug#27762). * test/lisp/dired-tests.el (dired-test-bug27762): Test should pass. diff --git a/lisp/dired.el b/lisp/dired.el index c502dd8a50..4f8f615a34 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -34,6 +34,7 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) ;; When bootstrapping dired-loaddefs has not been generated. (require 'dired-loaddefs nil t) @@ -871,6 +872,46 @@ periodically reverts at specified time intervals." :group 'dired :version "23.2") +(defun dired--need-align-p () + "Return non-nil if some file names are misaligned. +The return value is the target column for the file names." + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + ;; Use point difference instead of `current-column', because + ;; the former works when `dired-hide-details-mode' is enabled. + (let* ((first (- (point) (point-at-bol))) + (target first)) + (while (and (not (eobp)) + (progn + (forward-line) + (dired-move-to-filename))) + (when-let* ((distance (- (point) (point-at-bol))) + (higher (> distance target))) + (setq target distance))) + (and (/= first target) target)))) + +(defun dired--align-all-files () + "Align all files adding spaces in front of the size column." + (let ((target (dired--need-align-p)) + (regexp directory-listing-before-filename-regexp)) + (when target + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + (while (dired-move-to-filename) + ;; Use point difference instead of `current-column', because + ;; the former works when `dired-hide-details-mode' is enabled. + (let ((distance (- target (- (point) (point-at-bol)))) + (inhibit-read-only t)) + (unless (zerop distance) + (re-search-backward regexp nil t) + (goto-char (match-beginning 0)) + (search-backward-regexp "[[:space:]]" nil t) + (skip-chars-forward "[:space:]") + (insert-char ?\s distance 'inherit)) + (forward-line))))))) + (defun dired-internal-noselect (dir-or-list &optional switches mode) ;; If DIR-OR-LIST is a string and there is an existing dired buffer ;; for it, just leave buffer as it is (don't even call dired-revert). @@ -940,6 +981,8 @@ periodically reverts at specified time intervals." (if failed (kill-buffer buffer)))) (goto-char (point-min)) (dired-initial-position dirname)) + (when (consp dired-directory) + (dired--align-all-files)) (set-buffer old-buf) buffer)) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 8657910a49..047bfdcf71 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -260,7 +260,6 @@ (ert-deftest dired-test-bug27762 () "Test for http://debbugs.gnu.org/27762 ." - :expected-result :failed (require 'ls-lisp) (let* ((dir source-directory) (default-directory dir) commit 21375a29ac9700810b90a34bd9825b1ca8f0c8e6 Author: Eli Zaretskii Date: Tue Aug 1 17:45:25 2017 +0300 Fix some dired-tests.el on MS-Windows * test/lisp/dired-tests.el (dired-test-bug27243-01) (dired-test-bug27243-02): On MS-Windows, pass test-dir through file-truename, to avoid bogus failures due to file-name comparison as strings. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 5900fead7d..8657910a49 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -124,6 +124,11 @@ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." (let ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t))) (dired-auto-revert-buffer t) buffers) + ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the + ;; corresponding long file names exist, otherwise such names trip + ;; dired-buffers-for-dir. + (if (eq system-type 'windows-nt) + (setq test-dir (file-truename test-dir))) (should-not (dired-buffers-for-dir test-dir)) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) @@ -158,6 +163,11 @@ "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ." (let ((test-dir (make-temp-file "test-dir-" t)) (dired-auto-revert-buffer t) buffers) + ;; On MS-Windows, get rid of 8+3 short names in test-dir, if the + ;; corresponding long file names exist, otherwise such names trip + ;; string comparisons below. + (if (eq system-type 'windows-nt) + (setq test-dir (file-truename test-dir))) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) (push (dired test-dir) buffers) commit f3ad15933a0d104b099d640d5c43fce99ece0003 Author: Tino Calancha Date: Tue Aug 1 23:31:35 2017 +0900 Insert subdir content if dir-or-list is a string w/o wildcards * lisp/eshell/em-ls.el (eshell-ls--insert-directory): Append '("-d") into 'eshell-ls-dired-initial-args' if 'dired-directory' is a cons or there are wildcars (Bug#27843). * test/lisp/dired-tests.el (dired-test-bug27843): Add test. diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 4a5adc48f2..39f03ffb79 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -278,8 +278,12 @@ instead." (let ((insert-func 'insert) (error-func 'insert) (flush-func 'ignore) - eshell-ls-dired-initial-args) - (eshell-do-ls (append switches (list file))))))))) + (switches + (append eshell-ls-dired-initial-args + (and (or (consp dired-directory) wildcard) (list "-d")) + switches))) + (eshell-do-ls (nconc switches (list file))))))))) + (declare-function eshell-extended-glob "em-glob" (glob)) (declare-function dired-read-dir-and-switches "dired" (str)) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 0ee4e13783..5900fead7d 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -325,6 +325,21 @@ (delete-directory dir 'recursive) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest dired-test-bug27843 () + "Test for http://debbugs.gnu.org/27843 ." + (require 'em-ls) + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (setq buf (dired (list source-directory "lisp"))) + (dired-toggle-marks) + (should-not (cdr (dired-get-marked-files)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (unload-feature 'em-ls 'force) + (and (buffer-live-p buf) (kill-buffer))))) (provide 'dired-tests) ;; dired-tests.el ends here commit 4ddc5645606478725ae0c27c85aa3c5dca6360d6 Author: Stephen Berman Date: Tue Aug 1 14:17:44 2017 +0200 Update todo-mode defcustoms in a less hideous way * lisp/calendar/todo-mode.el (todo-reevaluate-filelist-defcustoms) (todo-reevaluate-default-file-defcustom) (todo-reevaluate-category-completions-files-defcustom) (todo-reevaluate-filter-files-defcustom): Delete these functions. (todo-update-filelist-defcustoms): New function. This replaces todo-reevaluate-filelist-defcustoms, using the 'custom-type' property instead of re-evaluating the defcustoms. (todo-add-file, todo-rename-file, todo-delete-file) (todo-delete-category, todo-move-category) (todo-convert-legacy-files, todo-check-file): Replace call of todo-reevaluate-filelist-defcustoms by todo-update-filelist-defcustoms. (todo-show, todo-category-completions): Replace call of todo-reevaluate-* function by use of 'custom-type' property. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 1cb01e1ed9..e39fee5bfa 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -701,7 +701,8 @@ and done items are always shown on visiting a category." ;; We just initialized the first todo file, so make it the default. (setq todo-default-todo-file (todo-short-file-name file) first-file t) - (todo-reevaluate-default-file-defcustom)) + (put 'todo-default-todo-file 'custom-type + `(radio ,@(todo--files-type-list)))) (unless (member file todo-visited) ;; Can't setq t-c-t-f here, otherwise wrong file shown when ;; todo-show is called from todo-show-categories-table. @@ -780,7 +781,8 @@ and done items are always shown on visiting a category." (when first-file (setq todo-default-todo-file nil todo-current-todo-file nil) - (todo-reevaluate-default-file-defcustom)) + (put 'todo-default-todo-file 'custom-type + `(radio ,@(todo--files-type-list)))) (kill-buffer) (keyboard-quit))))) (save-excursion (todo-category-select)) @@ -1102,7 +1104,7 @@ Noninteractively, return the name of the new file." (write-region (point-min) (point-max) file nil 'nomessage nil t) (kill-buffer file)) (setq todo-files (funcall todo-files-function)) - (todo-reevaluate-filelist-defcustoms) + (todo-update-filelist-defcustoms) (if (called-interactively-p 'any) (progn (set-window-buffer (selected-window) @@ -1156,7 +1158,7 @@ these files, also rename them accordingly." (setq todo-default-todo-file snname)) (when (string= todo-global-current-todo-file oname) (setq todo-global-current-todo-file nname)) - (todo-reevaluate-filelist-defcustoms))) + (todo-update-filelist-defcustoms))) (defun todo-delete-file () "Delete the current todo, archive or filtered items file. @@ -1217,7 +1219,7 @@ visiting the deleted files." (when (or (string= file1 todo-global-current-todo-file) (and delete2 (string= file2 todo-global-current-todo-file))) (setq todo-global-current-todo-file nil)) - (todo-reevaluate-filelist-defcustoms) + (todo-update-filelist-defcustoms) (message (concat (cond (todo "Todo") (archive "Archive")) " file \"%s\" " (when delete2 (concat "and its " @@ -1387,7 +1389,7 @@ todo or done items." (if (= (length todo-categories) 1) ;; If deleted category was the only one, delete the file. (progn - (todo-reevaluate-filelist-defcustoms) + (todo-update-filelist-defcustoms) ;; Skip confirming killing the archive buffer if it has been ;; modified and not saved. (set-buffer-modified-p nil) @@ -1430,7 +1432,7 @@ the archive of the file moved to, creating it if it does not exist." (write-region (point-min) (point-max) nfile nil 'nomessage nil t) (kill-buffer nfile)) (setq todo-files (funcall todo-files-function)) - (todo-reevaluate-filelist-defcustoms)) + (todo-update-filelist-defcustoms)) (dolist (buf buffers) ;; Make sure archive file is in Todo Archive mode so that ;; todo-categories has correct value. @@ -1524,7 +1526,7 @@ the archive of the file moved to, creating it if it does not exist." (delete-file todo-current-todo-file) (kill-buffer) (when (member todo-current-todo-file todo-files) - (todo-reevaluate-filelist-defcustoms))) + (todo-update-filelist-defcustoms))) (setq todo-categories (delete (assoc cat todo-categories) todo-categories)) (todo-update-categories-sexp) @@ -4799,7 +4801,7 @@ name in `todo-directory'. See also the documentation string of (prin1 sexp (current-buffer))) (write-region (point-min) (point-max) file nil 'nomessage)) (setq todo-archives (funcall todo-files-function t))) - (todo-reevaluate-filelist-defcustoms) + (todo-update-filelist-defcustoms) (when (y-or-n-p (concat "Format conversion done; do you want to " "visit the converted file now? ")) (setq todo-current-todo-file file) @@ -4863,7 +4865,7 @@ buffer, clean up the state and return nil." (member todo-default-todo-file files)) (setq todo-default-todo-file (todo-short-file-name (car todo-files)))) - (todo-reevaluate-filelist-defcustoms) + (todo-update-filelist-defcustoms) (when buf (kill-buffer buf)) nil))))) @@ -5749,7 +5751,8 @@ have been removed." " been deleted and removed from\n" "the list of category completion files") names)) - (todo-reevaluate-category-completions-files-defcustom) + (put 'todo-category-completions-files 'custom-type + `(set ,@(todo--files-type-list))) (custom-set-default 'todo-category-completions-files (symbol-value 'todo-category-completions-files)) (sleep-for 1.5))) @@ -6249,59 +6252,12 @@ the empty string (i.e., no time string)." (hl-line-mode 1) (hl-line-mode -1))))))))) -(defun todo-reevaluate-filelist-defcustoms () - "Reevaluate defcustoms that provide choice list of todo files." - ;; FIXME: This is hideous! I don't know enough about Custom to - ;; offer something better, but please ask on emacs-devel! - (custom-set-default 'todo-default-todo-file - (symbol-value 'todo-default-todo-file)) - (todo-reevaluate-default-file-defcustom) - (custom-set-default 'todo-filter-files (symbol-value 'todo-filter-files)) - (todo-reevaluate-filter-files-defcustom) - (custom-set-default 'todo-category-completions-files - (symbol-value 'todo-category-completions-files)) - (todo-reevaluate-category-completions-files-defcustom)) - -(defun todo-reevaluate-default-file-defcustom () - "Reevaluate defcustom of `todo-default-todo-file'. -Called after adding or deleting a todo file. If the value of -`todo-default-todo-file' before calling this function was -associated with an existing file, keep that value." - ;; FIXME: This is hideous! I don't know enough about Custom to - ;; offer something better, but please ask on emacs-devel! - ;; (let ((curval todo-default-todo-file)) - (eval - (defcustom todo-default-todo-file (todo-short-file-name - (car (funcall todo-files-function))) - "Todo file visited by first session invocation of `todo-show'." - :type (when todo-files - `(radio ,@(todo--files-type-list))) - :group 'todo)) - ;; (when (and curval (file-exists-p (todo-absolute-file-name curval))) - ;; (custom-set-default 'todo-default-todo-file curval) - ;; ;; (custom-reevaluate-setting 'todo-default-todo-file) - ;; ))) - ) - -(defun todo-reevaluate-category-completions-files-defcustom () - "Reevaluate defcustom of `todo-category-completions-files'. -Called after adding or deleting a todo file." - ;; FIXME: This is hideous! I don't know enough about Custom to - ;; offer something better, but please ask on emacs-devel! - (eval (defcustom todo-category-completions-files nil - "List of files for building `todo-read-category' completions." - :type `(set ,@(todo--files-type-list)) - :group 'todo))) - -(defun todo-reevaluate-filter-files-defcustom () - "Reevaluate defcustom of `todo-filter-files'. -Called after adding or deleting a todo file." - ;; FIXME: This is hideous! I don't know enough about Custom to - ;; offer something better, but please ask on emacs-devel! - (eval (defcustom todo-filter-files nil - "List of files for multifile item filtering." - :type `(set ,@(todo--files-type-list)) - :group 'todo))) +(defun todo-update-filelist-defcustoms () + "Update defcustoms that provide choice list of todo files." + (put 'todo-default-todo-file 'custom-type `(radio ,@(todo--files-type-list))) + (put 'todo-category-completions-files 'custom-type + `(set ,@(todo--files-type-list))) + (put 'todo-filter-files 'custom-type `(set ,@(todo--files-type-list)))) ;; ----------------------------------------------------------------------------- ;;; Font locking commit cb764acce7c572aba093fa61baf26d5f5babcdca Author: Glenn Morris Date: Tue Aug 1 06:27:40 2017 -0400 ; Auto-commit of loaddefs files. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index dababdb4fa..0cb2eb4c31 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -1102,6 +1102,15 @@ options only, i.e. behave like `apropos-user-option'. \(fn PATTERN &optional DO-NOT-ALL)" t nil) +(autoload 'apropos-local-variable "apropos" "\ +Show buffer-local variables that match PATTERN. +Optional arg BUFFER (default: current buffer) is the buffer to check. + +The output includes variables that are not yet set in BUFFER, but that +will be buffer-local when set. + +\(fn PATTERN &optional BUFFER)" t nil) + (defalias 'command-apropos 'apropos-command) (autoload 'apropos-command "apropos" "\ @@ -1167,6 +1176,13 @@ Returns list of symbols and values found. \(fn PATTERN &optional DO-ALL)" t nil) +(autoload 'apropos-local-value "apropos" "\ +Show buffer-local variables whose values match PATTERN. +This is like `apropos-value', but only for buffer-local variables. +Optional arg BUFFER (default: current buffer) is the buffer to check. + +\(fn PATTERN &optional BUFFER)" t nil) + (autoload 'apropos-documentation "apropos" "\ Show symbols whose documentation contains matches for PATTERN. PATTERN can be a word, a list of words (separated by spaces), @@ -2878,6 +2894,8 @@ columns on its right towards the left. (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) +(put 'bug-reference-bug-regexp 'safe-local-variable 'stringp) + (autoload 'bug-reference-mode "bug-reference" "\ Toggle hyperlinking bug references in the buffer (Bug Reference mode). With a prefix argument ARG, enable Bug Reference mode if ARG is @@ -7684,6 +7702,46 @@ in `.emacs'. ;;;*** +;;;### (autoloads nil "display-line-numbers" "display-line-numbers.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from display-line-numbers.el + +(autoload 'display-line-numbers-mode "display-line-numbers" "\ +Toggle display of line numbers in the buffer. +This uses `display-line-numbers' internally. + +To change the type of line numbers displayed by default, +customize `display-line-numbers-type'. To change the type while +the mode is on, set `display-line-numbers' directly. + +\(fn &optional ARG)" t nil) + +(defvar global-display-line-numbers-mode nil "\ +Non-nil if Global Display-Line-Numbers mode is enabled. +See the `global-display-line-numbers-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-display-line-numbers-mode'.") + +(custom-autoload 'global-display-line-numbers-mode "display-line-numbers" nil) + +(autoload 'global-display-line-numbers-mode "display-line-numbers" "\ +Toggle Display-Line-Numbers mode in all buffers. +With prefix ARG, enable Global Display-Line-Numbers mode if ARG is positive; +otherwise, disable it. If called from Lisp, enable the mode if +ARG is omitted or nil. + +Display-Line-Numbers mode is enabled in all buffers where +`display-line-numbers--turn-on' would do it. +See `display-line-numbers-mode' for more information on Display-Line-Numbers mode. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "display-line-numbers" '("display-line-numbers-"))) + +;;;*** + ;;;### (autoloads nil "dissociate" "play/dissociate.el" (0 0 0 0)) ;;; Generated autoloads from play/dissociate.el @@ -11892,9 +11950,12 @@ Render FILE using EWW. (autoload 'eww-search-words "eww" "\ Search the web for the text between BEG and END. -See the `eww-search-prefix' variable for the search engine used. +If region is active (and not whitespace), search the web for +the text between BEG and END. Else, prompt the user for a search +string. See the `eww-search-prefix' variable for the search +engine used. -\(fn &optional BEG END)" t nil) +\(fn)" t nil) (autoload 'eww-mode "eww" "\ Mode for browsing the web. @@ -11935,7 +11996,7 @@ command to find the next error. The buffer is also in `comint-mode' and (autoload 'executable-set-magic "executable" "\ Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. -The variables `executable-magicless-file-regexp', `executable-prefix', +The variables `executable-magicless-file-regexp', `executable-prefix-env', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable. @@ -12316,7 +12377,8 @@ If `ffap-url-regexp' is not nil, the FILENAME may also be an URL. With a prefix, this command behaves exactly like `ffap-file-finder'. If `ffap-require-prefix' is set, the prefix meaning is reversed. See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt', -and the functions `ffap-file-at-point' and `ffap-url-at-point'. +`ffap-url-unwrap-local', `ffap-url-unwrap-remote', and the functions +`ffap-file-at-point' and `ffap-url-at-point'. \(fn &optional FILENAME)" t nil) @@ -14998,8 +15060,12 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist '(("^\\(.*?[^/\n]\\):[ ]*\\([1-9][0-9]*\\)[ ]*:" 1 2 ((lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) (when mbeg (- mbeg beg))))) lambda nil (when grep-highlight-matches (let* ((beg (match-end 0)) (end (save-excursion (goto-char beg) (line-end-position))) (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) (when mend (- mend beg)))))) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ -Regexp used to match grep hits. See `compilation-error-regexp-alist'.") +(autoload 'grep-regexp-alist "grep" "\ +Return a regexp alist to match grep hits. +The regexp used depends on `grep-use-null-filename-separator'. +See `compilation-error-regexp-alist' for format details. + +\(fn)" nil nil) (defvar grep-program (purecopy "grep") "\ The default grep program for `grep-command' and `grep-find-command'. @@ -19147,7 +19213,8 @@ Use \\[kmacro-insert-counter] to insert (and increment) the macro counter. The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter]. The format of the counter can be modified via \\[kmacro-set-format]. -Use \\[kmacro-name-last-macro] to give it a permanent name. +Use \\[kmacro-name-last-macro] to give it a name that will remain valid even +after another macro is defined. Use \\[kmacro-bind-to-key] to bind it to a key sequence. \(fn ARG)" t nil) @@ -19175,8 +19242,8 @@ just the last key in the key sequence that you used to call this command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg' for details on how to adjust or disable this behavior. -To make a macro permanent so you can call it even after defining -others, use \\[kmacro-name-last-macro]. +To give a macro a name so you can call it even after defining others, +use \\[kmacro-name-last-macro]. \(fn ARG &optional NO-REPEAT END-MACRO MACRO)" t nil) @@ -19211,8 +19278,8 @@ Call last keyboard macro, ending it first if currently being defined. With numeric prefix ARG, repeat macro that many times. Zero argument means repeat until there is an error. -To give a macro a permanent name, so you can call it -even after defining other macros, use \\[kmacro-name-last-macro]. +To give a macro a name, so you can call it even after defining other +macros, use \\[kmacro-name-last-macro]. \(fn ARG &optional NO-REPEAT)" t nil) @@ -19522,7 +19589,7 @@ something strange, such as redefining an Emacs function. \(fn FEATURE &optional FORCE)" t nil) -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("unload-" "loadhist-hook-functions" "read-feature" "feature-" "file-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "loadhist" '("loadhist-" "unload-" "read-feature" "feature-" "file-"))) ;;;*** @@ -20360,7 +20427,7 @@ Default bookmark handler for Man buffers. ;;;### (autoloads nil "map" "emacs-lisp/map.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/map.el -(push (purecopy '(map 1 1)) package--builtin-versions) +(push (purecopy '(map 1 2)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "map" '("map"))) @@ -22710,10 +22777,25 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-J" "org/ob-J.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-J.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-J" '("obj-" "org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-R" "org/ob-R.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-R.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("org-babel-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-R" '("ob-R-" "org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-abc" "org/ob-abc.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-abc.el +(push (purecopy '(ob-abc 0 1)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-abc" '("org-babel-"))) ;;;*** @@ -22753,6 +22835,13 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-coq" "org/ob-coq.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-coq.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-coq" '("org-babel-" "coq-program-name"))) + +;;;*** + ;;;### (autoloads "actual autoloads are elsewhere" "ob-core" "org/ob-core.el" ;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/ob-core.el @@ -22782,6 +22871,14 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-ebnf" "org/ob-ebnf.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-ebnf.el +(push (purecopy '(ob-ebnf 1 0)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-ebnf" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-emacs-lisp" "org/ob-emacs-lisp.el" (0 0 ;;;;;; 0 0)) ;;; Generated autoloads from org/ob-emacs-lisp.el @@ -22804,6 +22901,13 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-forth" "org/ob-forth.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-forth.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-forth" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-fortran" "org/ob-fortran.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-fortran.el @@ -22818,6 +22922,13 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-groovy" "org/ob-groovy.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-groovy.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-groovy" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-haskell" "org/ob-haskell.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-haskell.el @@ -22857,7 +22968,7 @@ Many aspects this mode can be customized using ;;;### (autoloads nil "ob-latex" "org/ob-latex.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-latex.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-" "convert-pdf"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-latex" '("org-babel-"))) ;;;*** @@ -22890,6 +23001,13 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-lua" "org/ob-lua.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-lua.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-lua" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-makefile" "org/ob-makefile.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-makefile.el @@ -22953,6 +23071,14 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-processing" "org/ob-processing.el" (0 0 +;;;;;; 0 0)) +;;; Generated autoloads from org/ob-processing.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-processing" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-python" "org/ob-python.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-python.el @@ -23002,10 +23128,18 @@ Many aspects this mode can be customized using ;;;*** -;;;### (autoloads nil "ob-sh" "org/ob-sh.el" (0 0 0 0)) -;;; Generated autoloads from org/ob-sh.el +;;;### (autoloads nil "ob-sed" "org/ob-sed.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-sed.el +(push (purecopy '(ob-sed 0 1 0)) package--builtin-versions) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sed" '("org-babel-"))) + +;;;*** + +;;;### (autoloads nil "ob-shell" "org/ob-shell.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-shell.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sh" '("org-babel-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-shell" '("org-babel-"))) ;;;*** @@ -23019,7 +23153,7 @@ Many aspects this mode can be customized using ;;;### (autoloads nil "ob-sql" "org/ob-sql.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-sql.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-" "dbstring-mysql"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-sql" '("org-babel-"))) ;;;*** @@ -23030,6 +23164,13 @@ Many aspects this mode can be customized using ;;;*** +;;;### (autoloads nil "ob-stan" "org/ob-stan.el" (0 0 0 0)) +;;; Generated autoloads from org/ob-stan.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "ob-stan" '("org-babel-"))) + +;;;*** + ;;;### (autoloads nil "ob-table" "org/ob-table.el" (0 0 0 0)) ;;; Generated autoloads from org/ob-table.el @@ -23137,7 +23278,7 @@ Load the languages defined in `org-babel-load-languages'. \(fn SYM VALUE)" nil nil) (autoload 'org-babel-load-file "org" "\ -Load Emacs Lisp source code blocks in the Org-mode FILE. +Load Emacs Lisp source code blocks in the Org FILE. This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'. With prefix arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp @@ -23146,10 +23287,11 @@ file to byte-code before it is loaded. \(fn FILE &optional COMPILE)" t nil) (autoload 'org-version "org" "\ -Show the org-mode version in the echo area. -With prefix argument HERE, insert it at point. -When FULL is non-nil, use a verbose version string. -When MESSAGE is non-nil, display a message with the version. +Show the Org version. +Interactively, or when MESSAGE is non-nil, show it in echo area. +With prefix argument, or when HERE is non-nil, insert it at point. +In non-interactive uses, a reduced version string is output unless +FULL is given. \(fn &optional HERE FULL MESSAGE)" t nil) @@ -23167,15 +23309,15 @@ Set up hooks for clock persistence. Outline-based notes management and organizer, alias \"Carsten's outline-mode for keeping track of everything.\" -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content +Org mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org mode is +implemented on top of Outline mode, which is ideal to keep the content of large files well structured. It supports ToDo items, deadlines and time stamps, which magically appear in the diary listing of the Emacs calendar. Tables are easily created with a built-in table editor. Plain text URL-like links connect to websites, emails (VM), Usenet messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) +For printing and sharing of notes, an Org file (or a part of it) can be exported as a structured ASCII or HTML file. The following commands are available: @@ -23185,58 +23327,60 @@ The following commands are available: \(fn)" t nil) (autoload 'org-cycle "org" "\ -TAB-action and visibility cycling for Org-mode. +TAB-action and visibility cycling for Org mode. -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions in special contexts. -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) +When this function is called with a `\\[universal-argument]' prefix, rotate the entire +buffer through 3 states (global cycling) 1. OVERVIEW: Show only top-level headlines. 2. CONTENTS: Show all headlines of all levels, but no body text. 3. SHOW ALL: Show everything. - When called with two `C-u C-u' prefixes, switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - When called with three `C-u C-u C-u' prefixed, show the entire buffer, - including any drawers. -- When inside a table, re-align the table and move to the next field. +With a `\\[universal-argument] \\[universal-argument]' prefix argument, switch to the startup visibility, +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. + +With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) +When inside a table, re-align the table and move to the next field. + +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) 1. FOLDED: Only the main headline is shown. 2. CHILDREN: The main headline and the direct children are shown. From this state, you can move to one of the children and zoom in further. 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. +If there is no subtree, switch directly from CHILDREN to FOLDED. -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (C-u TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t. +As a special case, if point is at the beginning of the buffer and there is +no headline in line 1, this function will act as if called with prefix arg +\(`\\[universal-argument] TAB', same as `S-TAB') also when called without prefix arg, but only +if the variable `org-cycle-global-at-bob' is t. \(fn &optional ARG)" t nil) (autoload 'org-global-cycle "org" "\ Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. With a numeric prefix, show all headlines up to that level. \(fn &optional ARG)" t nil) @@ -23244,10 +23388,10 @@ With a numeric prefix, show all headlines up to that level. (autoload 'orgstruct-mode "org" "\ Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if +This mode is for using Org mode structure commands in other +modes. The following keys behave as if Org mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode). +defined by Org mode). \(fn &optional ARG)" t nil) @@ -23262,61 +23406,59 @@ Unconditionally turn on `orgstruct++-mode'. \(fn)" nil nil) (autoload 'org-run-like-in-org-mode "org" "\ -Run a command, pretending that the current buffer is in Org-mode. +Run a command, pretending that the current buffer is in Org mode. This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively +Org mode to the values they have in Org mode, and then interactively call CMD. \(fn CMD)" nil nil) (autoload 'org-store-link "org" "\ -\\Store an org-link to the current location. +Store an org-link to the current location. +\\ This link is added to `org-stored-links' and can later be inserted -into an org-buffer with \\[org-insert-link]. +into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a prefix arg is interpreted. -For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. A single +`\\[universal-argument]' negates `org-context-in-file-links' for file links or +`org-gnus-prefer-web-links' for links to Usenet articles. -A double prefix arg force skipping storing functions that are not -part of Org's core. +A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not +part of Org core. -A triple prefix arg force storing a link for each line in the +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix ARG forces storing a link for each line in the active region. \(fn ARG)" t nil) (autoload 'org-insert-link-global "org" "\ -Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax. +Insert a link like Org mode does. +This command can be called in any mode to insert a link in Org syntax. \(fn)" t nil) (autoload 'org-open-at-point-global "org" "\ -Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax. +Follow a link or time-stamp like Org mode does. +This command can be called in any mode to follow an external link +or a time-stamp that has Org mode syntax. Its behavior is +undefined when called on internal links (e.g., fuzzy links). +Raise an error when there is nothing to follow. \(fn)" t nil) (autoload 'org-open-link-from-string "org" "\ -Open a link in the string S, as if it was in Org-mode. +Open a link in the string S, as if it was in Org mode. \(fn S &optional ARG REFERENCE-BUFFER)" t nil) (autoload 'org-switchb "org" "\ Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. - -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead. -\(fn &optional ARG)" t nil) +With `\\[universal-argument]' prefix, restrict available buffers to files. -(defalias 'org-ido-switchb 'org-switchb) +With `\\[universal-argument] \\[universal-argument]' prefix, restrict available buffers to agenda files. -(defalias 'org-iswitchb 'org-switchb) +\(fn &optional ARG)" t nil) (autoload 'org-cycle-agenda-files "org" "\ Cycle through the files in `org-agenda-files'. @@ -23326,13 +23468,13 @@ If the current buffer does not, find the first agenda file. \(fn)" t nil) (autoload 'org-submit-bug-report "org" "\ -Submit a bug report on Org-mode via mail. +Submit a bug report on Org via mail. Don't hesitate to report any problems or inaccurate documentation. If you don't have setup sending mail from (X)Emacs, please copy the output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration. +information about your Org version and configuration. \(fn)" t nil) @@ -23388,9 +23530,9 @@ More commands can be added by configuring the variable `org-agenda-custom-commands'. In particular, specific tags and TODO keyword searches can be pre-defined in this way. -If the current buffer is in Org-mode and visiting a file, you can also +If the current buffer is in Org mode and visiting a file, you can also first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. +\(until the next use of `\\[org-agenda]') restricted to the current file. Pressing `<' twice means to restrict to the current subtree or region \(if active). @@ -23519,7 +23661,7 @@ in `org-agenda-text-search-extra-files'. (autoload 'org-todo-list "org-agenda" "\ Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted +the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'. @@ -23575,22 +23717,22 @@ Do we have a reason to ignore this TODO entry because it has a time stamp? (autoload 'org-agenda-set-restriction-lock "org-agenda" "\ Set restriction lock for agenda, to current subtree or file. -Restriction will be the file if TYPE is `file', or if TYPE is the -universal prefix `(4)', or if the cursor is before the first headline +Restriction will be the file if TYPE is `file', or if type is the +universal prefix \\='(4), or if the cursor is before the first headline in the file. Otherwise, restriction will be to the current subtree. \(fn &optional TYPE)" t nil) (autoload 'org-calendar-goto-agenda "org-agenda" "\ -Compute the Org-mode agenda for the calendar date displayed at the cursor. +Compute the Org agenda for the calendar date displayed at the cursor. This is a command that has to be installed in `calendar-mode-map'. \(fn)" t nil) (autoload 'org-agenda-to-appt "org-agenda" "\ Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of -appointments. + +With a `\\[universal-argument]' prefix, refresh the list of appointments. If FILTER is t, interactively prompt the user for a regular expression, and filter out entries that don't match it. @@ -23605,8 +23747,8 @@ argument: an entry from `org-agenda-get-day-entries'. FILTER can also be an alist with the car of each cell being either `headline' or `category'. For example: - ((headline \"IMPORTANT\") - (category \"Work\")) + \\='((headline \"IMPORTANT\") + (category \"Work\")) will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category. @@ -23668,16 +23810,17 @@ Capture STRING with the template selected by KEYS. (autoload 'org-capture "org-capture" "\ Capture something. \\ -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. +This will let you select a template from `org-capture-templates', and +then file the newly captured information. The text is immediately +inserted at the target location, and an indirect buffer is shown where +you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the previous +state of Emacs, so that you can continue your work. + +When called interactively with a `\\[universal-argument]' prefix argument GOTO, don't +capture anything, just go to the file/headline where the selected +template stores its notes. -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note -stored. +With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to the last note stored. When called with a `C-0' (zero) prefix, insert a template at point. @@ -23723,26 +23866,29 @@ Remove all currently active column overlays. \(fn)" nil nil) (autoload 'org-columns "org-colview" "\ -Turn on column view on an org-mode file. +Turn on column view on an Org mode file. + +Column view applies to the whole buffer if point is before the +first headline. Otherwise, it applies to the first ancestor +setting \"COLUMNS\" property. If there is none, it defaults to +the current headline. With a `\\[universal-argument]' prefix argument, turn on column +view for the whole buffer unconditionally. + When COLUMNS-FMT-STRING is non-nil, use it as the column format. -\(fn &optional COLUMNS-FMT-STRING)" t nil) +\(fn &optional GLOBAL COLUMNS-FMT-STRING)" t nil) (autoload 'org-columns-compute "org-colview" "\ -Sum the values of property PROPERTY hierarchically, for the entire buffer. +Summarize the values of PROPERTY hierarchically. +Also update existing values for PROPERTY according to the first +column specification. \(fn PROPERTY)" t nil) -(autoload 'org-columns-number-to-string "org-colview" "\ -Convert a computed column number to a string value, according to FMT. - -\(fn N FMT &optional PRINTF)" nil nil) - (autoload 'org-dblock-write:columnview "org-colview" "\ Write the column view table. PARAMS is a property list of parameters: -:width enforce same column widths with specifiers. :id the :ID: property of the entry where the columns view should be built. When the symbol `local', call locally. When `global' call column view with the cursor at the beginning @@ -23752,15 +23898,17 @@ PARAMS is a property list of parameters: using `org-id-find'. :hlines When t, insert a hline before each item. When a number, insert a hline before each level <= that number. +:indent When non-nil, indent each ITEM field according to its level. :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows When t, skip rows where all specifiers other than ITEM are empty. +:width apply widths specified in columns format using specifiers. :format When non-nil, specify the column view format to use. \(fn PARAMS)" nil nil) -(autoload 'org-insert-columns-dblock "org-colview" "\ +(autoload 'org-columns-insert-dblock "org-colview" "\ Create a dynamic block capturing a column view table. \(fn)" t nil) @@ -23796,7 +23944,7 @@ Try very hard to provide sensible version strings. ;;;### (autoloads nil "org-ctags" "org/org-ctags.el" (0 0 0 0)) ;;; Generated autoloads from org/org-ctags.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-" "y-or-n-minibuffer"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-ctags" '("org-ctags-"))) ;;;*** @@ -23827,7 +23975,7 @@ Try very hard to provide sensible version strings. ;;;;;; 0)) ;;; Generated autoloads from org/org-entities.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("replace-amp" "org-entit"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-entities" '("org-entit"))) ;;;*** @@ -23838,6 +23986,13 @@ Try very hard to provide sensible version strings. ;;;*** +;;;### (autoloads nil "org-eww" "org/org-eww.el" (0 0 0 0)) +;;; Generated autoloads from org/org-eww.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-eww" '("org-eww-"))) + +;;;*** + ;;;### (autoloads nil "org-faces" "org/org-faces.el" (0 0 0 0)) ;;; Generated autoloads from org/org-faces.el @@ -23864,7 +24019,7 @@ Try very hard to provide sensible version strings. ;;;### (autoloads nil "org-gnus" "org/org-gnus.el" (0 0 0 0)) ;;; Generated autoloads from org/org-gnus.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-gnus-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-gnus" '("org-"))) ;;;*** @@ -23914,6 +24069,24 @@ Try very hard to provide sensible version strings. ;;;*** +;;;### (autoloads nil "org-lint" "org/org-lint.el" (0 0 0 0)) +;;; Generated autoloads from org/org-lint.el + +(autoload 'org-lint "org-lint" "\ +Check current Org buffer for syntax mistakes. + +By default, run all checkers. With a `\\[universal-argument]' prefix ARG, select one +category of checkers only. With a `\\[universal-argument] \\[universal-argument]' prefix, run one precise +checker by its name. + +ARG can also be a list of checker names, as symbols, to run. + +\(fn &optional ARG)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-lint" '("org-lint-"))) + +;;;*** + ;;;### (autoloads nil "org-list" "org/org-list.el" (0 0 0 0)) ;;; Generated autoloads from org/org-list.el @@ -23932,7 +24105,7 @@ Try very hard to provide sensible version strings. ;;; Generated autoloads from org/org-macs.el (autoload 'org-load-noerror-mustsuffix "org-macs" "\ -Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it. +Load FILE with optional arguments NOERROR and MUSTSUFFIX. \(fn FILE)" nil t) @@ -24004,7 +24177,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;;;;; (0 0 0 0)) ;;; Generated autoloads from org/org-table.el -(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org" "*orgtbl-"))) +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "org-table" '("org"))) ;;;*** @@ -24020,14 +24193,14 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a ;;; Generated autoloads from org/org-version.el (autoload 'org-release "org-version" "\ -The release version of org-mode. - Inserted by installing org-mode or when a release is made. +The release version of Org. +Inserted by installing Org mode or when a release is made. \(fn)" nil nil) (autoload 'org-git-version "org-version" "\ The Git version of org-mode. - Inserted by installing org-mode or when a release is made. +Inserted by installing Org or when a release is made. \(fn)" nil nil) @@ -26220,7 +26393,7 @@ Optional argument FACE specifies the face to do the highlighting. ;;; Generated autoloads from progmodes/python.el (push (purecopy '(python 0 25 2)) package--builtin-versions) -(add-to-list 'auto-mode-alist (cons (purecopy "\\.pyw?\\'") 'python-mode)) +(add-to-list 'auto-mode-alist (cons (purecopy "\\.py[iw]?\\'") 'python-mode)) (add-to-list 'interpreter-mode-alist (cons (purecopy "python[0-9.]*") 'python-mode)) @@ -34153,7 +34326,7 @@ Reenable Ange-FTP, when Tramp is unloaded. ;;;### (autoloads nil "trampver" "net/trampver.el" (0 0 0 0)) ;;; Generated autoloads from net/trampver.el -(push (purecopy '(tramp 2 3 2)) package--builtin-versions) +(push (purecopy '(tramp 2 3 3 -1)) package--builtin-versions) (if (fboundp 'register-definition-prefixes) (register-definition-prefixes "trampver" '("tramp-"))) commit c5305ff6c40a2650ed9878f69ce58829927c3978 Author: Tino Calancha Date: Tue Aug 1 19:00:59 2017 +0900 Add more should form calls in a failing dired test Some dired tests fail intermittently in hydra. Add few more should form calls for debugging. See: https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg01092.html * test/lisp/dired-tests.el (dired-test-bug27243-01): Add few more should forms for debugging. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index d6fe839708..0ee4e13783 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -122,11 +122,18 @@ (ert-deftest dired-test-bug27243-01 () "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." - (let ((test-dir (make-temp-file "test-dir-" t)) + (let ((test-dir (file-name-as-directory (make-temp-file "test-dir-" t))) (dired-auto-revert-buffer t) buffers) + (should-not (dired-buffers-for-dir test-dir)) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) + ;; Point must be at end-of-buffer. + (with-current-buffer (car (dired-buffers-for-dir test-dir)) + (should (eobp))) (push (dired test-dir) buffers) + ;; Previous dired call shouldn't create a new buffer: must visit the one + ;; created by `find-file-noselect' above. + (should (eq 1 (length (dired-buffers-for-dir test-dir)))) (unwind-protect (let ((buf (current-buffer)) (pt1 (point)) @@ -135,11 +142,10 @@ (write-region "Test" nil test-file nil 'silent nil 'excl) ;; Sanity check: point should now be on the subdirectory. (should (equal (dired-file-name-at-point) - (concat (file-name-as-directory test-dir) - (file-name-as-directory "test-subdir")))) + (concat test-dir (file-name-as-directory "test-subdir")))) (push (dired-find-file) buffers) (let ((pt2 (point))) ; Point is on test-file. - (switch-to-buffer buf) + (pop-to-buffer-same-window buf) ;; Sanity check: point should now be back on the subdirectory. (should (eq (point) pt1)) (push (dired-find-file) buffers) commit ef7a18a071446ee7a5366bb4d4cbf766661d6bd0 Author: Michael Albinus Date: Tue Aug 1 10:13:09 2017 +0200 Follow SAUNA recommendations for display-line-numbers-type * lisp/display-line-numbers.el (display-line-numbers-type): Do not autoload. * lisp/menu-bar.el (display-line-numbers-type): Declare. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index a99474547b..c9dd28a40f 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -38,7 +38,6 @@ "Display line numbers in the buffer." :group 'display) -;;;###autoload (defcustom display-line-numbers-type t "The default type of line numbers to use in `display-line-numbers-mode'. See `display-line-numbers' for value options." diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 05a336bfe2..75ffd1e2b4 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1101,6 +1101,7 @@ The selected font will be the default on both the existing and future frames." :button (:radio . (eq tool-bar-mode nil)))) menu))) +(defvar display-line-numbers-type) (defun menu-bar-display-line-numbers-mode (type) (setq display-line-numbers-type type) (if global-display-line-numbers-mode commit 3a8d0cc825635e07da2a90c4ac987b476fc9b05d Author: Paul Eggert Date: Mon Jul 31 12:31:02 2017 -0700 Avoid most stat calls when completing file names * admin/merge-gnulib (GNULIB_MODULES): Add d-type. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * m4/d-type.m4: New file, copied from gnulib. * src/dired.c (DT_UNKNOWN, DT_DIR, DT_LINK) [!HAVE_STRUCT_DIRENT_D_TYPE]: New constants. (dirent_type): New function. (file_name_completion): Use it, to avoid unnecessary calls to stat-like functions on GNU/Linux and other platforms with d_type. (file_name_completion_stat): Just follow the link; there is no need to try first with AT_SYMLINK_NOFOLLOW since the directory entry was already checked to exist. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 18c9ee8def..c23e8a40ea 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -30,7 +30,8 @@ GNULIB_MODULES=' careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 - diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat + d-type diffseq dtoastr dtotimespec dup2 + environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 3e57391372..11c1ecf05a 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 d-type diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump diff --git a/m4/d-type.m4 b/m4/d-type.m4 new file mode 100644 index 0000000000..c819fc02f8 --- /dev/null +++ b/m4/d-type.m4 @@ -0,0 +1,32 @@ +# serial 12 + +dnl From Jim Meyering. +dnl +dnl Check whether struct dirent has a member named d_type. +dnl + +# Copyright (C) 1997, 1999-2004, 2006, 2009-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE], + [AC_CACHE_CHECK([for d_type member in directory struct], + [gl_cv_struct_dirent_d_type], + [AC_LINK_IFELSE([AC_LANG_PROGRAM([[ +#include +#include + ]], + [[struct dirent dp; dp.d_type = 0;]])], + [gl_cv_struct_dirent_d_type=yes], + [gl_cv_struct_dirent_d_type=no]) + ] + ) + if test $gl_cv_struct_dirent_d_type = yes; then + AC_DEFINE([HAVE_STRUCT_DIRENT_D_TYPE], [1], + [Define if there is a member named d_type in the struct describing + directory headers.]) + fi + ] +) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 2f13577393..188c116c85 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -61,6 +61,7 @@ AC_DEFUN([gl_EARLY], # Code from module crypto/sha1: # Code from module crypto/sha256: # Code from module crypto/sha512: + # Code from module d-type: # Code from module diffseq: # Code from module dirent: # Code from module dirfd: @@ -199,6 +200,7 @@ AC_DEFUN([gl_INIT], gl_SHA1 gl_SHA256 gl_SHA512 + gl_CHECK_TYPE_STRUCT_DIRENT_D_TYPE gl_DIRENT_H AC_REQUIRE([gl_C99_STRTOLD]) gl_FUNC_DUP2 @@ -968,6 +970,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/count-leading-zeros.m4 m4/count-one-bits.m4 m4/count-trailing-zeros.m4 + m4/d-type.m4 m4/dirent_h.m4 m4/dirfd.m4 m4/dup2.m4 diff --git a/src/dired.c b/src/dired.c index 5ea00fb8db..288ba6b103 100644 --- a/src/dired.c +++ b/src/dired.c @@ -64,6 +64,21 @@ dirent_namelen (struct dirent *dp) #endif } +#ifndef HAVE_STRUCT_DIRENT_D_TYPE +enum { DT_UNKNOWN, DT_DIR, DT_LNK }; +#endif + +/* Return the file type of DP. */ +static int +dirent_type (struct dirent *dp) +{ +#ifdef HAVE_STRUCT_DIRENT_D_TYPE + return dp->d_type; +#else + return DT_UNKNOWN; +#endif +} + static DIR * open_directory (Lisp_Object dirname, int *fdp) { @@ -434,7 +449,7 @@ is matched against file and directory names relative to DIRECTORY. */) return file_name_completion (file, directory, 1, Qnil); } -static int file_name_completion_stat (int, struct dirent *, struct stat *); +static bool file_name_completion_dirp (int, struct dirent *, ptrdiff_t); static Lisp_Object file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, @@ -448,7 +463,6 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, Lisp_Object bestmatch, tem, elt, name; Lisp_Object encoded_file; Lisp_Object encoded_dir; - struct stat st; bool directoryp; /* If not INCLUDEALL, exclude files in completion-ignored-extensions as well as "." and "..". Until shown otherwise, assume we can't exclude @@ -512,10 +526,21 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag, >= 0)) continue; - if (file_name_completion_stat (fd, dp, &st) < 0) - continue; + switch (dirent_type (dp)) + { + case DT_DIR: + directoryp = true; + break; + + case DT_LNK: case DT_UNKNOWN: + directoryp = file_name_completion_dirp (fd, dp, len); + break; + + default: + directoryp = false; + break; + } - directoryp = S_ISDIR (st.st_mode) != 0; tem = Qnil; /* If all_flag is set, always include all. It would not actually be helpful to the user to ignore any possible @@ -781,32 +806,18 @@ scmp (const char *s1, const char *s2, ptrdiff_t len) return len - l; } -static int -file_name_completion_stat (int fd, struct dirent *dp, struct stat *st_addr) +/* Return true if in the directory FD the directory entry DP, whose + string length is LEN, is that of a subdirectory that can be searched. */ +static bool +file_name_completion_dirp (int fd, struct dirent *dp, ptrdiff_t len) { - int value; - -#ifdef MSDOS - /* Some fields of struct stat are *very* expensive to compute on MS-DOS, - but aren't required here. Avoid computing the following fields: - st_inode, st_size and st_nlink for directories, and the execute bits - in st_mode for non-directory files with non-standard extensions. */ - - unsigned short save_djstat_flags = _djstat_flags; - - _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE; -#endif /* MSDOS */ - - /* We want to return success if a link points to a nonexistent file, - but we want to return the status for what the link points to, - in case it is a directory. */ - value = fstatat (fd, dp->d_name, st_addr, AT_SYMLINK_NOFOLLOW); - if (value == 0 && S_ISLNK (st_addr->st_mode)) - fstatat (fd, dp->d_name, st_addr, 0); -#ifdef MSDOS - _djstat_flags = save_djstat_flags; -#endif /* MSDOS */ - return value; + USE_SAFE_ALLOCA; + char *subdir_name = SAFE_ALLOCA (len + 2); + memcpy (subdir_name, dp->d_name, len); + strcpy (subdir_name + len, "/"); + bool dirp = faccessat (fd, subdir_name, F_OK, AT_EACCESS) == 0; + SAFE_FREE (); + return dirp; } static char * commit 192342a3a93a2e467ab589ae2d1ffd5e7acf1398 Author: Tino Calancha Date: Mon Jul 31 21:51:12 2017 +0900 dired-tests: Unload tested features after test them Some tests are for Dired with ls-lisp or eshell-ls. Requiring these features add an advice on `dired' and might affect other tests. Do not require these features at the top of the file; require then inside the tests and unload then at the end. * test/lisp/dired-tests.el (dired-test-bug27693) (dired-test-bug7131, dired-test-bug27817, dired-test-bug27631): require ls-lisp and/or eshell-ls inside the test; unload the features at the end. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index cd58edaa3f..d6fe839708 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -21,7 +21,6 @@ (require 'ert) (require 'dired) (require 'nadvice) -(require 'ls-lisp) (ert-deftest dired-autoload () "Tests to see whether dired-x has been autoloaded" @@ -212,6 +211,7 @@ (ert-deftest dired-test-bug27693 () "Test for http://debbugs.gnu.org/27693 ." + (require 'ls-lisp) (let ((dir (expand-file-name "lisp" source-directory)) (size "") ls-lisp-use-insert-directory-program buf) @@ -223,6 +223,7 @@ (file-attributes (dired-get-filename))))) (search-backward-regexp size nil t) (should (looking-back "[[:space:]]" (1- (point))))) + (unload-feature 'ls-lisp 'force) (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest dired-test-bug7131 () @@ -244,6 +245,7 @@ (ert-deftest dired-test-bug27762 () "Test for http://debbugs.gnu.org/27762 ." :expected-result :failed + (require 'ls-lisp) (let* ((dir source-directory) (default-directory dir) (files (mapcar (lambda (f) (concat "src/" f)) @@ -262,6 +264,7 @@ (should (looking-at "src")) (next-line) ; File names must be aligned. (should (looking-at "src"))) + (unload-feature 'ls-lisp 'force) (when (buffer-live-p buf) (kill-buffer buf))))) (ert-deftest dired-test-bug27817 () @@ -275,6 +278,7 @@ (customize-set-variable 'eshell-ls-use-in-dired t) (should (setq buf (dired source-directory)))) (customize-set-variable 'eshell-ls-use-in-dired orig) + (unload-feature 'em-ls 'force) (and (buffer-live-p buf) (kill-buffer))))) (ert-deftest dired-test-bug27631 () @@ -311,6 +315,7 @@ (setq buf (dired (expand-file-name "dir*/*.txt" dir))) (dired-toggle-marks) (should (cdr (dired-get-marked-files))))) + (unload-feature 'em-ls 'force) (delete-directory dir 'recursive) (when (buffer-live-p buf) (kill-buffer buf))))) commit 3d58ea1c0ba821a4d6915d6beeaa1617d4ad606f Author: Michael Albinus Date: Mon Jul 31 14:32:24 2017 +0200 Small adaptions for directory wildcards * lisp/dired.el (dired-insert-directory): Remove "--dired" when there are wildcards, and the directory is remote. * test/lisp/net/tramp-tests.el (tramp--test-make-temp-name): Adapt docstring. (tramp-test17-dired-with-wildcards): Skip for all methods but those from tamp-sh.p. diff --git a/lisp/dired.el b/lisp/dired.el index ca005785d6..c502dd8a50 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1228,6 +1228,11 @@ see `dired-use-ls-dired' for more details.") (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) (cond (dir-wildcard (setq switches (concat "-d " switches)) + ;; We don't know whether the remote ls supports + ;; "--dired", so we cannot add it to the `process-file' + ;; call for wildcards. + (when (file-remote-p dir) + (setq switches (dired-replace-in-string "--dired" "" switches))) (let ((default-directory (car dir-wildcard)) (script (format "ls %s %s" switches (cdr dir-wildcard)))) (unless diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 3e28eb62fc..d76629038f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -123,9 +123,10 @@ being the result.") (cdr tramp--test-enabled-checked)) (defun tramp--test-make-temp-name (&optional local quoted) - "Create a temporary file name for test. -If LOCAL is non-nil, a local file is created. -If QUOTED is non-nil, the local part of the file is quoted." + "Return a temporary file name for test. +If LOCAL is non-nil, a local file name is returned. +If QUOTED is non-nil, the local part of the file name is quoted. +The temporary file is not created." (funcall (if quoted 'tramp-compat-file-name-quote 'identity) (expand-file-name @@ -2204,6 +2205,8 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." (ert-deftest tramp-test17-dired-with-wildcards () "Check `dired' with wildcards." (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + ;; Since Emacs 26.1. (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) @@ -3107,6 +3110,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) + ;; Since Emacs 26.1. (skip-unless (and (fboundp 'connection-local-set-profile-variables) (fboundp 'connection-local-set-profiles))) @@ -3316,6 +3320,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (ert-deftest tramp-test33-make-nearby-temp-file () "Check `make-nearby-temp-file' and `temporary-file-directory'." (skip-unless (tramp--test-enabled)) + ;; Since Emacs 26.1. (skip-unless (and (fboundp 'make-nearby-temp-file) (fboundp 'temporary-file-directory))) @@ -3902,7 +3907,7 @@ process sentinels. They shall not disturb each other." (count (process-get proc 'bar))) (tramp--test-message "Start action %d %s %s" count buf (current-time-string)) - ;; Regular operation. + ;; Regular operation prior process action. (if (= count 0) (should-not (file-attributes file)) (should (file-attributes file))) @@ -3911,7 +3916,7 @@ process sentinels. They shall not disturb each other." (accept-process-output proc 0.1 nil 0) ;; Give the watchdog a chance. (read-event nil nil 0.01) - ;; Regular operation. + ;; Regular operation post process action. (tramp--test-instrument-test-case 10 (if (= count 2) (should-not (file-attributes file)) commit 55d62d344a0c2ad6c2726fae04366b2a3ed87f6f Author: Michael Albinus Date: Mon Jul 31 09:43:04 2017 +0200 ; Change instrumentation code in tramp-tests.el diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 979f674f0f..3e28eb62fc 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -149,7 +149,6 @@ handled properly. BODY shall not contain a timeout." (debug-ignored-errors (cons "^make-symbolic-link not supported$" debug-ignored-errors)) inhibit-message) - (message "tramp--test-instrument-test-case %s" tramp-verbose) (unwind-protect (let ((tramp--test-instrument-test-case-p t)) ,@body) ;; Unwind forms. @@ -3908,23 +3907,15 @@ process sentinels. They shall not disturb each other." (should-not (file-attributes file)) (should (file-attributes file))) ;; Send string to process. - (tramp--test-message - "Trace 1 action %d %s %s" count buf (current-time-string)) (process-send-string proc (format "%s\n" (buffer-name buf))) - (tramp--test-message - "Trace 2 action %d %s %s" count buf (current-time-string)) (accept-process-output proc 0.1 nil 0) - (tramp--test-message - "Trace 3 action %d %s %s" count buf (current-time-string)) ;; Give the watchdog a chance. (read-event nil nil 0.01) ;; Regular operation. - (if (= count 2) - (if (= (length buffers) 1) - (tramp--test-instrument-test-case 10 - (should-not (file-attributes file))) - (should-not (file-attributes file))) - (should (file-attributes file))) + (tramp--test-instrument-test-case 10 + (if (= count 2) + (should-not (file-attributes file)) + (should (file-attributes file)))) (tramp--test-message "Stop action %d %s %s" count buf (current-time-string)) (process-put proc 'bar (1+ count)) commit 6ebef3daf24c847d6f16621489ae587e98c11ec0 Author: Tino Calancha Date: Mon Jul 31 14:55:47 2017 +0900 * lisp/dired (dired-trivial-filenames): Use \` and \' to match string bounds diff --git a/lisp/dired.el b/lisp/dired.el index a056ad679f..ca005785d6 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -133,7 +133,7 @@ always set this variable to t." :type 'boolean :group 'dired-mark) -(defcustom dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#") +(defcustom dired-trivial-filenames (purecopy "\\`\\.\\.?\\'\\|\\`#") "Regexp of files to skip when finding first file of a directory. A value of nil means move to the subdir line. A value of t means move to first file." commit ebce9c2440e69a1c521cb6ad58a909161cfefc7e Author: Paul Eggert Date: Sun Jul 30 22:46:58 2017 -0700 Merge from gnulib This incorporates: 2017-07-30 Don't interpret EOVERFLOW to mean nonexistence * lib/tempname.c: Copy from gnulib. diff --git a/lib/tempname.c b/lib/tempname.c index 2cd90328bd..9c4a3c2a54 100644 --- a/lib/tempname.c +++ b/lib/tempname.c @@ -279,7 +279,7 @@ try_nocreate (char *tmpl, void *flags _GL_UNUSED) { struct_stat64 st; - if (__lxstat64 (_STAT_VER, tmpl, &st) == 0) + if (__lxstat64 (_STAT_VER, tmpl, &st) == 0 || errno == EOVERFLOW) __set_errno (EEXIST); return errno == ENOENT ? 0 : -1; } commit dcfcaf40d577808d640016c886d4fae7280a7fd5 Author: Eli Zaretskii Date: Sun Jul 30 22:42:18 2017 +0300 ; Don't use non-ASCII quotes in comments * src/regex.h: * src/regex.c (re_wctype_parse): Don't use non-ASCII quotes in comments. diff --git a/src/regex.c b/src/regex.c index fb48765c96..0dbb47309e 100644 --- a/src/regex.c +++ b/src/regex.c @@ -1942,7 +1942,7 @@ struct range_table_work_area returned. If name is not a valid character class name zero, or RECC_ERROR, is returned. - Otherwise, if *strp doesn’t begin with "[:name:]", -1 is returned. + Otherwise, if *strp doesn't begin with "[:name:]", -1 is returned. The function can be used on ASCII and multibyte (UTF-8-encoded) strings. */ @@ -1954,8 +1954,8 @@ re_wctype_parse (const unsigned char **strp, unsigned limit) if (limit < 4 || beg[0] != '[' || beg[1] != ':') return -1; - beg += 2; /* skip opening ‘[:’ */ - limit -= 3; /* opening ‘[:’ and half of closing ‘:]’; --limit handles rest */ + beg += 2; /* skip opening "[:" */ + limit -= 3; /* opening "[:" and half of closing ":]"; --limit handles rest */ for (it = beg; it[0] != ':' || it[1] != ']'; ++it) if (!--limit) return -1; @@ -1985,7 +1985,7 @@ re_wctype_parse (const unsigned char **strp, unsigned limit) 2 [:cntrl:] 1 [:ff:] - If you update this list, consider also updating chain of or’ed conditions + If you update this list, consider also updating chain of or'ed conditions in execute_charset function. */ diff --git a/src/regex.h b/src/regex.h index 1d439de259..5e3a79763e 100644 --- a/src/regex.h +++ b/src/regex.h @@ -21,7 +21,7 @@ #define _REGEX_H 1 #if defined emacs && (defined _REGEX_RE_COMP || defined _LIBC) -/* We’re not defining re_set_syntax and using a different prototype of +/* We're not defining re_set_syntax and using a different prototype of re_compile_pattern when building Emacs so fail compilation early with a (somewhat helpful) error message when conflict is detected. */ # error "_REGEX_RE_COMP nor _LIBC can be defined if emacs is defined." commit c8f44e4b53c40dfea1c83ad0ff3bd653e72c4f4e Author: Tino Calancha Date: Sun Jul 30 20:28:33 2017 +0900 ls-lisp: Do not require em-glob at top of the file Require em-glob inside 'ls-lisp--dired'. This is necessary to not break the Emacs build. See following thread for details: https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg01083.html * lisp/ls-lisp.el (dired-goto-next-file) (dired-read-dir-and-switches, eshell-extended-glob): Add function declarations. * lisp/eshell/em-ls.el (dired-goto-next-file): Fix function declaration. diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 948ac38b5f..4a5adc48f2 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -283,7 +283,7 @@ instead." (declare-function eshell-extended-glob "em-glob" (glob)) (declare-function dired-read-dir-and-switches "dired" (str)) -(declare-function dired-goto-next-file "em-glob" ()) +(declare-function dired-goto-next-file "dired" ()) (defun eshell-ls--dired (orig-fun dir-or-list &optional switches) (interactive (dired-read-dir-and-switches "")) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 56780daa09..2f723ca8ac 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -61,7 +61,6 @@ ;;; Code: -(require 'em-glob) (defgroup ls-lisp nil "Emulate the ls program completely in Emacs Lisp." @@ -481,8 +480,13 @@ not contain `d', so that a full listing is expected." (ding) (sit-for 2))))) ; to show user the message! +(declare-function eshell-extended-glob "em-glob" (glob)) +(declare-function dired-read-dir-and-switches "dired" (str)) +(declare-function dired-goto-next-file "dired" ()) + (defun ls-lisp--dired (orig-fun dir-or-list &optional switches) (interactive (dired-read-dir-and-switches "")) + (require 'em-glob) (if (consp dir-or-list) (funcall orig-fun dir-or-list switches) (let ((dir-wildcard (insert-directory-wildcard-in-dir-p commit 6c106712a8d2ffd0c932541cb50cc59a6df732f4 Author: Michael Albinus Date: Sun Jul 30 13:11:00 2017 +0200 * lisp/dired.el (dired-insert-directory): Move `file-remote-p' check up. diff --git a/lisp/dired.el b/lisp/dired.el index e09691b07c..a056ad679f 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1209,19 +1209,20 @@ If HDR is non-nil, insert a header line with the directory name." ;; as indicated by `ls-lisp-use-insert-directory-program'. (not (and (featurep 'ls-lisp) (null ls-lisp-use-insert-directory-program))) - (not (and (featurep 'eshell) (bound-and-true-p eshell-ls-use-in-dired))) - (or (if (eq dired-use-ls-dired 'unspecified) + (not (and (featurep 'eshell) + (bound-and-true-p eshell-ls-use-in-dired))) + (or (file-remote-p dir) + (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and ;; save the answer in `dired-use-ls-dired'. (or (setq dired-use-ls-dired (eq 0 (call-process insert-directory-program - nil nil nil "--dired"))) + nil nil nil "--dired"))) (progn (message "ls does not support --dired; \ see `dired-use-ls-dired' for more details.") nil)) - dired-use-ls-dired) - (file-remote-p dir))) + dired-use-ls-dired))) (setq switches (concat "--dired " switches))) ;; Expand directory wildcards and fill file-list. (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) @@ -1229,13 +1230,18 @@ see `dired-use-ls-dired' for more details.") (setq switches (concat "-d " switches)) (let ((default-directory (car dir-wildcard)) (script (format "ls %s %s" switches (cdr dir-wildcard)))) - (unless (zerop (process-file "/bin/sh" nil (current-buffer) nil "-c" script)) - (user-error "%s: No files matching wildcard" (cdr dir-wildcard))) + (unless + (zerop + (process-file + "/bin/sh" nil (current-buffer) nil "-c" script)) + (user-error + "%s: No files matching wildcard" (cdr dir-wildcard))) (insert-directory-clean (point) switches))) (t - ;; We used to specify the C locale here, to force English month names; - ;; but this should not be necessary any more, - ;; with the new value of `directory-listing-before-filename-regexp'. + ;; We used to specify the C locale here, to force English + ;; month names; but this should not be necessary any + ;; more, with the new value of + ;; `directory-listing-before-filename-regexp'. (if file-list (dolist (f file-list) (let ((beg (point))) commit 65d428228bb57ce434a8eb5a4eeb2274171586b8 Author: Michael Albinus Date: Sun Jul 30 13:08:36 2017 +0200 * test/lisp/net/tramp-tests.el (tramp-test17-dired-with-wildcards): New test. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 4ae7b88024..979f674f0f 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -2202,6 +2202,108 @@ This tests also `file-directory-p' and `file-accessible-directory-p'." ;; Cleanup. (ignore-errors (delete-directory tmp-name1 'recursive)))))) +(ert-deftest tramp-test17-dired-with-wildcards () + "Check `dired' with wildcards." + (skip-unless (tramp--test-enabled)) + (skip-unless (fboundp 'insert-directory-wildcard-in-dir-p)) + + (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) + (let* ((tmp-name1 + (expand-file-name (tramp--test-make-temp-name nil quoted))) + (tmp-name2 + (expand-file-name (tramp--test-make-temp-name nil quoted))) + (tmp-name3 (expand-file-name "foo" tmp-name1)) + (tmp-name4 (expand-file-name "bar" tmp-name2)) + (tramp-test-temporary-file-directory + (funcall + (if quoted 'tramp-compat-file-name-quote 'identity) + tramp-test-temporary-file-directory)) + buffer) + (unwind-protect + (progn + (make-directory tmp-name1) + (write-region "foo" nil tmp-name3) + (should (file-directory-p tmp-name1)) + (should (file-exists-p tmp-name3)) + (make-directory tmp-name2) + (write-region "foo" nil tmp-name4) + (should (file-directory-p tmp-name2)) + (should (file-exists-p tmp-name4)) + + ;; Check for expanded directory names. + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name1 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name2 tramp-test-temporary-file-directory))))) + (kill-buffer buffer) + + ;; Check for expanded directory and file names. + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*/*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name3 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name4 + tramp-test-temporary-file-directory))))) + (kill-buffer buffer) + + ;; Check for special characters. + (setq tmp-name3 (expand-file-name "*?" tmp-name1)) + (setq tmp-name4 (expand-file-name "[a-z0-9]" tmp-name2)) + (write-region "foo" nil tmp-name3) + (should (file-exists-p tmp-name3)) + (write-region "foo" nil tmp-name4) + (should (file-exists-p tmp-name4)) + + (with-current-buffer + (setq buffer + (dired-noselect + (expand-file-name + "tramp-test*/*" tramp-test-temporary-file-directory))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name3 tramp-test-temporary-file-directory)))) + (goto-char (point-min)) + (should + (re-search-forward + (regexp-quote + (file-relative-name + tmp-name4 + tramp-test-temporary-file-directory))))) + (kill-buffer buffer)) + + ;; Cleanup. + (ignore-errors (kill-buffer buffer)) + (ignore-errors (delete-directory tmp-name1 'recursive)) + (ignore-errors (delete-directory tmp-name2 'recursive)))))) + (ert-deftest tramp-test18-file-attributes () "Check `file-attributes'. This tests also `file-readable-p', `file-regular-p' and @@ -3812,11 +3914,11 @@ process sentinels. They shall not disturb each other." (tramp--test-message "Trace 2 action %d %s %s" count buf (current-time-string)) (accept-process-output proc 0.1 nil 0) - ;; Regular operation. (tramp--test-message "Trace 3 action %d %s %s" count buf (current-time-string)) ;; Give the watchdog a chance. (read-event nil nil 0.01) + ;; Regular operation. (if (= count 2) (if (= (length buffers) 1) (tramp--test-instrument-test-case 10 commit 4219240e1df6abbd842f4474fe7862f341cc355a Author: Simen Heggestøyl Date: Sun Jul 30 11:16:58 2017 +0200 Change default CSS property face * lisp/textmodes/css-mode.el (css-property): Inherit from `font-lock-keyword-face' instead of `font-lock-variable-name-face' to distinguish CSS properties from variables. diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b37e6dce1a..19cb7b4fea 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -835,7 +835,7 @@ cannot be completed sensibly: `custom-ident', (defface css-selector '((t :inherit font-lock-function-name-face)) "Face to use for selectors." :group 'css) -(defface css-property '((t :inherit font-lock-variable-name-face)) +(defface css-property '((t :inherit font-lock-keyword-face)) "Face to use for properties." :group 'css) (defface css-proprietary-property '((t :inherit (css-property italic))) commit 6f6639d6ed6c6314b2643f6c22498fc2e23d34c7 Author: Tino Calancha Date: Sun Jul 30 11:02:49 2017 +0900 Dired: Handle posix wildcards in directory part Allow Dired to handle calls like \(dired \"~/foo/*/*.el\"), that is, with wildcards within the directory part of the file argument (Bug#27631). * lisp/files.el (insert-directory-wildcard-in-dir-p): New predicate. (insert-directory-clean): New defun extracted from insert-directory. (insert-directory) * lisp/dired.el (dired-internal-noselect) (dired-insert-directory): Use the new predicate; when it's true, handle the directory wildcards with a shell call. * lisp/eshell/em-ls.el (eshell-ls-use-in-dired): Add/remove both advices. (eshell-ls-unload-hook): New defun. Use it in eshell-ls-unload-hook instead of an anonymous function. (eshell-ls--dired) * lisp/ls-lisp.el (ls-lisp--dired): Advice dired to handle wildcards in the directory part with both eshell-ls and ls-lisp. * etc/NEWS: Announce it. * doc/emacs/dired.texi (Dired Enter): Update manual. * test/lisp/dired-tests.el (dired-test-bug27631): Add test. diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index ddd7229b0c..150ac8427a 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -64,10 +64,22 @@ you to operate on the listed files. @xref{Directories}. directory name using the minibuffer, and opens a @dfn{Dired buffer} listing the files in that directory. You can also supply a wildcard file name pattern as the minibuffer argument, in which case the Dired -buffer lists all files matching that pattern. The usual history and -completion commands can be used in the minibuffer; in particular, -@kbd{M-n} puts the name of the visited file (if any) in the minibuffer -(@pxref{Minibuffer History}). +buffer lists all files matching that pattern. A wildcard may appear +in the directory part as well. +For instance, + +@example +C-x d ~/foo/*.el @key{RET} +C-x d ~/foo/*/*.el @key{RET} +@end example + +The former lists all the files with extension @samp{.el} in directory +@samp{foo}. The latter lists the files with extension @samp{.el} +in subdirectories 2 levels of depth below @samp{foo}. + +The usual history and completion commands can be used in the minibuffer; +in particular, @kbd{M-n} puts the name of the visited file (if any) in +the minibuffer (@pxref{Minibuffer History}). You can also invoke Dired by giving @kbd{C-x C-f} (@code{find-file}) a directory name. diff --git a/etc/NEWS b/etc/NEWS index a785c6a86b..44f5ff5bde 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -608,6 +608,9 @@ paragraphs, for the purposes of bidirectional display. ** Dired ++++ +*** Dired supports wildcards in the directory part of the file names. + +++ *** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced by the current file name. diff --git a/lisp/dired.el b/lisp/dired.el index 3b29c7129d..e09691b07c 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -920,11 +920,12 @@ periodically reverts at specified time intervals." "Directory has changed on disk; type \\[revert-buffer] to update Dired"))))) ;; Else a new buffer (setq default-directory - ;; We can do this unconditionally - ;; because dired-noselect ensures that the name - ;; is passed in directory name syntax - ;; if it was the name of a directory at all. - (file-name-directory dirname)) + (or (car-safe (insert-directory-wildcard-in-dir-p dirname)) + ;; We can do this unconditionally + ;; because dired-noselect ensures that the name + ;; is passed in directory name syntax + ;; if it was the name of a directory at all. + (file-name-directory dirname))) (or switches (setq switches dired-listing-switches)) (if mode (funcall mode) (dired-mode dir-or-list switches)) @@ -1056,13 +1057,14 @@ wildcards, erases the buffer, and builds the subdir-alist anew (not file-list)) ;; If we are reading a whole single directory... (dired-insert-directory dir dired-actual-switches nil nil t) - (if (not (file-readable-p - (directory-file-name (file-name-directory dir)))) - (error "Directory %s inaccessible or nonexistent" dir) - ;; Else treat it as a wildcard spec - ;; unless we have an explicit list of files. - (dired-insert-directory dir dired-actual-switches - file-list (not file-list) t))))) + (if (and (not (insert-directory-wildcard-in-dir-p dir)) + (not (file-readable-p + (directory-file-name (file-name-directory dir))))) + (error "Directory %s inaccessible or nonexistent" dir)) + ;; Else treat it as a wildcard spec + ;; unless we have an explicit list of files. + (dired-insert-directory dir dired-actual-switches + file-list (not file-list) t)))) (defun dired-align-file (beg end) "Align the fields of a file to the ones of surrounding lines. @@ -1221,16 +1223,26 @@ see `dired-use-ls-dired' for more details.") dired-use-ls-dired) (file-remote-p dir))) (setq switches (concat "--dired " switches))) - ;; We used to specify the C locale here, to force English month names; - ;; but this should not be necessary any more, - ;; with the new value of `directory-listing-before-filename-regexp'. - (if file-list - (dolist (f file-list) - (let ((beg (point))) - (insert-directory f switches nil nil) - ;; Re-align fields, if necessary. - (dired-align-file beg (point)))) - (insert-directory dir switches wildcard (not wildcard))) + ;; Expand directory wildcards and fill file-list. + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p dir))) + (cond (dir-wildcard + (setq switches (concat "-d " switches)) + (let ((default-directory (car dir-wildcard)) + (script (format "ls %s %s" switches (cdr dir-wildcard)))) + (unless (zerop (process-file "/bin/sh" nil (current-buffer) nil "-c" script)) + (user-error "%s: No files matching wildcard" (cdr dir-wildcard))) + (insert-directory-clean (point) switches))) + (t + ;; We used to specify the C locale here, to force English month names; + ;; but this should not be necessary any more, + ;; with the new value of `directory-listing-before-filename-regexp'. + (if file-list + (dolist (f file-list) + (let ((beg (point))) + (insert-directory f switches nil nil) + ;; Re-align fields, if necessary. + (dired-align-file beg (point)))) + (insert-directory dir switches wildcard (not wildcard)))))) ;; Quote certain characters, unless ls quoted them for us. (if (not (dired-switches-escape-p dired-actual-switches)) (save-excursion @@ -1280,11 +1292,14 @@ see `dired-use-ls-dired' for more details.") ;; Note that dired-build-subdir-alist will replace the name ;; by its expansion, so it does not matter whether what we insert ;; here is fully expanded, but it should be absolute. - (insert " " (directory-file-name (file-name-directory dir)) ":\n") + (insert " " (or (car-safe (insert-directory-wildcard-in-dir-p dir)) + (directory-file-name (file-name-directory dir))) ":\n") (setq content-point (point))) (when wildcard ;; Insert "wildcard" line where "total" line would be for a full dir. - (insert " wildcard " (file-name-nondirectory dir) "\n"))) + (insert " wildcard " (or (cdr-safe (insert-directory-wildcard-in-dir-p dir)) + (file-name-nondirectory dir)) + "\n"))) (dired-insert-set-properties content-point (point))))) (defun dired-insert-set-properties (beg end) diff --git a/lisp/eshell/em-ls.el b/lisp/eshell/em-ls.el index 79799db30b..948ac38b5f 100644 --- a/lisp/eshell/em-ls.el +++ b/lisp/eshell/em-ls.el @@ -65,17 +65,19 @@ This is useful for enabling human-readable format (-h), for example." "If non-nil, use `eshell-ls' to read directories in Dired. Changing this without using customize has no effect." :set (lambda (symbol value) - (if value - (advice-add 'insert-directory :around - #'eshell-ls--insert-directory) - (advice-remove 'insert-directory - #'eshell-ls--insert-directory)) + (cond (value + (require 'dired) + (advice-add 'insert-directory :around + #'eshell-ls--insert-directory) + (advice-add 'dired :around #'eshell-ls--dired)) + (t + (advice-remove 'insert-directory + #'eshell-ls--insert-directory) + (advice-remove 'dired #'eshell-ls--dired))) (set symbol value)) :type 'boolean :require 'em-ls) -(add-hook 'eshell-ls-unload-hook - (lambda () (advice-remove 'insert-directory - #'eshell-ls--insert-directory))) +(add-hook 'eshell-ls-unload-hook #'eshell-ls-unload-function) (defcustom eshell-ls-default-blocksize 1024 @@ -279,6 +281,36 @@ instead." eshell-ls-dired-initial-args) (eshell-do-ls (append switches (list file))))))))) +(declare-function eshell-extended-glob "em-glob" (glob)) +(declare-function dired-read-dir-and-switches "dired" (str)) +(declare-function dired-goto-next-file "em-glob" ()) + +(defun eshell-ls--dired (orig-fun dir-or-list &optional switches) + (interactive (dired-read-dir-and-switches "")) + (require 'em-glob) + (if (consp dir-or-list) + (funcall orig-fun dir-or-list switches) + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p + (expand-file-name dir-or-list)))) + (if (not dir-wildcard) + (funcall orig-fun dir-or-list switches) + (let* ((default-directory (car dir-wildcard)) + (files (eshell-extended-glob (cdr dir-wildcard))) + (dir (car dir-wildcard))) + (if files + (let ((inhibit-read-only t) + (buf + (apply orig-fun + (nconc (list dir) files) + (and switches (list switches))))) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + (forward-line 0) + (insert " wildcard " (cdr dir-wildcard) "\n")))) + (user-error "No files matching regexp"))))))) + (defsubst eshell/ls (&rest args) "An alias version of `eshell-do-ls'." (let ((insert-func 'eshell-buffered-print) @@ -909,6 +941,11 @@ to use, and each member of which is the width of that column (car file))))) (car file)) +(defun eshell-ls-unload-function () + (advice-remove 'insert-directory #'eshell-ls--insert-directory) + (advice-remove 'dired #'eshell-ls--dired) + nil) + (provide 'em-ls) ;; Local Variables: diff --git a/lisp/files.el b/lisp/files.el index 6ce2fe98b0..96647fb262 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -6555,6 +6555,75 @@ regardless of the language.") (defvar insert-directory-ls-version 'unknown) +(defun insert-directory-wildcard-in-dir-p (dir) + "Return non-nil if DIR contents a shell wildcard in the directory part. +The return value is a cons (DIR . WILDCARDS); DIR is the +`default-directory' in the Dired buffer, and WILDCARDS are the wildcards. + +Valid wildcards are '*', '?', '[abc]' and '[a-z]'." + (let ((wildcards "[?*")) + (when (and (or (not (featurep 'ls-lisp)) + ls-lisp-support-shell-wildcards) + (string-match (concat "[" wildcards "]") (file-name-directory dir)) + (not (file-exists-p dir))) ; Prefer an existing file to wildcards. + (let ((regexp (format "\\`\\([^%s]+/\\)\\([^%s]*[%s].*\\)" + wildcards wildcards wildcards))) + (string-match regexp dir) + (cons (match-string 1 dir) (match-string 2 dir)))))) + +(defun insert-directory-clean (beg switches) + (when (if (stringp switches) + (string-match "--dired\\>" switches) + (member "--dired" switches)) + ;; The following overshoots by one line for an empty + ;; directory listed with "--dired", but without "-a" + ;; switch, where the ls output contains a + ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. + ;; We take care of that case later. + (forward-line -2) + (when (looking-at "//SUBDIRED//") + (delete-region (point) (progn (forward-line 1) (point))) + (forward-line -1)) + (if (looking-at "//DIRED//") + (let ((end (line-end-position)) + (linebeg (point)) + error-lines) + ;; Find all the lines that are error messages, + ;; and record the bounds of each one. + (goto-char beg) + (while (< (point) linebeg) + (or (eql (following-char) ?\s) + (push (list (point) (line-end-position)) error-lines)) + (forward-line 1)) + (setq error-lines (nreverse error-lines)) + ;; Now read the numeric positions of file names. + (goto-char linebeg) + (forward-word-strictly 1) + (forward-char 3) + (while (< (point) end) + (let ((start (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines)) + (end (insert-directory-adj-pos + (+ beg (read (current-buffer))) + error-lines))) + (if (memq (char-after end) '(?\n ?\s)) + ;; End is followed by \n or by " -> ". + (put-text-property start end 'dired-filename t) + ;; It seems that we can't trust ls's output as to + ;; byte positions of filenames. + (put-text-property beg (point) 'dired-filename nil) + (end-of-line)))) + (goto-char end) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; Take care of the case where the ls output contains a + ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line + ;; and we went one line too far back (see above). + (forward-line 1)) + (if (looking-at "//DIRED-OPTIONS//") + (delete-region (point) (progn (forward-line 1) (point)))))) + ;; insert-directory ;; - must insert _exactly_one_line_ describing FILE if WILDCARD and ;; FULL-DIRECTORY-P is nil. @@ -6614,13 +6683,19 @@ normally equivalent short `-D' option is just passed on to default-file-name-coding-system)))) (setq result (if wildcard - ;; Run ls in the directory part of the file pattern - ;; using the last component as argument. - (let ((default-directory - (if (file-name-absolute-p file) - (file-name-directory file) - (file-name-directory (expand-file-name file)))) - (pattern (file-name-nondirectory file))) + ;; If the wildcard is just in the file part, then run ls in + ;; the directory part of the file pattern using the last + ;; component as argument. Otherwise, run ls in the longest + ;; subdirectory of the directory part free of wildcards; use + ;; the remaining of the file pattern as argument. + (let* ((dir-wildcard (insert-directory-wildcard-in-dir-p file)) + (default-directory + (cond (dir-wildcard (car dir-wildcard)) + (t + (if (file-name-absolute-p file) + (file-name-directory file) + (file-name-directory (expand-file-name file)))))) + (pattern (if dir-wildcard (cdr dir-wildcard) (file-name-nondirectory file)))) ;; NB since switches is passed to the shell, be ;; careful of malicious values, eg "-l;reboot". ;; See eg dired-safe-switches-p. @@ -6668,7 +6743,8 @@ normally equivalent short `-D' option is just passed on to (setq file (expand-file-name file))) (list (if full-directory-p - (concat (file-name-as-directory file) ".") + ;; (concat (file-name-as-directory file) ".") + file file)))))))) ;; If we got "//DIRED//" in the output, it means we got a real @@ -6739,59 +6815,7 @@ normally equivalent short `-D' option is just passed on to ;; Unix. Access the file to get a suitable error. (access-file file "Reading directory") (error "Listing directory failed but `access-file' worked"))) - - (when (if (stringp switches) - (string-match "--dired\\>" switches) - (member "--dired" switches)) - ;; The following overshoots by one line for an empty - ;; directory listed with "--dired", but without "-a" - ;; switch, where the ls output contains a - ;; "//DIRED-OPTIONS//" line, but no "//DIRED//" line. - ;; We take care of that case later. - (forward-line -2) - (when (looking-at "//SUBDIRED//") - (delete-region (point) (progn (forward-line 1) (point))) - (forward-line -1)) - (if (looking-at "//DIRED//") - (let ((end (line-end-position)) - (linebeg (point)) - error-lines) - ;; Find all the lines that are error messages, - ;; and record the bounds of each one. - (goto-char beg) - (while (< (point) linebeg) - (or (eql (following-char) ?\s) - (push (list (point) (line-end-position)) error-lines)) - (forward-line 1)) - (setq error-lines (nreverse error-lines)) - ;; Now read the numeric positions of file names. - (goto-char linebeg) - (forward-word-strictly 1) - (forward-char 3) - (while (< (point) end) - (let ((start (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines)) - (end (insert-directory-adj-pos - (+ beg (read (current-buffer))) - error-lines))) - (if (memq (char-after end) '(?\n ?\s)) - ;; End is followed by \n or by " -> ". - (put-text-property start end 'dired-filename t) - ;; It seems that we can't trust ls's output as to - ;; byte positions of filenames. - (put-text-property beg (point) 'dired-filename nil) - (end-of-line)))) - (goto-char end) - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Take care of the case where the ls output contains a - ;; "//DIRED-OPTIONS//"-line, but no "//DIRED//"-line - ;; and we went one line too far back (see above). - (forward-line 1)) - (if (looking-at "//DIRED-OPTIONS//") - (delete-region (point) (progn (forward-line 1) (point))))) - + (insert-directory-clean beg switches) ;; Now decode what read if necessary. (let ((coding (or coding-system-for-read file-name-coding-system diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 730ba26c6c..56780daa09 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -60,6 +60,9 @@ ;;; Code: + +(require 'em-glob) + (defgroup ls-lisp nil "Emulate the ls program completely in Emacs Lisp." :version "21.1" @@ -477,6 +480,32 @@ not contain `d', so that a full listing is expected." (message "%s: doesn't exist or is inaccessible" file) (ding) (sit-for 2))))) ; to show user the message! + +(defun ls-lisp--dired (orig-fun dir-or-list &optional switches) + (interactive (dired-read-dir-and-switches "")) + (if (consp dir-or-list) + (funcall orig-fun dir-or-list switches) + (let ((dir-wildcard (insert-directory-wildcard-in-dir-p + (expand-file-name dir-or-list)))) + (if (not dir-wildcard) + (funcall orig-fun dir-or-list switches) + (let* ((default-directory (car dir-wildcard)) + (files (eshell-extended-glob (cdr dir-wildcard))) + (dir (car dir-wildcard))) + (if files + (let ((inhibit-read-only t) + (buf + (apply orig-fun (nconc (list dir) files) (and switches (list switches))))) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (dired-goto-next-file) + (forward-line 0) + (insert " wildcard " (cdr dir-wildcard) "\n")))) + (user-error "No files matching regexp"))))))) + +(advice-add 'dired :around #'ls-lisp--dired) + (defun ls-lisp-sanitize (file-alist) "Sanitize the elements in FILE-ALIST. Fixes any elements in the alist for directory entries whose file @@ -869,6 +898,7 @@ All ls time options, namely c, t and u, are handled." (defun ls-lisp-unload-function () "Unload ls-lisp library." (advice-remove 'insert-directory #'ls-lisp--insert-directory) + (advice-remove 'dired #'ls-lisp--dired) ;; Continue standard unloading. nil) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 43a21e1acc..cd58edaa3f 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -277,5 +277,43 @@ (customize-set-variable 'eshell-ls-use-in-dired orig) (and (buffer-live-p buf) (kill-buffer))))) +(ert-deftest dired-test-bug27631 () + "Test for http://debbugs.gnu.org/27631 ." + (let* ((dir (make-temp-file "bug27631" 'dir)) + (dir1 (expand-file-name "dir1" dir)) + (dir2 (expand-file-name "dir2" dir)) + (default-directory dir) + buf) + (unwind-protect + (progn + (make-directory dir1) + (make-directory dir2) + (with-temp-file (expand-file-name "a.txt" dir1)) + (with-temp-file (expand-file-name "b.txt" dir2)) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files))) + ;; Must work with ls-lisp ... + (require 'ls-lisp) + (kill-buffer buf) + (setq default-directory dir) + (let (ls-lisp-use-insert-directory-program) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files)))) + ;; ... And with em-ls as well. + (kill-buffer buf) + (setq default-directory dir) + (unload-feature 'ls-lisp 'force) + (require 'em-ls) + (let ((orig eshell-ls-use-in-dired)) + (customize-set-value 'eshell-ls-use-in-dired t) + (setq buf (dired (expand-file-name "dir*/*.txt" dir))) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files))))) + (delete-directory dir 'recursive) + (when (buffer-live-p buf) (kill-buffer buf))))) + + (provide 'dired-tests) ;; dired-tests.el ends here commit 2c930d15f541761422a268cd2b5a7f5c11c9a00e Author: Tino Calancha Date: Sun Jul 30 01:00:51 2017 +0900 * lisp/find-lisp.el: Enable lexical binding diff --git a/lisp/find-lisp.el b/lisp/find-lisp.el index e9f844487b..a795211f4f 100644 --- a/lisp/find-lisp.el +++ b/lisp/find-lisp.el @@ -1,4 +1,4 @@ -;;; find-lisp.el --- emulation of find in Emacs Lisp +;;; find-lisp.el --- emulation of find in Emacs Lisp -*- lexical-binding: t -*- ;; Author: Peter Breton ;; Created: Fri Mar 26 1999 commit fb09370b37b30a2c5a391b87bddcd2aad918d61c Author: Tino Calancha Date: Sun Jul 30 00:50:52 2017 +0900 * lisp/find-dired.el: Enable lexical binding diff --git a/lisp/find-dired.el b/lisp/find-dired.el index a92d477e1e..2292b5f32d 100644 --- a/lisp/find-dired.el +++ b/lisp/find-dired.el @@ -1,4 +1,4 @@ -;;; find-dired.el --- run a `find' command and dired the output +;;; find-dired.el --- run a `find' command and dired the output -*- lexical-binding: t -*- ;; Copyright (C) 1992, 1994-1995, 2000-2017 Free Software Foundation, ;; Inc. commit d7825cb09eae438a83ed2f5b3e0715523d4ed5b7 Author: Mark Oteiza Date: Sat Jul 29 11:01:57 2017 -0400 * lisp/kmacro.el: Use lexical binding. diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 472972e3ed..2db8061fa4 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -1,4 +1,4 @@ -;;; kmacro.el --- enhanced keyboard macros +;;; kmacro.el --- enhanced keyboard macros -*- lexical-binding: t -*- ;; Copyright (C) 2002-2017 Free Software Foundation, Inc. commit 47cecf350d6add5ab2a20a389b63a011c84cbc1b Author: Mark Oteiza Date: Sat Jul 29 11:00:51 2017 -0400 Use lexical-binding in dired-aux.el * lisp/dired.el: Use lexical binding. (dired-do-shell-command): Remove unused bindings. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 17dae6085d..0a8ec26f7c 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1,4 +1,4 @@ -;;; dired-aux.el --- less commonly used parts of dired +;;; dired-aux.el --- less commonly used parts of dired -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992, 1994, 1998, 2000-2017 Free Software ;; Foundation, Inc. @@ -742,8 +742,6 @@ can be produced by `dired-get-marked-files', for example." (string-match regexp res)))) (let* ((on-each (not (dired--star-or-qmark-p command "*" 'keep))) (no-subst (not (dired--star-or-qmark-p command "?" 'keep))) - (star (string-match "\\*" command)) - (qmark (string-match "\\?" command)) ;; Get confirmation for wildcards that may have been meant ;; to control substitution of a file name or the file name list. (ok (cond ((not (or on-each no-subst)) commit 4246ad2c2aec52a0248b73af13861c413fd8e7b9 Author: Mark Oteiza Date: Sat Jul 29 10:28:57 2017 -0400 * lisp/ido.el: Use lexical binding. diff --git a/lisp/ido.el b/lisp/ido.el index 07a5bcf722..defb744201 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -1,4 +1,4 @@ -;;; ido.el --- interactively do things with buffers and files +;;; ido.el --- interactively do things with buffers and files -*- lexical-binding: t -*- ;; Copyright (C) 1996-2017 Free Software Foundation, Inc. commit eae4fa520b1efeaa31ae01c0979ed2b74bbcbbef Author: Mark Oteiza Date: Sat Jul 29 10:25:49 2017 -0400 * lisp/whitespace.el: Use lexical binding. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index c6d5b16cae..4198b9bd0e 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -1,4 +1,4 @@ -;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE +;;; whitespace.el --- minor mode to visualize TAB, (HARD) SPACE, NEWLINE -*- lexical-binding: t -*- ;; Copyright (C) 2000-2017 Free Software Foundation, Inc. commit 701752827364a9d56ce47343c783ea0fc6a610a1 Author: Stephen Berman Date: Sat Jul 29 13:59:18 2017 +0200 artist.el: Avoid error with keyboard command invocation * lisp/textmodes/artist.el (artist-mouse-choose-operation): Call x-popup-menu with t instead of last-nonmenu-event as the value of the position argument; this allows invoking the command from the keyboard without raising an error (bug#27819). diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index 596570ca4e..cdc2af4a7a 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -4889,7 +4889,7 @@ If optional argument STATE is positive, turn borders on." (select-window (posn-window (event-start last-input-event))) (list last-input-event (if (display-popup-menus-p) - (x-popup-menu last-nonmenu-event artist-popup-menu-table) + (x-popup-menu t artist-popup-menu-table) 'no-popup-menus)))) (if (eq op 'no-popup-menus) commit 8e394b082bd6ecd9ba212cb3ca07cbace66767a6 Author: Stephen Berman Date: Sat Jul 29 13:34:47 2017 +0200 Preserve point under 'dired-auto-revert-buffer' (third case) * lisp/files.el (find-file): Use pop-to-buffer-same-window instead of switch-to-buffer. This preserves Dired window point when dired-auto-revert-buffer is non-nil. (Bug#27243) * test/lisp/dired-tests.el (dired-test-bug27243-01) (dired-test-bug27243-02, dired-test-bug27243-03): New tests. The first two replace a previous test that combined them; that test intermittently fails in the Hydra build system, so maybe separating the two cases will help locate the point of failure. The third test involves find-file but is here because it, like the others, is testing the effect of dired-auto-revert-buffer. diff --git a/lisp/files.el b/lisp/files.el index 6d9957d494..6ce2fe98b0 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1599,8 +1599,8 @@ automatically choosing a major mode, use \\[find-file-literally]." (confirm-nonexistent-file-or-buffer))) (let ((value (find-file-noselect filename nil nil wildcards))) (if (listp value) - (mapcar 'switch-to-buffer (nreverse value)) - (switch-to-buffer value)))) + (mapcar 'pop-to-buffer-same-window (nreverse value)) + (pop-to-buffer-same-window value)))) (defun find-file-other-window (filename &optional wildcards) "Edit file FILENAME, in another window. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 601d65768b..43a21e1acc 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -89,8 +89,40 @@ (advice-remove 'dired-query "advice-dired-query") (advice-remove 'completing-read "advice-completing-read")))) -(ert-deftest dired-test-bug27243 () - "Test for http://debbugs.gnu.org/27243 ." +;; (ert-deftest dired-test-bug27243 () +;; "Test for http://debbugs.gnu.org/27243 ." +;; (let ((test-dir (make-temp-file "test-dir-" t)) +;; (dired-auto-revert-buffer t) buffers) +;; (with-current-buffer (find-file-noselect test-dir) +;; (make-directory "test-subdir")) +;; (push (dired test-dir) buffers) +;; (unwind-protect +;; (let ((buf (current-buffer)) +;; (pt1 (point)) +;; (test-file (concat (file-name-as-directory "test-subdir") +;; "test-file"))) +;; (write-region "Test" nil test-file nil 'silent nil 'excl) +;; ;; Sanity check: point should now be on the subdirectory. +;; (should (equal (dired-file-name-at-point) +;; (concat (file-name-as-directory test-dir) +;; (file-name-as-directory "test-subdir")))) +;; (push (dired-find-file) buffers) +;; (let ((pt2 (point))) ; Point is on test-file. +;; (switch-to-buffer buf) +;; ;; Sanity check: point should now be back on the subdirectory. +;; (should (eq (point) pt1)) +;; ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 +;; (push (dired-find-file) buffers) +;; (should (eq (point) pt2)) +;; ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 +;; (push (dired test-dir) buffers) +;; (should (eq (point) pt1)))) +;; (dolist (buf buffers) +;; (when (buffer-live-p buf) (kill-buffer buf))) +;; (delete-directory test-dir t)))) + +(ert-deftest dired-test-bug27243-01 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 ." (let ((test-dir (make-temp-file "test-dir-" t)) (dired-auto-revert-buffer t) buffers) (with-current-buffer (find-file-noselect test-dir) @@ -111,16 +143,73 @@ (switch-to-buffer buf) ;; Sanity check: point should now be back on the subdirectory. (should (eq (point) pt1)) - ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 (push (dired-find-file) buffers) - (should (eq (point) pt2)) - ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 + (should (eq (point) pt2)))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) + (delete-directory test-dir t)))) + +(ert-deftest dired-test-bug27243-02 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 ." + (let ((test-dir (make-temp-file "test-dir-" t)) + (dired-auto-revert-buffer t) buffers) + (with-current-buffer (find-file-noselect test-dir) + (make-directory "test-subdir")) + (push (dired test-dir) buffers) + (unwind-protect + (let ((buf (current-buffer)) + (pt1 (point)) + (test-file (concat (file-name-as-directory "test-subdir") + "test-file"))) + (write-region "Test" nil test-file nil 'silent nil 'excl) + ;; Sanity check: point should now be on the subdirectory. + (should (equal (dired-file-name-at-point) + (concat (file-name-as-directory test-dir) + (file-name-as-directory "test-subdir")))) + (push (dired-find-file) buffers) + (let ((pt2 (point))) ; Point is on test-file. + (switch-to-buffer buf) + ;; Sanity check: point should now be back on the subdirectory. + (should (eq (point) pt1)) (push (dired test-dir) buffers) (should (eq (point) pt1)))) (dolist (buf buffers) (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory test-dir t)))) +(ert-deftest dired-test-bug27243-03 () + "Test for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#61 ." + (let ((test-dir (make-temp-file "test-dir-" t)) + (dired-auto-revert-buffer t) + test-subdir1 test-subdir2 allbufs) + (unwind-protect + (progn + (with-current-buffer (find-file-noselect test-dir) + (push (current-buffer) allbufs) + (make-directory "test-subdir1") + (make-directory "test-subdir2") + (let ((test-file1 "test-file1") + (test-file2 "test-file2")) + (with-current-buffer (find-file-noselect "test-subdir1") + (push (current-buffer) allbufs) + (write-region "Test1" nil test-file1 nil 'silent nil 'excl)) + (with-current-buffer (find-file-noselect "test-subdir2") + (push (current-buffer) allbufs) + (write-region "Test2" nil test-file2 nil 'silent nil 'excl)))) + ;; Call find-file with a wild card and test point in each file. + (let ((buffers (find-file (concat (file-name-as-directory test-dir) + "*") + t))) + (dolist (buf buffers) + (let ((pt (with-current-buffer buf (point)))) + (switch-to-buffer (find-file-noselect test-dir)) + (find-file (buffer-name buf)) + (should (equal (point) pt)))) + (append buffers allbufs))) + (dolist (buf allbufs) + (when (buffer-live-p buf) (kill-buffer buf))) + (delete-directory test-dir t)))) + (ert-deftest dired-test-bug27693 () "Test for http://debbugs.gnu.org/27693 ." (let ((dir (expand-file-name "lisp" source-directory)) commit dfee60fe66f3d9fe4249c9662d802753f3e50929 Author: Allen Li Date: Sat Jul 29 12:00:56 2017 +0300 Do not unset user key remaps in dired-x * lisp/dired-x.el (dired-x-bind-find-file): Don't map any keys if user sets dired-x-hands-off-my-keys. (Bug#27828) Copyright-paperwork-exempt: yes diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 915550991d..1425278bdc 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -1629,10 +1629,11 @@ Binding direction based on `dired-x-hands-off-my-keys'." (if (called-interactively-p 'interactive) (setq dired-x-hands-off-my-keys (not (y-or-n-p "Bind dired-x-find-file over find-file? ")))) - (define-key (current-global-map) [remap find-file] - (if (not dired-x-hands-off-my-keys) 'dired-x-find-file)) - (define-key (current-global-map) [remap find-file-other-window] - (if (not dired-x-hands-off-my-keys) 'dired-x-find-file-other-window))) + (unless dired-x-hands-off-my-keys + (define-key (current-global-map) [remap find-file] + 'dired-x-find-file) + (define-key (current-global-map) [remap find-file-other-window] + 'dired-x-find-file-other-window))) ;; Now call it so binding is correct. This could go in the :initialize ;; slot, but then dired-x-bind-find-file has to be defined before the commit d3fcb9241339357869969547924e02bed6f661cd Author: Eli Zaretskii Date: Sat Jul 29 11:25:29 2017 +0300 Improve documentation of 'occur' * doc/emacs/search.texi (Other Repeating Search): * lisp/replace.el (occur): Make the documentation of 'occur' be more accurate when matches overlap. (Bug#27818) diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index c9e83da173..9f7e9a12cd 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -1747,6 +1747,10 @@ at the first match after such line. You can also run @kbd{M-s o} when an incremental search is active; this uses the current search string. +Note that matches for the regexp you type are extended to include +complete lines, and a match that starts before the previous match ends +is not considered a match. + @kindex RET @r{(Occur mode)} @kindex o @r{(Occur mode)} @kindex C-o @r{(Occur mode)} diff --git a/lisp/replace.el b/lisp/replace.el index 64dfe7da22..a5024943e6 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -1395,6 +1395,11 @@ invoke `occur'." "Show all lines in the current buffer containing a match for REGEXP. If a match spreads across multiple lines, all those lines are shown. +Each match is extended to include complete lines. Only non-overlapping +matches are considered. (Note that extending matches to complete +lines could cause some of the matches to overlap; if so, they will not +be shown as separate matches.) + Each line is displayed with NLINES lines before and after, or -NLINES before if NLINES is negative. NLINES defaults to `list-matching-lines-default-context-lines'. commit a00083cedec8151ec5c27e6cb41e1ec5572356f5 Author: Eli Zaretskii Date: Sat Jul 29 10:56:57 2017 +0300 Minor copyedits of comments in faces.el * lisp/faces.el (face-font-family-alternatives): More info about requirements from "Monospace Serif". diff --git a/lisp/faces.el b/lisp/faces.el index 97c32165b9..c0c1c7b59f 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -104,7 +104,9 @@ a font height that isn't optimal." ;; when combined with Monospaced and with other standard fonts. ;; One of its uses is for 'tex-verbatim' and 'Info-quoted' faces, ;; so the result must be different from the default face's font, - ;; and must be monospaced. + ;; and must be monospaced. For 'tex-verbatim', it is desirable + ;; that the font really is a Serif font, so as to look like + ;; TeX's 'verbatim'. ("Monospace Serif" ;; This looks good on GNU/Linux. commit 51f5d3b525388d146205adf54aca95b86abdcb84 Author: Eli Zaretskii Date: Sat Jul 29 10:43:23 2017 +0300 ; Revert "; * .gitignore: Add .deps/." This reverts commit f1ed31a8f5c6f19aa5e119e670533241c6375945. diff --git a/.gitignore b/.gitignore index 05a8d6b533..9229297833 100644 --- a/.gitignore +++ b/.gitignore @@ -112,7 +112,6 @@ lisp/subdirs.el # Dependencies. deps/ -.deps/ # Logs and temporaries. *.log commit 920afa22651b2ae16f18e4ea1bb2e110c5e3d0af Author: Paul Eggert Date: Sat Jul 29 00:01:02 2017 -0700 Do not worry about paxctl on newer NetBSD Problem reported privately by Thomas Klausner. * configure.ac (emacs_uname_r): New var. Use it to avoid paxctl on newer NetBSD platforms, where it is not needed. Also use it to simplify Cygwin diagnostic. diff --git a/configure.ac b/configure.ac index e4647c6a30..c3e440adca 100644 --- a/configure.ac +++ b/configure.ac @@ -175,6 +175,7 @@ esac canonical=$host configuration=${host_alias-${build_alias-$host}} +emacs_uname_r=`uname -r` dnl Support for --program-prefix, --program-suffix and dnl --program-transform-name options @@ -1222,8 +1223,8 @@ if test $opsys = gnu-linux; then AC_SUBST([SETFATTR]) fi fi -case $opsys,$PAXCTL_notdumped in - gnu-linux, | netbsd,) +case $opsys,$PAXCTL_notdumped,$emacs_uname_r in + gnu-linux,,* | netbsd,,[0-7].*) AC_PATH_PROG([PAXCTL], [paxctl], [], [$PATH$PATH_SEPARATOR/sbin$PATH_SEPARATOR/usr/sbin]) if test -n "$PAXCTL"; then @@ -5509,13 +5510,12 @@ to run if these resources are not installed."]) echo fi -if test "${opsys}" = "cygwin"; then - case `uname -r` in - 1.5.*) AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]]) +case $opsys,$emacs_uname_r in + cygwin,1.5.*) + AC_MSG_WARN([[building Emacs on Cygwin 1.5 is not supported.]]) echo ;; - esac -fi +esac # Remove any trailing slashes in these variables. case $prefix in commit 6238b6c0d4176621a1f224291f41e5d71c0c9968 Author: Eli Zaretskii Date: Sat Jul 29 09:57:51 2017 +0300 Clarify documentation of ':inherit' face attribute * doc/lispref/display.texi (Face Attributes): Document the special treatment of 'unspecified' in the ':inherit' attribute. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index f5c73e55a4..2ed848adf3 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2423,7 +2423,9 @@ the values of the @code{:family}, @code{:foundry}, @code{:width}, The name of a face from which to inherit attributes, or a list of face names. Attributes from inherited faces are merged into the face like an underlying face would be, with higher priority than underlying -faces (@pxref{Displaying Faces}). If a list of faces is used, +faces (@pxref{Displaying Faces}). If the face to inherit from is +@code{unspecified}, it is treated the same as @code{nil}, since Emacs +never merges @code{:inherit} attributes. If a list of faces is used, attributes from faces earlier in the list override those from later faces. @end table commit d66dcde46a87ee8a9064db3d9b05da9b17036f5b Author: Stefan Monnier Date: Fri Jul 28 12:27:00 2017 -0400 * lisp/password-cache.el (password-data): Use a hash-table * lisp/auth-source.el (auth-source-magic): Remove. (auth-source-forget+, auth-source-forget-all-cached): Adjust to new format of password-data. (auth-source-format-cache-entry): Just use a cons. (password-cache-remove, password-cache-add, password-reset) (password-read-from-cache, password-in-cache-p): Adjust accordingly. Fixes: bug#26699 diff --git a/etc/NEWS b/etc/NEWS index ef4c125ab1..a785c6a86b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1084,6 +1084,9 @@ fontification, and commenting for embedded JavaScript and CSS. * Incompatible Lisp Changes in Emacs 26.1 +*** password-data is now a hash-table +so that `password-read' can use any object for the `key' argument. + +++ *** Command 'dired-mark-extension' now automatically prepends a '.' to the extension when not present. The new command 'dired-mark-suffix' behaves diff --git a/lisp/auth-source.el b/lisp/auth-source.el index d1747bda3d..d4b44a5952 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -200,8 +200,6 @@ Note that if EPA/EPG is not available, this should NOT be used." (const :tag "Save GPG-encrypted password tokens" gpg) (const :tag "Don't encrypt tokens" never)))))) -(defvar auth-source-magic "auth-source-magic ") - (defcustom auth-source-do-cache t "Whether auth-source should cache information with `password-cache'." :group 'auth-source @@ -782,16 +780,16 @@ Returns the deleted entries." (defun auth-source-forget-all-cached () "Forget all cached auth-source data." (interactive) - (cl-do-symbols (sym password-data) - ;; when the symbol name starts with auth-source-magic - (when (string-match (concat "^" auth-source-magic) (symbol-name sym)) - ;; remove that key - (password-cache-remove (symbol-name sym)))) + (maphash (lambda (key _password) + (when (eq 'auth-source (car-safe key)) + ;; remove that key + (password-cache-remove key))) + password-data) (setq auth-source-netrc-cache nil)) (defun auth-source-format-cache-entry (spec) "Format SPEC entry to put it in the password cache." - (concat auth-source-magic (format "%S" spec))) + `(auth-source . ,spec)) (defun auth-source-remember (spec found) "Remember FOUND search results for SPEC." @@ -822,18 +820,16 @@ This is not a full `auth-source-search' spec but works similarly. For instance, \(:host \"myhost\" \"yourhost\") would find all the cached data that was found with a search for those two hosts, while \(:host t) would find all host entries." - (let ((count 0) - sname) - (cl-do-symbols (sym password-data) - ;; when the symbol name matches with auth-source-magic - (when (and (setq sname (symbol-name sym)) - (string-match (concat "^" auth-source-magic "\\(.+\\)") - sname) - ;; and the spec matches what was stored in the cache - (auth-source-specmatchp spec (read (match-string 1 sname)))) - ;; remove that key - (password-cache-remove sname) - (cl-incf count))) + (let ((count 0)) + (maphash + (lambda (key _password) + (when (and (eq 'auth-source (car-safe key)) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (cdr key))) + ;; remove that key + (password-cache-remove key) + (cl-incf count))) + password-data) count)) (defun auth-source-specmatchp (spec stored) diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 7be3c6fdb6..cbc248b9ec 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -66,7 +66,7 @@ Whether passwords are cached at all is controlled by `password-cache'." :type '(choice (const :tag "Never" nil) (integer :tag "Seconds"))) -(defvar password-data (make-vector 7 0)) +(defvar password-data (make-hash-table :test #'equal)) (defun password-read-from-cache (key) "Obtain passphrase for KEY from time-limited passphrase cache. @@ -74,20 +74,20 @@ Custom variables `password-cache' and `password-cache-expiry' regulate cache behavior." (and password-cache key - (symbol-value (intern-soft key password-data)))) + (gethash key password-data))) ;;;###autoload (defun password-in-cache-p (key) "Check if KEY is in the cache." (and password-cache key - (intern-soft key password-data))) + (gethash key password-data))) (defun password-read (prompt &optional key) "Read password, for use with KEY, from user, or from cache if wanted. KEY indicate the purpose of the password, so the cache can -separate passwords. The cache is not used if KEY is nil. It is -typically a string. +separate passwords. The cache is not used if KEY is nil. +KEY is typically a string but can be anything (compared via `equal'). The variable `password-cache' control whether the cache is used." (or (password-read-from-cache key) (read-passwd prompt))) @@ -115,29 +115,27 @@ but can be invoked at any time to forcefully remove passwords from the cache. This may be useful when it has been detected that a password is invalid, so that `password-read' query the user again." - (let ((sym (intern-soft key password-data))) - (when sym - (let ((password (symbol-value sym))) - (when (stringp password) - (if (fboundp 'clear-string) - (clear-string password) - (fillarray password ?_))) - (unintern key password-data))))) + (let ((password (gethash key password-data))) + (when (stringp password) + (if (fboundp 'clear-string) + (clear-string password) + (fillarray password ?_))) + (remhash key password-data))) (defun password-cache-add (key password) "Add password to cache. The password is removed by a timer after `password-cache-expiry' seconds." - (when (and password-cache-expiry (null (intern-soft key password-data))) + (when (and password-cache-expiry (null (gethash key password-data))) (run-at-time password-cache-expiry nil #'password-cache-remove key)) - (set (intern key password-data) password) + (puthash key password password-data) nil) (defun password-reset () "Clear the password cache." (interactive) - (fillarray password-data 0)) + (clrhash password-data)) (provide 'password-cache) diff --git a/test/lisp/auth-source-tests.el b/test/lisp/auth-source-tests.el index 2634777c7d..9753029f19 100644 --- a/test/lisp/auth-source-tests.el +++ b/test/lisp/auth-source-tests.el @@ -215,7 +215,7 @@ (ert-deftest auth-source-test-remembrances-of-things-past () (let ((password-cache t) - (password-data (make-vector 7 0))) + (password-data (copy-hash-table password-data))) (auth-source-remember '(:host "wedd") '(4 5 6)) (should (auth-source-remembered-p '(:host "wedd"))) (should-not (auth-source-remembered-p '(:host "xedd"))) commit bfb8d33fd18b1d9fd5868204d472cb19f5bcafbe Author: Stefan Monnier Date: Fri Jul 28 12:02:01 2017 -0400 * lisp/subr.el (define-symbol-prop): New function (symbol-file): Make it find symbol property definitions. * lisp/emacs-lisp/pcase.el (pcase-defmacro): * lisp/emacs-lisp/ert.el (ert-set-test): Use it instead of `put'. (ert-describe-test): Adjust call to symbol-file accordingly. diff --git a/etc/NEWS b/etc/NEWS index 2b7c93fda1..ef4c125ab1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1175,6 +1175,8 @@ break. * Lisp Changes in Emacs 26.1 +** New function `define-symbol-prop'. + +++ ** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 5186199cfc..d7bd331c11 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -135,16 +135,9 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; Note that nil is still a valid value for the `name' slot in ;; ert-test objects. It designates an anonymous test. (error "Attempt to define a test named nil")) - (put symbol 'ert--test definition) - ;; Register in load-history, so `symbol-file' can find us, and so - ;; unload-feature can unload our tests. - (cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal) + (define-symbol-prop symbol 'ert--test definition) definition) -(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) - (let ((name (cdr x))) - (put name 'ert--test nil))) - (defun ert-make-test-unbound (symbol) "Make SYMBOL name no test. Return SYMBOL." (cl-remprop symbol 'ert--test) @@ -2539,7 +2532,7 @@ To be used in the ERT results buffer." (insert (if test-name (format "%S" test-name) "")) (insert " is a test") (let ((file-name (and test-name - (symbol-file test-name 'ert-deftest)))) + (symbol-file test-name 'ert--test)))) (when file-name (insert (format-message " defined in `%s'" (file-name-nondirectory file-name))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index b40161104d..253b60e753 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -418,8 +418,8 @@ to this macro." (when decl (setq body (remove decl body))) `(progn (defun ,fsym ,args ,@body) - (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl))) - (put ',name 'pcase-macroexpander #',fsym)))) + (define-symbol-prop ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl))) + (define-symbol-prop ',name 'pcase-macroexpander #',fsym)))) (defun pcase--match (val upat) "Build a MATCH structure, hoisting all `or's and `and's outside." diff --git a/lisp/loadhist.el b/lisp/loadhist.el index b83d023ccf..18c30f781f 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -221,6 +221,11 @@ restore a previous autoload if possible.") ;; Remove the struct. (setf (cl--find-class name) nil))) +(cl-defmethod loadhist-unload-element ((x (head define-symbol-props))) + (pcase-dolist (`(,symbol . ,props) (cdr x)) + (dolist (prop props) + (put symbol prop nil)))) + ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE. diff --git a/lisp/subr.el b/lisp/subr.el index 90a78cf68a..b3f9f90234 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1999,6 +1999,25 @@ If TOGGLE has a `:menu-tag', that is used for the menu item's label." ;; "Return the name of the file from which AUTOLOAD will be loaded. ;; \n\(fn AUTOLOAD)") +(defun define-symbol-prop (symbol prop val) + "Define the property PROP of SYMBOL to be VAL. +This is to `put' what `defalias' is to `fset'." + ;; Can't use `cl-pushnew' here (nor `push' on (cdr foo)). + ;; (cl-pushnew symbol (alist-get prop + ;; (alist-get 'define-symbol-props + ;; current-load-list))) + (let ((sps (assq 'define-symbol-props current-load-list))) + (unless sps + (setq sps (list 'define-symbol-props)) + (push sps current-load-list)) + (let ((ps (assq prop sps))) + (unless ps + (setq ps (list prop)) + (setcdr sps (cons ps (cdr sps)))) + (unless (member symbol (cdr ps)) + (setcdr ps (cons symbol (cdr ps)))))) + (put symbol prop val)) + (defun symbol-file (symbol &optional type) "Return the name of the file that defined SYMBOL. The value is normally an absolute file name. It can also be nil, @@ -2008,28 +2027,30 @@ file name without extension. If TYPE is nil, then any kind of definition is acceptable. If TYPE is `defun', `defvar', or `defface', that specifies function -definition, variable definition, or face definition only." +definition, variable definition, or face definition only. +Otherwise TYPE is assumed to be a symbol property." (if (and (or (null type) (eq type 'defun)) (symbolp symbol) (autoloadp (symbol-function symbol))) (nth 1 (symbol-function symbol)) - (let ((files load-history) - file match) - (while files - (if (if type - (if (eq type 'defvar) - ;; Variables are present just as their names. - (member symbol (cdr (car files))) - ;; Other types are represented as (TYPE . NAME). - (member (cons type symbol) (cdr (car files)))) - ;; We accept all types, so look for variable def - ;; and then for any other kind. - (or (member symbol (cdr (car files))) - (and (setq match (rassq symbol (cdr (car files)))) - (not (eq 'require (car match)))))) - (setq file (car (car files)) files nil)) - (setq files (cdr files))) - file))) + (catch 'found + (pcase-dolist (`(,file . ,elems) load-history) + (when (if type + (if (eq type 'defvar) + ;; Variables are present just as their names. + (member symbol elems) + ;; Many other types are represented as (TYPE . NAME). + (or (member (cons type symbol) elems) + (memq symbol (alist-get type + (alist-get 'define-symbol-props + elems))))) + ;; We accept all types, so look for variable def + ;; and then for any other kind. + (or (member symbol elems) + (let ((match (rassq symbol elems))) + (and match + (not (eq 'require (car match))))))) + (throw 'found file)))))) (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index 317838b250..57463ad932 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -352,7 +352,7 @@ This macro is used to test if macroexpansion in `should' works." (let ((abc (ert-get-test 'ert-test-abc))) (should (equal (ert-test-tags abc) '(bar))) (should (equal (ert-test-documentation abc) "foo"))) - (should (equal (symbol-file 'ert-test-deftest 'ert-deftest) + (should (equal (symbol-file 'ert-test-deftest 'ert--test) (symbol-file 'ert-test--which-file 'defun))) (ert-deftest ert-test-def () :expected-result ':passed) commit b2225a374f24f1ee1a881bfd5d3c1f7b57447e47 Author: Stefan Monnier Date: Fri Jul 28 11:28:48 2017 -0400 * lisp/subr.el (method-files): Move function to cl-generic.el * lisp/emacs-lisp/cl-generic.el (cl-generic-p): New function. (cl--generic-method-files): New function, moved from subr.el. * lisp/emacs-lisp/edebug.el (edebug-instrument-function): Use them. * test/lisp/emacs-lisp/cl-generic-tests.el: * test/lisp/subr-tests.el: Move and adjust method-files tests accordingly. diff --git a/etc/NEWS b/etc/NEWS index a7800feed1..2b7c93fda1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -604,6 +604,8 @@ paragraphs, for the purposes of bidirectional display. * Changes in Specialized Modes and Packages in Emacs 26.1 +** New function `cl-generic-p'. + ** Dired +++ diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 114468239a..1a3f8e1f4d 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -166,6 +166,10 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG (defmacro cl--generic (name) `(get ,name 'cl--generic)) +(defun cl-generic-p (f) + "Return non-nil if F is a generic function." + (and (symbolp f) (cl--generic f))) + (defun cl-generic-ensure-function (name &optional noerror) (let (generic (origname name)) @@ -1023,6 +1027,20 @@ The value returned is a list of elements of the form (push (cl--generic-method-info method) docs)))) docs)) +(defun cl--generic-method-files (method) + "Return a list of files where METHOD is defined by `cl-defmethod'. +The list will have entries of the form (FILE . (METHOD ...)) +where (METHOD ...) contains the qualifiers and specializers of +the method and is a suitable argument for +`find-function-search-for-symbol'. Filenames are absolute." + (let (result) + (pcase-dolist (`(,file . ,defs) load-history) + (dolist (def defs) + (when (and (eq (car-safe def) 'cl-defmethod) + (eq (cadr def) method)) + (push (cons file (cdr def)) result)))) + result)) + ;;; Support for (head ) specializers. ;; For both the `eql' and the `head' specializers, the dispatch diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 1494ed1d9c..c6ef8d7a99 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3213,8 +3213,8 @@ instrument cannot be found, signal an error." ((consp func-marker) (message "%s is already instrumented." func) (list func)) - ((get func 'cl--generic) - (let ((method-defs (method-files func)) + ((cl-generic-p func) + (let ((method-defs (cl--generic-method-files func)) symbols) (unless method-defs (error "Could not find any method definitions for %s" func)) diff --git a/lisp/subr.el b/lisp/subr.el index 79a28d301e..90a78cf68a 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2031,25 +2031,6 @@ definition, variable definition, or face definition only." (setq files (cdr files))) file))) -(defun method-files (method) - "Return a list of files where METHOD is defined by `cl-defmethod'. -The list will have entries of the form (FILE . (METHOD ...)) -where (METHOD ...) contains the qualifiers and specializers of -the method and is a suitable argument for -`find-function-search-for-symbol'. Filenames are absolute." - (let ((files load-history) - result) - (while files - (let ((defs (cdr (car files)))) - (while defs - (let ((def (car defs))) - (if (and (eq (car-safe def) 'cl-defmethod) - (eq (cadr def) method)) - (push (cons (car (car files)) (cdr def)) result))) - (setq defs (cdr defs)))) - (setq files (cdr files))) - result)) - (defun locate-library (library &optional nosuffix path interactive-call) "Show the precise file name of Emacs library LIBRARY. LIBRARY should be a relative file name of the library, a string. diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 0768e31f7e..31f65413c8 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el @@ -219,5 +219,29 @@ (should (equal (cl--generic-1 '(5) nil) '("cinq" (5)))) (should (equal (cl--generic-1 '(6) nil) '("six" a)))) +(cl-defgeneric cl-generic-tests--generic (x)) +(cl-defmethod cl-generic-tests--generic ((x string)) + (message "%s is a string" x)) +(cl-defmethod cl-generic-tests--generic ((x integer)) + (message "%s is a number" x)) +(cl-defgeneric cl-generic-tests--generic-without-methods (x y)) +(defvar cl-generic-tests--this-file + (file-truename (or load-file-name buffer-file-name))) + +(ert-deftest cl-generic-tests--method-files--finds-methods () + "`method-files' returns a list of files and methods for a generic function." + (let ((retval (cl--generic-method-files 'cl-generic-tests--generic))) + (should (equal (length retval) 2)) + (mapc (lambda (x) + (should (equal (car x) cl-generic-tests--this-file)) + (should (equal (cadr x) 'cl-generic-tests--generic))) + retval) + (should-not (equal (nth 0 retval) (nth 1 retval))))) + +(ert-deftest cl-generic-tests--method-files--nonexistent-methods () + "`method-files' returns nil if asked to find a method which doesn't exist." + (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) + (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) + (provide 'cl-generic-tests) ;;; cl-generic-tests.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 7e50429a5b..a59f0ca90e 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -292,31 +292,6 @@ cf. Bug#25477." (should-error (eval '(dolist "foo") t) :type 'wrong-type-argument)) -(require 'cl-generic) -(cl-defgeneric subr-tests--generic (x)) -(cl-defmethod subr-tests--generic ((x string)) - (message "%s is a string" x)) -(cl-defmethod subr-tests--generic ((x integer)) - (message "%s is a number" x)) -(cl-defgeneric subr-tests--generic-without-methods (x y)) -(defvar subr-tests--this-file - (file-truename (or load-file-name buffer-file-name))) - -(ert-deftest subr-tests--method-files--finds-methods () - "`method-files' returns a list of files and methods for a generic function." - (let ((retval (method-files 'subr-tests--generic))) - (should (equal (length retval) 2)) - (mapc (lambda (x) - (should (equal (car x) subr-tests--this-file)) - (should (equal (cadr x) 'subr-tests--generic))) - retval) - (should-not (equal (nth 0 retval) (nth 1 retval))))) - -(ert-deftest subr-tests--method-files--nonexistent-methods () - "`method-files' returns nil if asked to find a method which doesn't exist." - (should-not (method-files 'subr-tests--undefined-generic)) - (should-not (method-files 'subr-tests--generic-without-methods))) - (ert-deftest subr-tests-bug22027 () "Test for http://debbugs.gnu.org/22027 ." (let ((default "foo") res) commit dc9c6a071c0c12be2bd490f85107486bca44623e Author: Eli Zaretskii Date: Fri Jul 28 15:40:25 2017 +0300 Preserve this-command-keys across recursive-edit invocations * src/minibuf.c (read_minibuf, read_minibuf_unwind): Save and restore this-command-keys, to preserve it across recursive-edit. (Bug#27470) diff --git a/src/minibuf.c b/src/minibuf.c index d4128ce01c..010152930b 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -497,6 +497,8 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Fcons (Vminibuffer_history_position, Fcons (Vminibuffer_history_variable, minibuf_save_list)))))); + minibuf_save_list + = Fcons (Fthis_command_keys_vector (), minibuf_save_list); record_unwind_protect_void (read_minibuf_unwind); minibuf_level++; @@ -836,6 +838,11 @@ read_minibuf_unwind (void) Fset_buffer (XWINDOW (window)->contents); /* Restore prompt, etc, from outer minibuffer level. */ + Lisp_Object key_vec = Fcar (minibuf_save_list); + eassert (VECTORP (key_vec)); + this_command_key_count = XFASTINT (Flength (key_vec)); + this_command_keys = key_vec; + minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt = Fcar (minibuf_save_list); minibuf_save_list = Fcdr (minibuf_save_list); minibuf_prompt_width = XFASTINT (Fcar (minibuf_save_list)); commit f1ed31a8f5c6f19aa5e119e670533241c6375945 Author: Eli Zaretskii Date: Fri Jul 28 12:38:22 2017 +0300 ; * .gitignore: Add .deps/. diff --git a/.gitignore b/.gitignore index 9229297833..05a8d6b533 100644 --- a/.gitignore +++ b/.gitignore @@ -112,6 +112,7 @@ lisp/subdirs.el # Dependencies. deps/ +.deps/ # Logs and temporaries. *.log commit 82c7c1e4394ec160fe67134659c9c662760d31e2 Author: Eli Zaretskii Date: Fri Jul 28 12:35:36 2017 +0300 Improve doc string of 'locate-dominating-file' * lisp/files.el (locate-dominating-file): Doc fix. (Bug#27798) diff --git a/lisp/files.el b/lisp/files.el index 321a35b530..6d9957d494 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -978,12 +978,15 @@ or mount points potentially requiring authentication as a different user.") ;; nil))) (defun locate-dominating-file (file name) - "Look up the directory hierarchy from FILE for a directory containing NAME. + "Starting from FILE, look up directory hierarchy for directory containing NAME. +FILE can be a file or a directory. If it's a file, its directory will +serve as the starting point for searching the hierarchy of directories. Stop at the first parent directory containing a file NAME, and return the directory. Return nil if not found. Instead of a string, NAME can also be a predicate taking one argument \(a directory) and returning a non-nil value if that directory is the one for -which we're looking." +which we're looking. The predicate will be called with every file/directory +the function needs to examine, starting with FILE." ;; We used to use the above locate-dominating-files code, but the ;; directory-files call is very costly, so we're much better off doing ;; multiple calls using the code in here. commit 353dbbb6682e287fbe8936ca65277af709b90817 Author: Drew Adams Date: Fri Jul 28 10:47:20 2017 +0300 New commands 'apropos-local-variable', 'apropos-local-value' * lisp/apropos.el (apropos-local-variable, apropos-local-value): New functions. (Bug#27424) * doc/emacs/help.texi (Apropos): Document 'apropos-local-variable' and 'apropos-local-value'. * etc/NEWS: Mention the new commands. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index fd6df1c7e5..460ced0d21 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -320,12 +320,21 @@ search for non-customizable variables too. Search for variables. With a prefix argument, search for customizable variables only. +@item M-x apropos-local-variable +@findex apropos-local-variable +Search for buffer-local variables. + @item M-x apropos-value @findex apropos-value Search for variables whose values match the specified pattern. With a prefix argument, search also for functions with definitions matching the pattern, and Lisp symbols with properties matching the pattern. +@item M-x apropos-local-value +@findex apropos-local-value +Search for buffer-local variables whose values match the specified +pattern. + @item C-h d @kindex C-h d @findex apropos-documentation diff --git a/etc/NEWS b/etc/NEWS index f43491b630..a7800feed1 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -589,6 +589,12 @@ current buffer with the contents of the accessible portion of a different buffer while keeping point, mark, markers, and text properties as intact as possible. ++++ +** New commands 'apropos-local-variable' and 'apropos-local-value. +These are buffer-local versions of 'apropos-variable' and +'apropos-value', respectively. They show buffer-local variables whose +names and values, respectively, match a given pattern. + +++ ** More user control of reordering bidirectional text for display. The two new variables, 'bidi-paragraph-start-re' and diff --git a/lisp/apropos.el b/lisp/apropos.el index cbd9c71d3e..86d9b51429 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -514,6 +514,19 @@ options only, i.e. behave like `apropos-user-option'." (let ((apropos-do-all (if do-not-all nil t))) (apropos-user-option pattern))) +;;;###autoload +(defun apropos-local-variable (pattern &optional buffer) + "Show buffer-local variables that match PATTERN. +Optional arg BUFFER (default: current buffer) is the buffer to check. + +The output includes variables that are not yet set in BUFFER, but that +will be buffer-local when set." + (interactive (list (apropos-read-pattern "buffer-local variable"))) + (unless buffer (setq buffer (current-buffer))) + (apropos-command pattern nil (lambda (symbol) + (and (local-variable-if-set-p symbol) + (get symbol 'variable-documentation))))) + ;; For auld lang syne: ;;;###autoload (defalias 'command-apropos 'apropos-command) @@ -795,6 +808,35 @@ Returns list of symbols and values found." (let ((apropos-multi-type do-all)) (apropos-print nil "\n----------------\n"))) +;;;###autoload +(defun apropos-local-value (pattern &optional buffer) + "Show buffer-local variables whose values match PATTERN. +This is like `apropos-value', but only for buffer-local variables. +Optional arg BUFFER (default: current buffer) is the buffer to check." + (interactive (list (apropos-read-pattern "value of buffer-local variable"))) + (unless buffer (setq buffer (current-buffer))) + (apropos-parse-pattern pattern) + (setq apropos-accumulator ()) + (let ((var nil)) + (mapatoms + (lambda (symb) + (unless (memq symb '(apropos-regexp apropos-pattern apropos-all-words-regexp + apropos-words apropos-all-words apropos-accumulator symb var)) + (setq var (apropos-value-internal 'local-variable-if-set-p symb 'symbol-value))) + (when (and (fboundp 'apropos-false-hit-str) (apropos-false-hit-str var)) + (setq var nil)) + (when var + (setq apropos-accumulator (cons (list symb (apropos-score-str var) nil var) + apropos-accumulator)))))) + (let ((apropos-multi-type nil)) + (if (> emacs-major-version 20) + (apropos-print + nil "\n----------------\n" + (format "Buffer `%s' has the following local variables\nmatching %s`%s':" + (buffer-name buffer) + (if (consp pattern) "keywords " "") + pattern)) + (apropos-print nil "\n----------------\n")))) ;;;###autoload (defun apropos-documentation (pattern &optional do-all) commit 955e0cbb32225a53ac8b5b8f2235fb251d83f49e Author: Stefan Monnier Date: Thu Jul 27 22:51:37 2017 -0400 * lisp/loadhist.el (unload-feature): Remove ad-hoc ELP code * lisp/emacs-lisp/elp.el (loadhist-unload-element): Un-instrument functions. diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index d4500f131a..7bdd749d5a 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -583,6 +583,11 @@ displayed." (elp-restore-all) ;; continue standard unloading nil) + +(cl-defmethod loadhist-unload-element :before :extra "elp" ((x (head defun))) + "Un-instrument before unloading a function." + (elp-restore-function (cdr x))) + (provide 'elp) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 24c3acd1b9..b83d023ccf 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -301,11 +301,6 @@ something strange, such as redefining an Emacs function." ;; Change major mode in all buffers using one defined in the feature being unloaded. (unload--set-major-mode) - (when (fboundp 'elp-restore-function) ; remove ELP stuff first - (dolist (elt unload-function-defs-list) - (when (symbolp elt) - (elp-restore-function elt)))) - (mapc #'loadhist-unload-element unload-function-defs-list) ;; Delete the load-history element for this file. (setq load-history (delq (assoc file load-history) load-history)))) commit eaa5dc9d102d10c79f10bee1994ad922b8fcf9c4 Author: Alan Mackenzie Date: Thu Jul 27 17:56:23 2017 +0000 Fix C++ class initializers not always being fontified at mode start. The problem here happened when an "outer list" of declarations moved beyond an "inner list" containing class initializers. These weren't being checked for by the code. Also, fix places in c-get-fontification-context where point is undefined. * lisp/progmodes/cc-fonts.el (c-get-fontification-context): when argument not-front-decl is set, test for class initializers. Also, anchor point in places where it is moved and is otherwise undefined. diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index e8552af8ed..b35d33a5fd 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1231,13 +1231,16 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got a cached hit in some other type of arglist. (type (cons 'arglist t)) - (not-front-decl + ((and not-front-decl ;; The point is within the range of a previously ;; encountered type decl expression, so the arglist ;; is probably one that contains declarations. ;; However, if `c-recognize-paren-inits' is set it ;; might also be an initializer arglist. - ;; + (or (not c-recognize-paren-inits) + (save-excursion + (goto-char match-pos) + (not (c-back-over-member-initializers))))) ;; The result of this check is cached with a char ;; property on the match token, so that we can look ;; it up again when refontifying single lines in a @@ -1248,17 +1251,21 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Got an open paren preceded by an arith operator. ((and (eq (char-before match-pos) ?\() (save-excursion + (goto-char match-pos) (and (zerop (c-backward-token-2 2)) (looking-at c-arithmetic-op-regexp)))) (cons nil nil)) ;; In a C++ member initialization list. ((and (eq (char-before match-pos) ?,) (c-major-mode-is 'c++-mode) - (save-excursion (c-back-over-member-initializers))) + (save-excursion + (goto-char match-pos) + (c-back-over-member-initializers))) (c-put-char-property (1- match-pos) 'c-type 'c-not-decl) (cons 'not-decl nil)) ;; At start of a declaration inside a declaration paren. ((save-excursion + (goto-char match-pos) (and (memq (char-before match-pos) '(?\( ?\,)) (c-go-up-list-backward match-pos) (eq (char-after) ?\() commit 30e6e558701ebc781cdca3b9d61d995004cfef7d Author: Alan Mackenzie Date: Thu Jul 27 17:05:53 2017 +0000 Fix variables in C++ "for" statement not always being fontified. The error happened when there was a comma inside template delimiters. * lisp/progmodes/cc-fonts.el (c-get-fontification-context): In "for" statements, recognise template delimiters containing "," and "&". diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 66f2575f49..e8552af8ed 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1182,10 +1182,15 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char match-pos) (backward-char) (c-backward-token-2) - (or (looking-at c-block-stmt-2-key) - (looking-at c-block-stmt-1-2-key) - (looking-at c-typeof-key)))) - (cons nil t)) + (cond + ((looking-at c-paren-stmt-key) + ;; Allow comma separated <> arglists in for statements. + (cons nil nil)) + ((or (looking-at c-block-stmt-2-key) + (looking-at c-block-stmt-1-2-key) + (looking-at c-typeof-key)) + (cons nil t)) + (t nil))))) ;; Near BOB. ((<= match-pos (point-min)) (cons 'arglist t)) commit 82583d4dde465c0d923eec306d0f9c5d671955bc Author: Michael Albinus Date: Thu Jul 27 12:51:45 2017 +0200 Add watchdog process to tramp-test36-asynchronous-requests * test/lisp/net/tramp-tests.el (tramp--test-timeout-handler): New defun. (tramp-test36-asynchronous-requests): Use a watchdog process, listening for SIGUSR1. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 58639e1bfa..4ae7b88024 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3681,6 +3681,10 @@ Use the `ls' command." tramp-connection-properties))) (tramp--test-utf8))) +(defun tramp--test-timeout-handler () + (interactive) + (ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test))))) + ;; This test is inspired by Bug#16928. (ert-deftest tramp-test36-asynchronous-requests () "Check parallel asynchronous requests. @@ -3690,10 +3694,15 @@ process sentinels. They shall not disturb each other." (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) - ;; This test could be blocked on hydra. - (with-timeout - (300 (ert-fail "`tramp-test36-asynchronous-requests' timed out")) - (let* ((tmp-name (tramp--test-make-temp-name)) + ;; This test could be blocked on hydra. So we set a timeout of 300 + ;; seconds, and we send a SIGUSR1 signal after 300 seconds. + (with-timeout (300 (tramp--test-timeout-handler)) + (define-key special-event-map [sigusr1] 'tramp--test-timeout-handler) + (let* ((watchdog + (start-process + "*watchdog*" nil shell-file-name shell-command-switch + (format "sleep 300; kill -USR1 %d" (emacs-pid)))) + (tmp-name (tramp--test-make-temp-name)) (default-directory tmp-name) ;; Do not cache Tramp properties. (remote-file-name-inhibit-cache t) @@ -3806,6 +3815,8 @@ process sentinels. They shall not disturb each other." ;; Regular operation. (tramp--test-message "Trace 3 action %d %s %s" count buf (current-time-string)) + ;; Give the watchdog a chance. + (read-event nil nil 0.01) (if (= count 2) (if (= (length buffers) 1) (tramp--test-instrument-test-case 10 @@ -3821,8 +3832,7 @@ process sentinels. They shall not disturb each other." ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be ;; deleted. - (tramp--test-message - "Check %s" (current-time-string)) + (tramp--test-message "Check %s" (current-time-string)) (dolist (buf buffers) (with-current-buffer buf (should (string-equal (format "%s\n" buf) (buffer-string))))) @@ -3831,6 +3841,8 @@ process sentinels. They shall not disturb each other." tmp-name nil directory-files-no-dot-files-regexp))) ;; Cleanup. + (define-key special-event-map [sigusr1] 'ignore) + (ignore-errors (quit-process watchdog)) (dolist (buf buffers) (ignore-errors (delete-process (get-buffer-process buf))) (ignore-errors (kill-buffer buf))) commit 28faa94f1c423091bb34c2776eabe9ae83e5b4fc Author: Alan Mackenzie Date: Thu Jul 27 06:27:13 2017 +0000 CC Mode: Fix declarator being cut off from terminator by end of jit-lock chunk If a declarator is so cut off, extend the fontification chunk to include it. * lisp/progmodes/cc-mode.el (c-fl-decl-end): New function. (c-change-expand-fl-region, c-context-expand-fl-region): Use the new function. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index bf0439ffe8..0bf89b9a36 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1539,6 +1539,21 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq new-pos capture-opener)) (and (/= new-pos pos) new-pos))) +(defun c-fl-decl-end (pos) + ;; If POS is inside a declarator, return the end of the token that follows + ;; the declarator, otherwise return nil. + (goto-char pos) + (let ((lit-start (c-literal-start)) + pos1) + (if lit-start (goto-char lit-start)) + (c-backward-syntactic-ws) + (when (setq pos1 (c-on-identifier)) + (goto-char pos1) + (when (and (c-forward-declarator) + (eq (c-forward-token-2) 0)) + (c-backward-syntactic-ws) + (point))))) + (defun c-change-expand-fl-region (_beg _end _old-len) ;; Expand the region (c-new-BEG c-new-END) to an after-change font-lock ;; region. This will usually be the smallest sequence of whole lines @@ -1552,18 +1567,16 @@ Note that this is a strict tail, so won't match, e.g. \"0x....\".") (setq c-new-BEG (or (c-fl-decl-start c-new-BEG) (c-point 'bol c-new-BEG)) c-new-END - (save-excursion - (goto-char c-new-END) - (if (bolp) - (point) - (c-point 'bonl c-new-END)))))) + (or (c-fl-decl-end c-new-END) + (c-point 'bonl (max (1- c-new-END) (point-min))))))) (defun c-context-expand-fl-region (beg end) ;; Return a cons (NEW-BEG . NEW-END), where NEW-BEG is the beginning of a ;; "local" declaration containing BEG (see `c-fl-decl-start') or BOL BEG is ;; in. NEW-END is beginning of the line after the one END is in. - (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) - (c-point 'bonl end))) + (c-save-buffer-state () + (cons (or (c-fl-decl-start beg) (c-point 'bol beg)) + (or (c-fl-decl-end end) (c-point 'bonl (1- end)))))) (defun c-before-context-fl-expand-region (beg end) ;; Expand the region (BEG END) as specified by commit 2d1d54d333735c0128fd31edb183a71298ef5cfc Author: Stefan Monnier Date: Thu Jul 27 00:21:35 2017 -0400 * lisp/vc/smerge-mode.el: Avoid N² blow up in degenerate cases (smerge--refine-long-words): New var. (smerge--refine-chopup-region): Use it. diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 21c39c85ca..f94f8a6d4d 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -938,15 +938,15 @@ It has the following disadvantages: - cannot use `diff -w' because the weighting causes added spaces in a line to be represented as added copies of some line, so `diff -w' can't do the right thing any more. -- may in degenerate cases take a 1KB input region and turn it into a 1MB - file to pass to diff.") +- Is a bit more costly (may in degenerate cases use temp files that are 10x + larger than the refined regions).") (defun smerge--refine-forward (n) (let ((case-fold-search nil) (re "[[:upper:]]?[[:lower:]]+\\|[[:upper:]]+\\|[[:digit:]]+\\|.\\|\n")) (when (and smerge-refine-ignore-whitespace ;; smerge-refine-weight-hack causes additional spaces to - ;; appear as additional lines as well, so even if diff ignore + ;; appear as additional lines as well, so even if diff ignores ;; whitespace changes, it'll report added/removed lines :-( (not smerge-refine-weight-hack)) (setq re (concat "[ \t]*\\(?:" re "\\)"))) @@ -954,6 +954,8 @@ It has the following disadvantages: (unless (looking-at re) (error "Smerge refine internal error")) (goto-char (match-end 0))))) +(defvar smerge--refine-long-words) + (defun smerge--refine-chopup-region (beg end file &optional preproc) "Chopup the region into small elements, one per line. Save the result into FILE. @@ -976,18 +978,46 @@ chars to try and eliminate some spurious differences." (subst-char-in-region (point-min) (point-max) ?\n ?\s)) (goto-char (point-min)) (while (not (eobp)) - (funcall smerge-refine-forward-function 1) - (let ((s (if (prog2 (forward-char -1) (bolp) (forward-char 1)) - nil - (buffer-substring (line-beginning-position) (point))))) - ;; We add \n after each char except after \n, so we get - ;; one line per text char, where each line contains - ;; just one char, except for \n chars which are - ;; represented by the empty line. - (unless (eq (char-before) ?\n) (insert ?\n)) - ;; HACK ALERT!! - (if smerge-refine-weight-hack - (dotimes (_i (1- (length s))) (insert s "\n"))))) + (cl-assert (bolp)) + (let ((start (point))) + (funcall smerge-refine-forward-function 1) + (let ((len (- (point) start))) + (cl-assert (>= len 1)) + ;; We add \n after each chunk except after \n, so we get + ;; one line per text chunk, where each line contains + ;; just one chunk, except for \n chars which are + ;; represented by the empty line. + (unless (bolp) (insert ?\n)) + (when (and smerge-refine-weight-hack (> len 1)) + (let ((s (buffer-substring-no-properties start (point)))) + ;; The weight-hack inserts N copies of words of size N, + ;; so it naturally suffers from an O(N²) blow up. + ;; To circumvent this, we map each long word + ;; to a shorter (but still unique) replacement. + ;; Another option would be to change smerge--refine-forward + ;; so it chops up long words into smaller ones. + (when (> len 8) + (let ((short (gethash s smerge--refine-long-words))) + (unless short + ;; To avoid accidental conflicts with ≤8 words, + ;; we make sure the replacement is >8 chars. Overall, + ;; this should bound the blowup factor to ~10x, + ;; tho if those chars end up encoded as multiple bytes + ;; each, it could probably still reach ~30x in + ;; pathological cases. + (setq short + (concat (substring s 0 7) + " " + (string + (+ ?0 + (hash-table-count + smerge--refine-long-words))) + "\n")) + (puthash s short smerge--refine-long-words)) + (delete-region start (point)) + (insert short) + (setq s short))) + (dotimes (_i (1- len)) (insert s))))))) (unless (bolp) (error "Smerge refine internal error")) (let ((coding-system-for-write 'emacs-internal)) (write-region (point-min) (point-max) file nil 'nomessage)))) @@ -1042,7 +1072,9 @@ used to replace chars to try and eliminate some spurious differences." (let* ((pos (point)) deactivate-mark ; The code does not modify any visible buffer. (file1 (make-temp-file "diff1")) - (file2 (make-temp-file "diff2"))) + (file2 (make-temp-file "diff2")) + (smerge--refine-long-words + (if smerge-refine-weight-hack (make-hash-table :test #'equal)))) (unless (markerp beg1) (setq beg1 (copy-marker beg1))) (unless (markerp beg2) (setq beg2 (copy-marker beg2))) ;; Chop up regions into smaller elements and save into files. @@ -1062,7 +1094,7 @@ used to replace chars to try and eliminate some spurious differences." ;; also and more importantly because otherwise it ;; may happen that diff doesn't behave like ;; smerge-refine-weight-hack expects it to. - ;; See http://thread.gmane.org/gmane.emacs.devel/82685. + ;; See http://thread.gmane.org/gmane.emacs.devel/82685, aka https://lists.gnu.org/archive/html/emacs-devel/2007-11/msg00401.html "-awd" "-ad") file1 file2)) ;; Process diff's output. commit ea875060882a0de5c35574eb815dc45290cd2135 Author: Stefan Monnier Date: Thu Jul 27 00:13:27 2017 -0400 * lisp/url/url-cookie.el: Use lexical-binding (url-cookie-host-can-set-p): Remove unused var `last'. Use string-suffix-p. (url-cookie-list): De morgan. (url-cookie-quit): Remove. (url-cookie-mode): Inherit from special-mode. (url-cookie-mode-map): Simplify accordingly. diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 4912db6c53..0edc93c964 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -1,4 +1,4 @@ -;;; url-cookie.el --- URL cookie support +;;; url-cookie.el --- URL cookie support -*- lexical-binding:t -*- ;; Copyright (C) 1996-1999, 2004-2017 Free Software Foundation, Inc. @@ -227,21 +227,17 @@ telling Microsoft that." :group 'url-cookie) (defun url-cookie-host-can-set-p (host domain) - (let ((last nil) - (case-fold-search t)) - (cond - ((string= host domain) ; Apparently netscape lets you do this - t) - ((zerop (length domain)) - nil) - (t - ;; Remove the dot from wildcard domains before matching. - (when (eq ?. (aref domain 0)) - (setq domain (substring domain 1))) - (and (url-domsuf-cookie-allowed-p domain) - ;; Need to check and make sure the host is actually _in_ the - ;; domain it wants to set a cookie for though. - (string-match (concat (regexp-quote domain) "$") host)))))) + (cond + ((string= host domain) ; Apparently netscape lets you do this + t) + ((zerop (length domain)) + nil) + (t + ;; Remove the dot from wildcard domains before matching. + (when (eq ?. (aref domain 0)) + (setq domain (substring domain 1))) + (and (url-domsuf-cookie-allowed-p domain) + (string-suffix-p domain host 'ignore-case))))) (defun url-cookie-handle-set-cookie (str) (setq url-cookies-changed-since-last-save t) @@ -380,8 +376,8 @@ instead delete all cookies that do not match REGEXP." "Display a buffer listing the current URL cookies, if there are any. Use \\\\[url-cookie-delete] to remove cookies." (interactive) - (when (and (null url-cookie-secure-storage) - (null url-cookie-storage)) + (unless (or url-cookie-secure-storage + url-cookie-storage) (error "No cookies are defined")) (pop-to-buffer "*url cookies*") @@ -442,20 +438,13 @@ Use \\\\[url-cookie-delete] to remove cookies." (forward-line 1) (point))))) -(defun url-cookie-quit () - "Kill the current buffer." - (interactive) - (kill-buffer (current-buffer))) - (defvar url-cookie-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'url-cookie-quit) (define-key map [delete] 'url-cookie-delete) (define-key map [(control k)] 'url-cookie-delete) map)) -(define-derived-mode url-cookie-mode nil "URL Cookie" +(define-derived-mode url-cookie-mode special-mode "URL Cookie" "Mode for listing cookies. \\{url-cookie-mode-map}" commit 27badfeaa789a4e99f94253d894dde18dafa0798 Author: Stefan Monnier Date: Thu Jul 27 00:09:17 2017 -0400 * lisp/calendar/todo-mode.el (todo-print-buffer-function): Rework docstring. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index b89c1c2bbd..1cb01e1ed9 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -4527,11 +4527,9 @@ If the file already exists, overwrite it only on confirmation." (defcustom todo-print-buffer-function #'ps-print-buffer-with-faces "Function called by `todo-print-buffer' to print Todo mode buffers. -The function should take an optional argument whose non-nil value -is a string naming a file to save the print image to; calling -`todo-print-buffer-to-file' prompts for the file name, which is -passed to this function. Calling this function with no or a nil -argument sends the image to the printer." +Called with one argument which can either be: +- a string, naming a file to save the print image to. +- nil, to send the image to the printer." :type 'symbol :group 'todo) commit 9c00d63d1a12894e49671a8884c1c0dbdeef961e Author: Stefan Monnier Date: Thu Jul 27 00:07:17 2017 -0400 * lisp/ruler-mode.el (ruler-mode-ruler): Document problem. diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el index 7b0588dfea..fdfd5c61be 100644 --- a/lisp/ruler-mode.el +++ b/lisp/ruler-mode.el @@ -696,6 +696,10 @@ Optional argument PROPS specifies other text properties to apply." ;; Create an "clean" ruler. (ruler (propertize + ;; FIXME: `make-string' returns a unibyte string if it's ASCII-only, + ;; which prevents further `aset' from inserting non-ASCII chars, + ;; hence the need for `string-to-multibyte'. + ;; http://lists.gnu.org/archive/html/emacs-devel/2017-05/msg00841.html (string-to-multibyte (make-string w ruler-mode-basic-graduation-char)) 'face 'ruler-mode-default commit 86c862767dbb501d27878efdb9f2664ccdd5cc4e Author: Stefan Monnier Date: Wed Jul 26 23:22:58 2017 -0400 * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method): Record this as the function's definition site if it's the first def. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 1d29082c62..114468239a 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -500,25 +500,26 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (cons method mt) ;; Keep the ordering; important for methods with :extra qualifiers. (mapcar (lambda (x) (if (eq x (car me)) method x)) mt))) - (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format - (cl--generic-name generic) - qualifiers specializers)) - current-load-list :test #'equal) - ;; FIXME: Try to avoid re-constructing a new function if the old one - ;; is still valid (e.g. still empty method cache)? - (let ((gfun (cl--generic-make-function generic)) - ;; Prevent `defalias' from recording this as the definition site of - ;; the generic function. - current-load-list) - ;; For aliases, cl--generic-name gives us the actual name. - (let ((purify-flag - ;; BEWARE! Don't purify this function definition, since that leads - ;; to memory corruption if the hash-tables it holds are modified - ;; (the GC doesn't trace those pointers). - nil)) + (let ((sym (cl--generic-name generic))) ; Actual name (for aliases). + (unless (symbol-function sym) + (defalias sym 'dummy)) ;Record definition into load-history. + (cl-pushnew `(cl-defmethod . ,(cl--generic-load-hist-format + (cl--generic-name generic) + qualifiers specializers)) + current-load-list :test #'equal) + ;; FIXME: Try to avoid re-constructing a new function if the old one + ;; is still valid (e.g. still empty method cache)? + (let ((gfun (cl--generic-make-function generic)) + ;; Prevent `defalias' from recording this as the definition site of + ;; the generic function. + current-load-list + ;; BEWARE! Don't purify this function definition, since that leads + ;; to memory corruption if the hash-tables it holds are modified + ;; (the GC doesn't trace those pointers). + (purify-flag nil)) ;; But do use `defalias', so that it interacts properly with nadvice, ;; e.g. for tracing/debug-on-entry. - (defalias (cl--generic-name generic) gfun))))) + (defalias sym gfun))))) (defmacro cl--generic-with-memoization (place &rest code) (declare (indent 1) (debug t)) commit e1e8d2e229f48b3cee765f7cf27ae04ee4401d85 Author: Glenn Morris Date: Wed Jul 26 12:40:13 2017 -0400 * doc/lispref/loading.texi (When to Autoload): New section. diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index d925c8c8f6..80dcb48898 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -468,6 +468,10 @@ runs the real definition as if it had been loaded all along. Autoloading can also be triggered by looking up the documentation of the function or macro (@pxref{Documentation Basics}). +@menu +* When to Autoload:: When to Use Autoload. +@end menu + There are two ways to set up an autoloaded function: by calling @code{autoload}, and by writing a ``magic'' comment in the source before the real definition. @code{autoload} is the low-level @@ -699,6 +703,42 @@ symbol's new function value. If the value of the optional argument function, only a macro. @end defun +@node When to Autoload +@subsection When to Use Autoload +@cindex autoload, when to use + +Do not add an autoload comment unless it is really necessary. +Autoloading code means it is always globally visible. Once an item is +autoloaded, there is no compatible way to transition back to it not +being autoloaded (after people become accustomed to being able to use it +without an explicit load). + +@itemize +@item +The most common items to autoload are the interactive entry points to a +library. For example, if @file{python.el} is a library defining a +major-mode for editing Python code, autoload the definition of the +@code{python-mode} function, so that people can simply use @kbd{M-x +python-mode} to load the library. + +@item +Variables usually don't need to be autoloaded. An exception is if the +variable on its own is generally useful without the whole defining +library being loaded. (An example of this might be something like +@code{find-exec-terminator}.) + +@item +Don't autoload a user option just so that a user can set it. + +@item +Never add an autoload @emph{comment} to silence a compiler warning in +another file. In the file that produces the warning, use +@code{(defvar foo)} to silence an undefined variable warning, and +@code{declare-function} (@pxref{Declaring Functions}) to silence an +undefined function warning; or require the relevant library; or use an +explicit autoload @emph{statement}. +@end itemize + @node Repeated Loading @section Repeated Loading @cindex repeated loading commit e19e1f9d4bbf0539d4becff09611473a45bdf3cc Author: Glenn Morris Date: Wed Jul 26 12:38:46 2017 -0400 Stop using unibyte buffers for ert backtraces * lisp/emacs-lisp/ert.el (ert-results-pop-to-backtrace-for-test-at-point): Set multibyte true, not false. This copies a debugger-setup-buffer change from 2009-08-30, and stops the "Backtrace for" header line containing ^X and ^Y. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 5c88b070f6..5186199cfc 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -2406,8 +2406,7 @@ To be used in the ERT results buffer." (buffer-disable-undo) (erase-buffer) (ert-simple-view-mode) - ;; Use unibyte because `debugger-setup-buffer' also does so. - (set-buffer-multibyte nil) + (set-buffer-multibyte t) ; mimic debugger-setup-buffer (setq truncate-lines t) (ert--print-backtrace backtrace t) (goto-char (point-min)) commit 851452f8f754324bba3374c46d2029c3d23a339f Author: Dmitry Gutov Date: Wed Jul 26 19:34:48 2017 +0300 Fix semantic-symref-parse-tool-output-one-line after 644cdd1aa0 * lisp/cedet/semantic/symref/grep.el (semantic-symref-grep--line-re): Delete. (semantic-symref-parse-tool-output-one-line): Use regexp and group numbers from (grep-regexp-alist). diff --git a/lisp/cedet/semantic/symref/grep.el b/lisp/cedet/semantic/symref/grep.el index 42dc40cce0..df71508da7 100644 --- a/lisp/cedet/semantic/symref/grep.el +++ b/lisp/cedet/semantic/symref/grep.el @@ -189,26 +189,25 @@ This shell should support pipe redirect syntax." ;; Return the answer ans)) -(defconst semantic-symref-grep--line-re - "^\\(\\(?:[a-zA-Z]:\\)?[^:\n]+\\):\\([0-9]+\\):") - (cl-defmethod semantic-symref-parse-tool-output-one-line ((tool semantic-symref-tool-grep)) "Parse one line of grep output, and return it as a match list. Moves cursor to end of the match." - (cond ((eq (oref tool :resulttype) 'file) - ;; Search for files - (when (re-search-forward "^\\([^\n]+\\)$" nil t) - (match-string 1))) - ((eq (oref tool :resulttype) 'line-and-text) - (when (re-search-forward semantic-symref-grep--line-re nil t) - (list (string-to-number (match-string 2)) - (match-string 1) - (buffer-substring-no-properties (point) (line-end-position))))) - (t - (when (re-search-forward semantic-symref-grep--line-re nil t) - (cons (string-to-number (match-string 2)) - (match-string 1)) - )))) + (pcase-let + ((`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist)))) + (cond ((eq (oref tool :resulttype) 'file) + ;; Search for files + (when (re-search-forward "^\\([^\n]+\\)$" nil t) + (match-string 1))) + ((eq (oref tool :resulttype) 'line-and-text) + (when (re-search-forward grep-re nil t) + (list (string-to-number (match-string line-group)) + (match-string file-group) + (buffer-substring-no-properties (point) (line-end-position))))) + (t + (when (re-search-forward grep-re nil t) + (cons (string-to-number (match-string line-group)) + (match-string file-group)) + ))))) (provide 'semantic/symref/grep) commit 325ad16fe029d971613434f0f286dfd54a63ec05 Author: Grégoire Jadi Date: Wed Jul 26 18:46:16 2017 +0300 Fix cl-defmethod indentation * lisp/emacs-lisp/cl-generic.el (cl-defmethod): Declare (indent defun). Fixes bug#23994. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 6a4ee47ac2..1d29082c62 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -409,7 +409,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined \(and can be extended) by the various methods of `cl-generic-generalizers'. \(fn NAME [QUALIFIER] ARGS &rest [DOCSTRING] BODY)" - (declare (doc-string 3) (indent 2) + (declare (doc-string 3) (indent defun) (debug (&define ; this means we are defining something [&or name ("setf" name :name setf)] commit ea0aabb419cbf24d32dfb0f801e08bbf3160196e Author: Martin Rudalics Date: Wed Jul 26 10:14:06 2017 +0200 Fix two customization types in frame.el * lisp/frame.el (window-divider-default-bottom-width) (window-divider-default-right-width): Fix customization types. diff --git a/lisp/frame.el b/lisp/frame.el index 634367edf4..2a14302e9f 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2158,7 +2158,7 @@ To adjust bottom dividers for frames individually, use the frame parameter `bottom-divider-width'." :type '(restricted-sexp :tag "Default width of bottom dividers" - :match-alternatives (frame-window-divider-width-valid-p)) + :match-alternatives (window-divider-width-valid-p)) :initialize 'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) @@ -2175,7 +2175,7 @@ To adjust right dividers for frames individually, use the frame parameter `right-divider-width'." :type '(restricted-sexp :tag "Default width of right dividers" - :match-alternatives (frame-window-divider-width-valid-p)) + :match-alternatives (window-divider-width-valid-p)) :initialize 'custom-initialize-default :set (lambda (symbol value) (set-default symbol value) commit d5c41e99a2071e3ee491a53a0f9506f62fa6ae54 Author: Tino Calancha Date: Wed Jul 26 16:42:30 2017 +0900 Dired: Support eshell-ls from the beginning if the user wants to * lisp/dired.el (dired-insert-directory): Check for eshell-ls as well (Bug#27817). * test/lisp/dired-tests.el (dired-test-bug27817): Add test. diff --git a/lisp/dired.el b/lisp/dired.el index 9d500a9f52..3b29c7129d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1207,6 +1207,7 @@ If HDR is non-nil, insert a header line with the directory name." ;; as indicated by `ls-lisp-use-insert-directory-program'. (not (and (featurep 'ls-lisp) (null ls-lisp-use-insert-directory-program))) + (not (and (featurep 'eshell) (bound-and-true-p eshell-ls-use-in-dired))) (or (if (eq dired-use-ls-dired 'unspecified) ;; Check whether "ls --dired" gives exit code 0, and ;; save the answer in `dired-use-ls-dired'. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 69331457c0..601d65768b 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -175,5 +175,18 @@ (should (looking-at "src"))) (when (buffer-live-p buf) (kill-buffer buf))))) +(ert-deftest dired-test-bug27817 () + "Test for http://debbugs.gnu.org/27817 ." + (require 'em-ls) + (let ((orig eshell-ls-use-in-dired) + (dired-use-ls-dired 'unspecified) + buf insert-directory-program) + (unwind-protect + (progn + (customize-set-variable 'eshell-ls-use-in-dired t) + (should (setq buf (dired source-directory)))) + (customize-set-variable 'eshell-ls-use-in-dired orig) + (and (buffer-live-p buf) (kill-buffer))))) + (provide 'dired-tests) ;; dired-tests.el ends here commit 4d30cf6be29a5a5503f8f2f2c20c7241c15be5d5 Author: Mark Oteiza Date: Tue Jul 25 22:13:20 2017 -0400 * lisp/progmodes/sh-script.el (sh-mode): Recognize mkshrc. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 35b555e687..23e79f6ac5 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1683,6 +1683,7 @@ with your script for an edit-interpret-debug cycle." ((string-match "[.]sh\\>" buffer-file-name) "sh") ((string-match "[.]bash\\>" buffer-file-name) "bash") ((string-match "[.]ksh\\>" buffer-file-name) "ksh") + ((string-match "[.]mkshrc\\>" buffer-file-name) "mksh") ((string-match "[.]t?csh\\(rc\\)?\\>" buffer-file-name) "csh") ((string-match "[.]zsh\\(rc\\|env\\)?\\>" buffer-file-name) "zsh") ((equal (file-name-nondirectory buffer-file-name) ".profile") "sh") commit 24b91584c214caadff0f2394cf1f021bf480b624 Author: Stefan Monnier Date: Tue Jul 25 10:12:58 2017 -0400 * lisp/emacs-lisp/eieio-compat.el (eieio--defgeneric-init-form): Adjust to change in cl-generic-ensure-function. diff --git a/lisp/emacs-lisp/eieio-compat.el b/lisp/emacs-lisp/eieio-compat.el index e6e6d11870..8403a8a655 100644 --- a/lisp/emacs-lisp/eieio-compat.el +++ b/lisp/emacs-lisp/eieio-compat.el @@ -165,7 +165,8 @@ Summary: (if (memq method '(no-next-method no-applicable-method)) (symbol-function method) (let ((generic (cl-generic-ensure-function method))) - (symbol-function (cl--generic-name generic))))) + (or (symbol-function (cl--generic-name generic)) + (cl--generic-make-function generic))))) ;;;###autoload (defun eieio--defmethod (method kind argclass code) commit ea5789dac36adc0aaa76c7ca3aa497e7acd06b7a Author: Michael Albinus Date: Tue Jul 25 10:05:43 2017 +0200 ; Instrument entry of tramp--test-instrument-test-case diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bb1bafa789..58639e1bfa 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -149,6 +149,7 @@ handled properly. BODY shall not contain a timeout." (debug-ignored-errors (cons "^make-symbolic-link not supported$" debug-ignored-errors)) inhibit-message) + (message "tramp--test-instrument-test-case %s" tramp-verbose) (unwind-protect (let ((tramp--test-instrument-test-case-p t)) ,@body) ;; Unwind forms. @@ -3911,8 +3912,8 @@ Since it unloads Tramp, it shall be the last test to run." (should-not (cl--find-class 'tramp-file-name)) (mapatoms (lambda (x) - (and (string-match "tramp-file-name" (symbol-name x)) - (functionp x) + (and (functionp x) + (string-match "tramp-file-name" (symbol-name x)) (ert-fail (format "Structure function `%s' still exists" x))))) ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. commit 565cfd9f6c19e4d2aa318efdf19bdc56175bd153 Author: Tino Calancha Date: Tue Jul 25 14:53:44 2017 +0900 ls-lisp: Add an unload function and enable lexical binding Enable lexical binding. * lisp/ls-lisp.el (ls-lisp-unload-function): New defun. * test/lisp/ls-lisp.el (ls-lisp-unload): Add test. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index b368efbbc9..730ba26c6c 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -1,4 +1,4 @@ -;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp +;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp -*- lexical-binding: t -*- ;; Copyright (C) 1992, 1994, 2000-2017 Free Software Foundation, Inc. @@ -866,6 +866,12 @@ All ls time options, namely c, t and u, are handled." file-size) (format " %6s" (file-size-human-readable file-size)))) +(defun ls-lisp-unload-function () + "Unload ls-lisp library." + (advice-remove 'insert-directory #'ls-lisp--insert-directory) + ;; Continue standard unloading. + nil) + (provide 'ls-lisp) ;;; ls-lisp.el ends here diff --git a/test/lisp/ls-lisp.el b/test/lisp/ls-lisp.el new file mode 100644 index 0000000000..5ef7c78f4d --- /dev/null +++ b/test/lisp/ls-lisp.el @@ -0,0 +1,37 @@ +;;; ls-lisp-tests.el --- tests for ls-lisp.el -*- lexical-binding: t-*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calacha +;; Keywords: + +;; 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: + + +;;; Code: +(require 'ert) + +(ert-deftest ls-lisp-unload () + "Test for http://debbugs.gnu.org/xxxxx ." + (require 'ls-lisp) + (should (advice-member-p 'ls-lisp--insert-directory 'insert-directory)) + (unload-feature 'ls-lisp 'force) + (should-not (advice-member-p 'ls-lisp--insert-directory 'insert-directory))) + +(provide 'ls-lisp-tests) +;;; ls-lisp-tests.el ends here commit 35954cb92b8cd4ad093756d171688343bab02c2e Author: Tino Calancha Date: Tue Jul 25 11:38:28 2017 +0900 register-read-with-preview: Quit if user input C-g or ESC * lisp/register.el (register-read-with-preview): Quit if user input C-g or ESC (bug#27634). * doc/emacs/regs.texi (Registers): Update manual. * test/lisp/register-tests.el (register-test-bug27634): Add test. diff --git a/doc/emacs/regs.texi b/doc/emacs/regs.texi index 7369f6b05b..40e3e2c1c3 100644 --- a/doc/emacs/regs.texi +++ b/doc/emacs/regs.texi @@ -15,7 +15,10 @@ jump back to that position once, or many times. Each register has a name that consists of a single character, which we will denote by @var{r}; @var{r} can be a letter (such as @samp{a}) or a number (such as @samp{1}); case matters, so register @samp{a} is -not the same as register @samp{A}. +not the same as register @samp{A}. You can also set a register in +non-alphanumeric characters, for instance @samp{*} or @samp{C-d}. +Note, it's not possible to set a register in @samp{C-g} or @samp{ESC}, +because these keys are reserved to terminate interactive commands. @findex view-register A register can store a position, a piece of text, a rectangle, a diff --git a/lisp/register.el b/lisp/register.el index 7cc3ccd870..e395963f56 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -164,6 +164,10 @@ display such a window regardless." help-chars) (unless (get-buffer-window buffer) (register-preview buffer 'show-empty))) + (when (or (eq ?\C-g last-input-event) + (eq 'escape last-input-event) + (eq ?\C-\[ last-input-event)) + (keyboard-quit)) (if (characterp last-input-event) last-input-event (error "Non-character input-event"))) (and (timerp timer) (cancel-timer timer)) diff --git a/test/lisp/register-tests.el b/test/lisp/register-tests.el new file mode 100644 index 0000000000..0425bc0e0f --- /dev/null +++ b/test/lisp/register-tests.el @@ -0,0 +1,43 @@ +;;; register-tests.el --- tests for register.el -*- lexical-binding: t-*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Tino Calacha +;; Keywords: + +;; 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: + + +;;; Code: +(require 'ert) +(require 'cl-lib) + +(ert-deftest register-test-bug27634 () + "Test for http://debbugs.gnu.org/27634 ." + (dolist (event (list ?\C-g 'escape ?\C-\[)) + (cl-letf (((symbol-function 'read-key) #'ignore) + (last-input-event event) + (register-alist nil)) + (should (equal 'quit + (condition-case err + (call-interactively 'point-to-register) + (quit (car err))))) + (should-not register-alist)))) + +(provide 'register-tests) +;;; register-tests.el ends here commit df1a71272e5cdd10b511e2ffd702ca50ddd8a773 Merge: eb27fc4d49 32daa3cb54 Author: Michael R. Mauger Date: Mon Jul 24 22:15:04 2017 -0400 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 32daa3cb54523006c88717cbeac87964cd687a1b Author: Mark Oteiza Date: Mon Jul 24 20:17:50 2017 -0400 ; Fix previous commit Functions prefixed with `turn-on-foo' are quite old, and in general subsumed by the corresponding `foo-mode` command. * lisp/display-line-numbers.el (turn-on-display-line-numbers-mode): Rename with library prefix, mark as internal. Nix autoload. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index d0c1750cf3..a99474547b 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -90,8 +90,7 @@ the mode is on, set `display-line-numbers' directly." (remove-hook 'pre-command-hook #'display-line-numbers-update-width t) (setq display-line-numbers nil))) -;;;###autoload -(defun turn-on-display-line-numbers-mode () +(defun display-line-numbers--turn-on () "Turn on `display-line-numbers-mode'." (unless (or (minibufferp) ;; taken from linum.el @@ -100,7 +99,7 @@ the mode is on, set `display-line-numbers' directly." ;;;###autoload (define-globalized-minor-mode global-display-line-numbers-mode - display-line-numbers-mode turn-on-display-line-numbers-mode) + display-line-numbers-mode display-line-numbers--turn-on) (provide 'display-line-numbers) commit f23090d03b684f37e027e1b2db45819d4fae60e0 Author: Mark Oteiza Date: Mon Jul 24 20:13:33 2017 -0400 Recognize MirBSD Korn shell rc file * lisp/files.el (auto-mode-alist): Add .mkshrc to the list. diff --git a/lisp/files.el b/lisp/files.el index 2f3efa33c2..321a35b530 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2543,7 +2543,7 @@ since only a single case-insensitive search through the alist is made." ("\\.[ckz]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode) ("\\.bash\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\(bash_\\(profile\\|history\\|log\\(in\\|out\\)\\)\\|z?log\\(in\\|out\\)\\)\\'" . sh-mode) - ("\\(/\\|\\`\\)\\.\\(shrc\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) + ("\\(/\\|\\`\\)\\.\\(shrc\\|zshrc\\|m?kshrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode) ("\\(/\\|\\`\\)\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode) ("\\.m?spec\\'" . sh-mode) ("\\.m[mes]\\'" . nroff-mode) commit 4a6558983dfe1783fc2d5ea2cf591524864ace23 Author: Glenn Morris Date: Mon Jul 24 19:51:27 2017 -0400 * configure.ac: Be explicit about ImageMagick version in summary. diff --git a/configure.ac b/configure.ac index 648da9939d..e4647c6a30 100644 --- a/configure.ac +++ b/configure.ac @@ -5462,7 +5462,7 @@ AS_ECHO([" Does Emacs use -lXaw3d? ${HAVE_XAW3D Does Emacs use a png library? ${HAVE_PNG} $LIBPNG Does Emacs use -lrsvg-2? ${HAVE_RSVG} Does Emacs use cairo? ${HAVE_CAIRO} - Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK} + Does Emacs use imagemagick (version 6)? ${HAVE_IMAGEMAGICK} Does Emacs support sound? ${HAVE_SOUND} Does Emacs use -lgpm? ${HAVE_GPM} Does Emacs use -ldbus? ${HAVE_DBUS} commit 7a4d9f6304cffa39642507609605bcbfa40d4675 Author: Andreas Schwab Date: Tue Jul 25 01:12:50 2017 +0200 Properly align global lispsym * lib-src/make-docfile.c (close_emacs_globals): Wrap struct Lisp_Symbols inside struct. * src/alloc.c (sweep_symbols): Update use of lispsym. * src/lisp.h (builtin_lisp_symbol): Likewise. diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 6b2cc11040..ecd6447ab7 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -667,7 +667,9 @@ close_emacs_globals (ptrdiff_t num_symbols) "#ifndef DEFINE_SYMBOLS\n" "extern\n" "#endif\n" - "struct Lisp_Symbol alignas (GCALIGNMENT) lispsym[%td];\n"), + "struct {\n" + " struct Lisp_Symbol alignas (GCALIGNMENT) s;\n" + "} lispsym[%td];\n"), num_symbols); } diff --git a/src/alloc.c b/src/alloc.c index 2d785d5b9a..2cee646256 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6943,7 +6943,7 @@ sweep_symbols (void) symbol_free_list = NULL; for (int i = 0; i < ARRAYELTS (lispsym); i++) - lispsym[i].gcmarkbit = 0; + lispsym[i].s.gcmarkbit = 0; for (sblk = symbol_block; sblk; sblk = *sprev) { diff --git a/src/lisp.h b/src/lisp.h index 9464bf8559..cffaf954b3 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -838,13 +838,13 @@ make_lisp_symbol (struct Lisp_Symbol *sym) INLINE Lisp_Object builtin_lisp_symbol (int index) { - return make_lisp_symbol (lispsym + index); + return make_lisp_symbol (&lispsym[index].s); } INLINE void (CHECK_SYMBOL) (Lisp_Object x) { - lisp_h_CHECK_SYMBOL (x); + lisp_h_CHECK_SYMBOL (x); } /* In the size word of a vector, this bit means the vector has been marked. */ commit b46a02eda44161afd4b2a6b0cdb1fed3efc504fd Author: Paul Eggert Date: Mon Jul 24 15:13:26 2017 -0700 Do not use ImageMagick 7 and later Suggested by Glenn Morris (Bug#25967#15). * configure.ac (IMAGEMAGICK_MODULE): Reject 7 and later. diff --git a/configure.ac b/configure.ac index 5e6dbda2b6..648da9939d 100644 --- a/configure.ac +++ b/configure.ac @@ -2507,7 +2507,8 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" if test "${with_imagemagick}" != "no"; then ## 6.3.5 is the earliest version known to work; see Bug#17339. ## 6.8.2 makes Emacs crash; see Bug#13867. - IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2" + ## 7 and later have not been ported to; See Bug#25967. + IMAGEMAGICK_MODULE="Wand >= 6.3.5 Wand != 6.8.2 Wand < 7" EMACS_CHECK_MODULES([IMAGEMAGICK], [$IMAGEMAGICK_MODULE]) if test $HAVE_IMAGEMAGICK = yes; then commit 3d847fa9fd68592c50ea5e18c86b9f3eb5030654 Author: Stefan Monnier Date: Mon Jul 24 18:10:02 2017 -0400 * lisp/progmodes/perl-mode.el: Add support for indented here docs * lisp/progmodes/perl-mode.el (perl-syntax-propertize-function): Recognize the new <<~ syntax for indented here docs. (perl-syntax-propertize-special-constructs): Adjust search of the end of here docs accordingly. * test/manual/indent/perl.perl: Add test for indented here docs. diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index 3def37a2ea..6197a53ee6 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -213,25 +213,6 @@ (regexp-opt perl--syntax-exp-intro-keywords) "\\|[-?:.,;|&+*=!~({[]\\|\\(^\\)\\)[ \t\n]*"))) -;; FIXME: handle here-docs and regexps. -;; < /.../ -;; s '...'...' -;; tr /.../.../ -;; y /.../.../ -;; -;; (defun perl-syntax-propertize-function (start end) (let ((case-fold-search nil)) (goto-char start) @@ -324,23 +305,25 @@ ((concat "\\(?:" ;; << "EOF", << 'EOF', or << \EOF - "<<[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" + "<<\\(~\\)?[ \t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)" ;; The < Date: Mon Jul 24 15:58:30 2017 -0400 (loadhist-unload-element): Move ERT and cl-generic methods * lisp/loadhist.el (loadhist-unload-element): Don't define cl-generic and ert methods here. (loadhist-unload-element) <(head define-type)>: Remove unused var `slots'. * lisp/emacs-lisp/cl-generic.el (loadhist-unload-element): Define unload method for cl-defmethod. (cl-generic-ensure-function): Remove redundant `defalias'. * lisp/emacs-lisp/ert.el (ert-set-test): Move the current-load-list setting here... (ert-deftest): ...from here. (loadhist-unload-element): Define unload method for ert-deftest. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c64376b940..6a4ee47ac2 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -182,8 +182,7 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG origname)) (if generic (cl-assert (eq name (cl--generic-name generic))) - (setf (cl--generic name) (setq generic (cl--generic-make name))) - (defalias name (cl--generic-make-function generic))) + (setf (cl--generic name) (setq generic (cl--generic-make name)))) generic)) ;;;###autoload @@ -1210,5 +1209,18 @@ Used internally for the (major-mode MODE) context specializers." (progn (cl-assert (null modes)) mode) `(derived-mode ,mode . ,modes)))) +;;; Support for unloading. + +(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) + (pcase-let* + ((`(,name ,qualifiers . ,specializers) (cdr x)) + (generic (cl-generic-ensure-function name 'noerror))) + (when generic + (let* ((mt (cl--generic-method-table generic)) + (me (cl--generic-member-method specializers qualifiers mt))) + (when me + (setf (cl--generic-method-table generic) (delq (car me) mt))))))) + + (provide 'cl-generic) ;;; cl-generic.el ends here diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index cee225cc8e..5c88b070f6 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -136,8 +136,15 @@ Emacs bug 6581 at URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=6581'." ;; ert-test objects. It designates an anonymous test. (error "Attempt to define a test named nil")) (put symbol 'ert--test definition) + ;; Register in load-history, so `symbol-file' can find us, and so + ;; unload-feature can unload our tests. + (cl-pushnew `(ert-deftest . ,symbol) current-load-list :test #'equal) definition) +(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) + (let ((name (cdr x))) + (put name 'ert--test nil))) + (defun ert-make-test-unbound (symbol) "Make SYMBOL name no test. Return SYMBOL." (cl-remprop symbol 'ert--test) @@ -214,12 +221,6 @@ description of valid values for RESULT-TYPE. ,@(when tags-supplied-p `(:tags ,tags)) :body (lambda () ,@body))) - ;; This hack allows `symbol-file' to associate `ert-deftest' - ;; forms with files, and therefore enables `find-function' to - ;; work with tests. However, it leads to warnings in - ;; `unload-feature', which doesn't know how to undefine tests - ;; and has no mechanism for extension. - (push '(ert-deftest . ,name) current-load-list) ',name)))) ;; We use these `put' forms in addition to the (declare (indent)) in diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 693050d704..24c3acd1b9 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -196,11 +196,8 @@ restore a previous autoload if possible.") (cl-defmethod loadhist-unload-element ((x (head autoload))) (loadhist--unload-function x)) -(cl-defmethod loadhist-unload-element ((x (head require))) nil) -(cl-defmethod loadhist-unload-element ((x (head defface))) nil) -;; The following two might require more actions. -(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) nil) -(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) nil) +(cl-defmethod loadhist-unload-element ((_ (head require))) nil) +(cl-defmethod loadhist-unload-element ((_ (head defface))) nil) (cl-defmethod loadhist-unload-element ((x (head provide))) ;; Remove any feature names that this file provided. @@ -220,8 +217,7 @@ restore a previous autoload if possible.") (makunbound x))) (cl-defmethod loadhist-unload-element ((x (head define-type))) - (let* ((name (cdr x)) - (slots (mapcar 'car (cdr (cl-struct-slot-info name))))) + (let* ((name (cdr x))) ;; Remove the struct. (setf (cl--find-class name) nil))) commit f07b12c1d036e50daa25b3a18b13686be6628c4d Author: Michael Albinus Date: Mon Jul 24 19:38:17 2017 +0200 Fix Bug#27371 * lisp/loadhist.el (loadhist-unload-element): Declare for different entry types of `load-history'. (loadhist--restore-autoload): New variable. (loadhist--unload-function): New defun. (unload-feature): Use `loadhist-unload-element'. Recommended by Stefan Monnier. (Bug#27371) * test/lisp/net/tramp-tests.el (tramp-test39-unload): Check, that the `tramp-file-name' structure has been unloaded. diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 28d0b18c81..693050d704 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -162,6 +162,69 @@ documentation of `unload-feature' for details.") ;; mode, or proposed is not nil and not major-mode, and so we use it. (funcall (or proposed 'fundamental-mode))))))) +(cl-defgeneric loadhist-unload-element (x) + "Unload an element from the `load-history'." + (message "Unexpected element %S in load-history" x)) + +;; In `load-history', the definition of a previously autoloaded +;; function is represented by 2 entries: (t . SYMBOL) comes before +;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when +;; we undefine it. +;; So we use this auxiliary variable to keep track of the last (t . SYMBOL) +;; that occurred. +(defvar loadhist--restore-autoload + "If non-nil, this is a symbol for which we should +restore a previous autoload if possible.") + +(cl-defmethod loadhist-unload-element ((x (head t))) + (setq loadhist--restore-autoload (cdr x))) + +(defun loadhist--unload-function (x) + (let ((fun (cdr x))) + (when (fboundp fun) + (when (fboundp 'ad-unadvise) + (ad-unadvise fun)) + (let ((aload (get fun 'autoload))) + (defalias fun + (if (and aload (eq fun loadhist--restore-autoload)) + (cons 'autoload aload) + nil))))) + (setq loadhist--restore-autoload nil)) + +(cl-defmethod loadhist-unload-element ((x (head defun))) + (loadhist--unload-function x)) +(cl-defmethod loadhist-unload-element ((x (head autoload))) + (loadhist--unload-function x)) + +(cl-defmethod loadhist-unload-element ((x (head require))) nil) +(cl-defmethod loadhist-unload-element ((x (head defface))) nil) +;; The following two might require more actions. +(cl-defmethod loadhist-unload-element ((x (head ert-deftest))) nil) +(cl-defmethod loadhist-unload-element ((x (head cl-defmethod))) nil) + +(cl-defmethod loadhist-unload-element ((x (head provide))) + ;; Remove any feature names that this file provided. + (setq features (delq (cdr x) features))) + +(cl-defmethod loadhist-unload-element ((x symbol)) + ;; Kill local values as much as possible. + (dolist (buf (buffer-list)) + (with-current-buffer buf + (if (and (boundp x) (timerp (symbol-value x))) + (cancel-timer (symbol-value x))) + (kill-local-variable x))) + (if (and (boundp x) (timerp (symbol-value x))) + (cancel-timer (symbol-value x))) + ;; Get rid of the default binding if we can. + (unless (local-variable-if-set-p x) + (makunbound x))) + +(cl-defmethod loadhist-unload-element ((x (head define-type))) + (let* ((name (cdr x)) + (slots (mapcar 'car (cdr (cl-struct-slot-info name))))) + ;; Remove the struct. + (setf (cl--find-class name) nil))) + ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE. @@ -200,9 +263,6 @@ something strange, such as redefining an Emacs function." (prin1-to-string dependents) file)))) (let* ((unload-function-defs-list (feature-symbols feature)) (file (pop unload-function-defs-list)) - ;; If non-nil, this is a symbol for which we should - ;; restore a previous autoload if possible. - restore-autoload (name (symbol-name feature)) (unload-hook (intern-soft (concat name "-unload-hook"))) (unload-func (intern-soft (concat name "-unload-function")))) @@ -250,38 +310,7 @@ something strange, such as redefining an Emacs function." (when (symbolp elt) (elp-restore-function elt)))) - (dolist (x unload-function-defs-list) - (if (consp x) - (pcase (car x) - ;; Remove any feature names that this file provided. - (`provide - (setq features (delq (cdr x) features))) - ((or `defun `autoload) - (let ((fun (cdr x))) - (when (fboundp fun) - (when (fboundp 'ad-unadvise) - (ad-unadvise fun)) - (let ((aload (get fun 'autoload))) - (if (and aload (eq fun restore-autoload)) - (fset fun (cons 'autoload aload)) - (fmakunbound fun)))))) - ;; (t . SYMBOL) comes before (defun . SYMBOL) - ;; and says we should restore SYMBOL's autoload - ;; when we undefine it. - (`t (setq restore-autoload (cdr x))) - ((or `require `defface) nil) - (_ (message "Unexpected element %s in load-history" x))) - ;; Kill local values as much as possible. - (dolist (buf (buffer-list)) - (with-current-buffer buf - (if (and (boundp x) (timerp (symbol-value x))) - (cancel-timer (symbol-value x))) - (kill-local-variable x))) - (if (and (boundp x) (timerp (symbol-value x))) - (cancel-timer (symbol-value x))) - ;; Get rid of the default binding if we can. - (unless (local-variable-if-set-p x) - (makunbound x)))) + (mapc #'loadhist-unload-element unload-function-defs-list) ;; Delete the load-history element for this file. (setq load-history (delq (assoc file load-history) load-history)))) ;; Don't return load-history, it is not useful. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 94e91b7930..bb1bafa789 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3906,6 +3906,14 @@ Since it unloads Tramp, it shall be the last test to run." (not (string-match "^tramp--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) (ert-fail (format "`%s' still bound" x))))) + ;; The defstruct `tramp-file-name' and all its internal functions + ;; shall be purged. + (should-not (cl--find-class 'tramp-file-name)) + (mapatoms + (lambda (x) + (and (string-match "tramp-file-name" (symbol-name x)) + (functionp x) + (ert-fail (format "Structure function `%s' still exists" x))))) ;; There shouldn't be left a hook function containing a Tramp ;; function. We do not regard the Tramp unload hooks. (mapatoms commit fe25d0ce8e8b44c3e2ce84ac470822a299199445 Author: Grégoire Jadi Date: Mon Jul 24 17:29:28 2017 +0200 Ensure that we parse images right in shr.el * lisp/net/shr.el (shr-image-fetched): Go back to the beginning of the buffer before trying to parse the image fetched. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 2f73f982af..fe93fc32ad 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -945,6 +945,7 @@ If EXTERNAL, browse the URL using `shr-external-browser'." (when (and (buffer-name buffer) (not (plist-get status :error))) (url-store-in-cache image-buffer) + (goto-char (point-min)) (when (or (search-forward "\n\n" nil t) (search-forward "\r\n\r\n" nil t)) (let ((data (shr-parse-image-data))) commit 6dc5d45c542a6f9cfbcf3e37d597c9e0efb3070d Author: Paul Eggert Date: Sun Jul 23 22:40:21 2017 -0700 Update .gitignore for Valgrind and no Automake * .gitignore: Remove .deps/ since we no longer use Automake. Add vgcore.*[0-9], for debugging Emacs with Valgrind+GDB. diff --git a/.gitignore b/.gitignore index 46ed4a137d..9229297833 100644 --- a/.gitignore +++ b/.gitignore @@ -111,7 +111,6 @@ lisp/mh-e/mh-autoloads.el lisp/subdirs.el # Dependencies. -.deps/ deps/ # Logs and temporaries. @@ -138,6 +137,7 @@ gmon.out oo/ oo-spd/ src/*.map +vgcore.*[0-9] # Tests. test/manual/biditest.txt commit 9b971bdd340e83c71068892d41baeb243e233f71 Author: Paul Eggert Date: Sun Jul 23 22:21:38 2017 -0700 Merge from gnulib This incorporates: 2017-07-23 Rename module 'strftime' to 'nstrftime' * admin/merge-gnulib (GNULIB_MODULES): Add nstrftime, remove strftime. * build-aux/config.guess: Copy from gnulib. * lib/nstrftime.c: Rename from lib/strftime.c. * m4/nstrftime.m4: Rename from m4/strftime.m4. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 2b1a16a10e..18c9ee8def 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -35,10 +35,10 @@ GNULIB_MODULES=' filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat - manywarnings memrchr minmax mkostemp mktime + manywarnings memrchr minmax mkostemp mktime nstrftime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio - stpcpy strftime strtoimax symlink sys_stat + stpcpy strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub update-copyright unlocked-io utimens vla warnings diff --git a/build-aux/config.guess b/build-aux/config.guess index 2193702b12..07785f5451 100755 --- a/build-aux/config.guess +++ b/build-aux/config.guess @@ -2,7 +2,7 @@ # Attempt to guess a canonical system name. # Copyright 1992-2017 Free Software Foundation, Inc. -timestamp='2017-05-27' +timestamp='2017-07-19' # This file is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by @@ -1429,8 +1429,8 @@ cat >&2 < Date: Mon Jul 24 11:58:35 2017 +0900 ; Don't keep temporary buffers alive after a dired test * test/lisp/dired-tests.el (dired-test-bug22694) (dired-test-bug25609, dired-test-bug27243) Delete all temporary dired buffers at the end. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index bd1816172e..69331457c0 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -38,19 +38,21 @@ (file "test") (full-name (expand-file-name file dir)) (regexp "bar") - (dired-always-read-filesystem t)) + (dired-always-read-filesystem t) buffers) (if (file-exists-p dir) (delete-directory dir 'recursive)) (make-directory dir) (with-temp-file full-name (insert "foo")) - (find-file-noselect full-name) - (dired dir) + (push (find-file-noselect full-name) buffers) + (push (dired dir) buffers) (with-temp-file full-name (insert "bar")) (dired-mark-files-containing-regexp regexp) (unwind-protect (should (equal (dired-get-marked-files nil nil nil 'distinguish-1-mark) `(t ,full-name))) ;; Clean up + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory dir 'recursive)))) (ert-deftest dired-test-bug25609 () @@ -60,7 +62,8 @@ (target (expand-file-name (file-name-nondirectory from) to)) (nested (expand-file-name (file-name-nondirectory from) target)) (dired-dwim-target t) - (dired-recursive-copies 'always)) ; Don't prompt me. + (dired-recursive-copies 'always) ; Don't prompt me. + buffers) (advice-add 'dired-query ; Don't ask confirmation to overwrite a file. :override (lambda (_sym _prompt &rest _args) (setq dired-query t)) @@ -70,8 +73,8 @@ (lambda (_prompt _coll &optional _pred _match init _hist _def _inherit _keymap) init) '((name . "advice-completing-read"))) - (dired to) - (dired-other-window temporary-file-directory) + (push (dired to) buffers) + (push (dired-other-window temporary-file-directory) buffers) (dired-goto-file from) (dired-do-copy) (dired-do-copy); Again. @@ -79,6 +82,8 @@ (progn (should (file-exists-p target)) (should-not (file-exists-p nested))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory from 'recursive) (delete-directory to 'recursive) (advice-remove 'dired-query "advice-dired-query") @@ -87,10 +92,10 @@ (ert-deftest dired-test-bug27243 () "Test for http://debbugs.gnu.org/27243 ." (let ((test-dir (make-temp-file "test-dir-" t)) - (dired-auto-revert-buffer t)) + (dired-auto-revert-buffer t) buffers) (with-current-buffer (find-file-noselect test-dir) (make-directory "test-subdir")) - (dired test-dir) + (push (dired test-dir) buffers) (unwind-protect (let ((buf (current-buffer)) (pt1 (point)) @@ -101,17 +106,19 @@ (should (equal (dired-file-name-at-point) (concat (file-name-as-directory test-dir) (file-name-as-directory "test-subdir")))) - (dired-find-file) + (push (dired-find-file) buffers) (let ((pt2 (point))) ; Point is on test-file. (switch-to-buffer buf) ;; Sanity check: point should now be back on the subdirectory. (should (eq (point) pt1)) ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 - (dired-find-file) + (push (dired-find-file) buffers) (should (eq (point) pt2)) ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 - (dired test-dir) + (push (dired test-dir) buffers) (should (eq (point) pt1)))) + (dolist (buf buffers) + (when (buffer-live-p buf) (kill-buffer buf))) (delete-directory test-dir t)))) (ert-deftest dired-test-bug27693 () commit ad4eff3b905dbc32e2d38bfec1e4f93eceec288d Author: Philipp Stephani Date: Thu Jul 20 21:36:18 2017 +0200 Add 'rx' pattern for pcase. * lisp/emacs-lisp/rx.el (rx): New pcase macro. * test/lisp/emacs-lisp/rx-tests.el (rx-pcase): Add unit test. diff --git a/etc/NEWS b/etc/NEWS index 4cb02bf518..f43491b630 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1555,6 +1555,9 @@ manual. ** 'tcl-auto-fill-mode' is now declared obsolete. Its functionality can be replicated simply by setting 'comment-auto-fill-only-comments'. +** New pcase pattern 'rx' to match against a rx-style regular +expression. + * Changes in Emacs 26.1 on Non-Free Operating Systems diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 4a06ab25d3..b40161104d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -930,6 +930,5 @@ QPAT can take the following forms: ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) (t (error "Unknown QPAT: %S" qpat)))) - (provide 'pcase) ;;; pcase.el ends here diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 386232c6ee..b66f2c6d51 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -1169,6 +1169,62 @@ enclosed in `(and ...)'. (rx-to-string `(and ,@regexps) t)) (t (rx-to-string (car regexps) t)))) + + +(pcase-defmacro rx (&rest regexps) + "Build a `pcase' pattern matching `rx' regexps. +The REGEXPS are interpreted as by `rx'. The pattern matches if +the regular expression so constructed matches the object, as if +by `string-match'. + +In addition to the usual `rx' constructs, REGEXPS can contain the +following constructs: + + (let VAR FORM...) creates a new explicitly numbered submatch + that matches FORM and binds the match to + VAR. + (backref VAR) creates a backreference to the submatch + introduced by a previous (let VAR ...) + construct. + +The VARs are associated with explicitly numbered submatches +starting from 1. Multiple occurrences of the same VAR refer to +the same submatch. + +If a case matches, the match data is modified as usual so you can +use it in the case body, but you still have to pass the correct +string as argument to `match-string'." + (let* ((vars ()) + (rx-constituents + `((let + ,(lambda (form) + (rx-check form) + (let ((var (cadr form))) + (cl-check-type var symbol) + (let ((i (or (cl-position var vars :test #'eq) + (prog1 (length vars) + (setq vars `(,@vars ,var)))))) + (rx-form `(submatch-n ,(1+ i) ,@(cddr form)))))) + 1 nil) + (backref + ,(lambda (form) + (rx-check form) + (rx-backref + `(backref ,(let ((var (cadr form))) + (if (integerp var) var + (1+ (cl-position var vars :test #'eq))))))) + 1 1 + ,(lambda (var) + (cond ((integerp var) (rx-check-backref var)) + ((memq var vars) t) + (t (error "rx `backref' variable must be one of %s: %s" + vars var))))) + ,@rx-constituents)) + (regexp (rx-to-string `(seq ,@regexps) :no-group))) + `(and (pred (string-match ,regexp)) + ,@(cl-loop for i from 1 + for var in vars + collect `(app (match-string ,i) ,var))))) ;; ;; sregex.el replacement diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index 8b7945c9d2..8f353b7e86 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el @@ -33,5 +33,15 @@ (number-sequence ?< ?\]) (number-sequence ?- ?:)))))) +(ert-deftest rx-pcase () + (should (equal (pcase "a 1 2 3 1 1 b" + ((rx (let u (+ digit)) space + (let v (+ digit)) space + (let v (+ digit)) space + (backref u) space + (backref 1)) + (list u v))) + '("1" "3")))) + (provide 'rx-tests) ;; rx-tests.el ends here. commit f57c7107727a615e217f1c245c400722c1422870 Author: Mark Oteiza Date: Sun Jul 23 15:41:51 2017 -0400 Use a named function for global minor mode turn-on argument * lisp/display-line-numbers.el (turn-on-display-line-numbers-mode): New function. (global-display-line-numbers-mode): Use it. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index 0351fc2871..d0c1750cf3 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -90,14 +90,17 @@ the mode is on, set `display-line-numbers' directly." (remove-hook 'pre-command-hook #'display-line-numbers-update-width t) (setq display-line-numbers nil))) +;;;###autoload +(defun turn-on-display-line-numbers-mode () + "Turn on `display-line-numbers-mode'." + (unless (or (minibufferp) + ;; taken from linum.el + (and (daemonp) (null (frame-parameter nil 'client)))) + (display-line-numbers-mode))) + ;;;###autoload (define-globalized-minor-mode global-display-line-numbers-mode - display-line-numbers-mode - (lambda () - (unless (or (minibufferp) - ;; taken from linum.el - (and (daemonp) (null (frame-parameter nil 'client)))) - (display-line-numbers-mode)))) + display-line-numbers-mode turn-on-display-line-numbers-mode) (provide 'display-line-numbers) commit 2c87aab57946b95d67b664259f30e64468d08544 Author: Charles A. Roelli Date: Mon Jul 10 21:08:14 2017 +0200 Enable GUI Emacs without 'make install' on macOS (Bug #27645) * nextstep/INSTALL: Correct it, and mention that Emacs can be run from 'src/emacs'. * src/nsterm.m (applicationDidFinishLaunching:): When Emacs is launched outside of a macOS application bundle, change its activation policy from the default 'prohibited' to 'regular'. ; * etc/NEWS: Mention the change on macOS. diff --git a/etc/NEWS b/etc/NEWS index 4324d87991..4cb02bf518 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1600,6 +1600,9 @@ debugger has been attached to it. ** 'set-mouse-position' and 'set-mouse-absolute-pixel-position' work on macOS. +** Emacs can now be run as a GUI application from the command line on +macOS. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/nextstep/INSTALL b/nextstep/INSTALL index 799cd4d866..b7e84e018e 100644 --- a/nextstep/INSTALL +++ b/nextstep/INSTALL @@ -21,15 +21,23 @@ In the top-level directory, use: (On macOS, --with-ns is enabled by default.) -This will compile all the files, but emacs will not be able to be run except -in -nw (terminal) mode. +Then run: -In order to run Emacs.app, you must run: + make + +This will compile all the files. + +In order to run Emacs, you must run: + + src/emacs + +In order to install Emacs, you must run: make install This will assemble the app in nextstep/Emacs.app (i.e., the --prefix -argument has no effect in this case). +argument has no effect in this case). You can then move the Emacs.app +bundle to a location of your choice. If you pass the --disable-ns-self-contained option to configure, the lisp files will be installed under whatever 'prefix' is set to (defaults to diff --git a/src/nsterm.m b/src/nsterm.m index a3c7031331..36d906a7ce 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -5497,6 +5497,19 @@ - (void)applicationDidFinishLaunching: (NSNotification *)notification object:nil]; #endif +#ifdef NS_IMPL_COCOA + if ([NSApp activationPolicy] == NSApplicationActivationPolicyProhibited) { + /* Set the app's activation policy to regular when we run outside + of a bundle. This is already done for us by Info.plist when we + run inside a bundle. */ + [NSApp setActivationPolicy:NSApplicationActivationPolicyRegular]; + [NSApp setApplicationIconImage: + [EmacsImage + allocInitFromFile: + build_string("icons/hicolor/128x128/apps/emacs.png")]]; + } +#endif + ns_send_appdefined (-2); } commit e1d1aa69e8cce480f51ebf81d5b0bb55c7ad4ec8 Author: Alan Mackenzie Date: Sun Jul 23 13:48:36 2017 +0000 Convert CC Mode's c-found-types from an obarray to a hash table. * lisp/progmodes/cc-engine.el (c-clear-found-types): create a hash table rather than an obarray. (c-copy-found-types): Remove. (c-add-type, c-unfind-type, c-check-type, c-list-found-types): Amend to use the new hash table. (c-forward-<>-arglist): Use copy-hash-table rather than c-copy-found-types. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 22f5b906e4..59dc96af03 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6089,14 +6089,8 @@ comment at the start of cc-engine.el for more info." (defsubst c-clear-found-types () ;; Clears `c-found-types'. - (setq c-found-types (make-vector 53 0))) - -(defun c-copy-found-types () - (let ((copy (make-vector 53 0))) - (mapatoms (lambda (sym) - (intern (symbol-name sym) copy)) - c-found-types) - copy)) + (setq c-found-types + (make-hash-table :test #'equal :weakness nil))) (defun c-add-type (from to) ;; Add the given region as a type in `c-found-types'. If the region @@ -6110,29 +6104,27 @@ comment at the start of cc-engine.el for more info." ;; ;; This function might do hidden buffer changes. (let ((type (c-syntactic-content from to c-recognize-<>-arglists))) - (unless (intern-soft type c-found-types) - (unintern (substring type 0 -1) c-found-types) - (intern type c-found-types)))) + (unless (gethash type c-found-types) + (remhash (substring type 0 -1) c-found-types) + (puthash type t c-found-types)))) (defun c-unfind-type (name) ;; Remove the "NAME" from c-found-types, if present. - (unintern name c-found-types)) + (remhash name c-found-types)) (defsubst c-check-type (from to) ;; Return non-nil if the given region contains a type in ;; `c-found-types'. ;; ;; This function might do hidden buffer changes. - (intern-soft (c-syntactic-content from to c-recognize-<>-arglists) - c-found-types)) + (gethash (c-syntactic-content from to c-recognize-<>-arglists) c-found-types)) (defun c-list-found-types () ;; Return all the types in `c-found-types' as a sorted list of ;; strings. (let (type-list) - (mapatoms (lambda (type) - (setq type-list (cons (symbol-name type) - type-list))) + (maphash (lambda (type _) + (setq type-list (cons type type-list))) c-found-types) (sort type-list 'string-lessp))) @@ -7066,7 +7058,7 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let ((start (point)) - (old-found-types (c-copy-found-types)) + (old-found-types (copy-hash-table c-found-types)) ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. commit e33ddda3bfb134756ae1a706bf8ea218c7312f2d Author: Lars Ingebrigtsen Date: Sun Jul 23 15:22:48 2017 +0200 Fix image/svg+xml display in shr * lisp/net/shr.el (shr-put-image): Display svg images as svg (bug#27799). I suspect the previous change was checked in by accident in conjuction with some other svg changes. diff --git a/lisp/net/shr.el b/lisp/net/shr.el index 4d4e8a809e..2f73f982af 100644 --- a/lisp/net/shr.el +++ b/lisp/net/shr.el @@ -998,7 +998,7 @@ element is the data blob and the second element is the content-type." (create-image data nil t :ascent 100 :format content-type)) ((eq content-type 'image/svg+xml) - (create-image data 'imagemagick t :ascent 100)) + (create-image data 'svg t :ascent 100)) ((eq size 'full) (ignore-errors (shr-rescale-image data content-type commit 012487bc4188f812102ce0e431ad242cb1f65942 Author: Michael Albinus Date: Sun Jul 23 09:28:35 2017 +0200 * lisp/display-line-numbers.el (display-line-numbers-type): Autoload it. diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el index 95237250f9..0351fc2871 100644 --- a/lisp/display-line-numbers.el +++ b/lisp/display-line-numbers.el @@ -38,6 +38,7 @@ "Display line numbers in the buffer." :group 'display) +;;;###autoload (defcustom display-line-numbers-type t "The default type of line numbers to use in `display-line-numbers-mode'. See `display-line-numbers' for value options." commit e7f65187580342171dd9ad32e570c50c96badb13 Author: Glenn Morris Date: Sat Jul 22 18:43:28 2017 -0700 Don't automatically enable Gconf if Gsettings was found * configure.ac (HAVE_GCONF) [HAVE_GSETTINGS]: Don't test for Gconf unless specifically requested. Gconf was deprecated in favor of Gsettings several years ago. diff --git a/configure.ac b/configure.ac index b127563c9d..5e6dbda2b6 100644 --- a/configure.ac +++ b/configure.ac @@ -352,7 +352,8 @@ OPTION_DEFAULT_OFF([w32], [use native MS Windows GUI in a Cygwin build]) OPTION_DEFAULT_ON([gpm],[don't use -lgpm for mouse support on a GNU/Linux console]) OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) -OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) +AC_ARG_WITH([gconf],[AS_HELP_STRING([--with-gconf], +[compile with Gconf support (Gsettings replaces this)])],[],[with_gconf=maybe]) OPTION_DEFAULT_ON([gsettings],[don't compile with GSettings support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) @@ -2775,6 +2776,7 @@ if test "${HAVE_X11}" = "yes" && test "${with_gsettings}" = "yes"; then AC_DEFINE(HAVE_GSETTINGS, 1, [Define to 1 if using GSettings.]) SETTINGS_CFLAGS="$GSETTINGS_CFLAGS" SETTINGS_LIBS="$GSETTINGS_LIBS" + test "$with_gconf" = "yes" || with_gconf=no fi CFLAGS=$old_CFLAGS LIBS=$old_LIBS @@ -2784,7 +2786,7 @@ fi dnl GConf has been tested under GNU/Linux only. dnl The version is really arbitrary, it is about the same age as Gtk+ 2.6. HAVE_GCONF=no -if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then +if test "${HAVE_X11}" = "yes" && test "${with_gconf}" != "no"; then EMACS_CHECK_MODULES([GCONF], [gconf-2.0 >= 2.13]) if test "$HAVE_GCONF" = yes; then AC_DEFINE(HAVE_GCONF, 1, [Define to 1 if using GConf.]) commit e8ba01d1a23041d6d2bdb8c8dd7c4e1c929df848 Author: Glenn Morris Date: Sat Jul 22 18:36:22 2017 -0700 * configure.ac (MODULES_SUFFIX): Always give it a value. This prevents a Makefile thinko like "rm *${MODULE_SUFFIX}". diff --git a/configure.ac b/configure.ac index 056c8c35c5..b127563c9d 100644 --- a/configure.ac +++ b/configure.ac @@ -3557,27 +3557,22 @@ AC_SUBST(LIBZ) LIBMODULES= HAVE_MODULES=no MODULES_OBJ= -MODULES_SUFFIX= +case $opsys in + cygwin|mingw32) MODULES_SUFFIX=".dll" ;; + *) MODULES_SUFFIX=".so" ;; +esac if test "${with_modules}" != "no"; then case $opsys in gnu|gnu-linux) LIBMODULES="-ldl" - MODULES_SUFFIX=".so" - HAVE_MODULES=yes - ;; - cygwin|mingw32) - MODULES_SUFFIX=".dll" HAVE_MODULES=yes ;; - darwin) - MODULES_SUFFIX=".so" + cygwin|mingw32|darwin) HAVE_MODULES=yes ;; *) # BSD systems have dlopen in libc. - AC_CHECK_FUNC([dlopen], - [MODULES_SUFFIX=".so" - HAVE_MODULES=yes]) + AC_CHECK_FUNC([dlopen], [HAVE_MODULES=yes]) ;; esac commit 195a161bbcf4322cb6edc424e9c6835d3ac330b9 Author: Glenn Morris Date: Sat Jul 22 18:28:46 2017 -0700 * doc/emacs/frames.texi (Fonts): Mention Gsettings. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index e3e59ad43a..ee33a6848c 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -575,7 +575,8 @@ font names in X resource files. If you are running Emacs on the GNOME desktop, you can tell Emacs to use the default system font by setting the variable @code{font-use-system-font} to @code{t} (the default is @code{nil}). -For this to work, Emacs must have been compiled with Gconf support. +For this to work, Emacs must have been compiled with support for +Gsettings (or the older Gconf). @item Use the command line option @samp{-fn} (or @samp{--font}). @xref{Font commit 640fc129fdf75c86c43ce15b0215d224e240052f Author: Michael Albinus Date: Sat Jul 22 20:24:24 2017 +0200 Add line numbers display to the Options menu * lisp/menu-bar.el (toggle-display-line-numbers): Remove. (menu-bar-display-line-numbers-mode): New defun. (menu-bar-showhide-line-numbers-menu): New defvar. (menu-bar-showhide-menu): Use `menu-bar-showhide-line-numbers-menu' diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 3ca7d1b5b3..05a336bfe2 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -1101,23 +1101,68 @@ The selected font will be the default on both the existing and future frames." :button (:radio . (eq tool-bar-mode nil)))) menu))) -(defun toggle-display-line-numbers () - (interactive) - (if display-line-numbers - (setq display-line-numbers nil) - (setq display-line-numbers t)) - (force-mode-line-update)) +(defun menu-bar-display-line-numbers-mode (type) + (setq display-line-numbers-type type) + (if global-display-line-numbers-mode + (global-display-line-numbers-mode) + (display-line-numbers-mode))) + +(defvar menu-bar-showhide-line-numbers-menu + (let ((menu (make-sparse-keymap "Line Numbers"))) + + (bindings--define-key menu [visual] + `(menu-item "Visual Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode 'visual) + (message "Visual line numbers enabled")) + :help "Enable visual line numbers" + :button (:radio . (eq display-line-numbers 'visual)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [relative] + `(menu-item "Relative Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode 'relative) + (message "Relative line numbers enabled")) + :help "Enable relative line numbers" + :button (:radio . (eq display-line-numbers 'relative)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [absolute] + `(menu-item "Absolute Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode t) + (setq display-line-numbers t) + (message "Absolute line numbers enabled")) + :help "Enable absolute line numbers" + :button (:radio . (eq display-line-numbers t)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [none] + `(menu-item "No Line Numbers" + ,(lambda () + (interactive) + (menu-bar-display-line-numbers-mode nil) + (message "Line numbers disabled")) + :help "Disable line numbers" + :button (:radio . (null display-line-numbers)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (bindings--define-key menu [global] + (menu-bar-make-mm-toggle global-display-line-numbers-mode + "Global Line Numbers Mode" + "Set line numbers globally")) + menu)) (defvar menu-bar-showhide-menu (let ((menu (make-sparse-keymap "Show/Hide"))) (bindings--define-key menu [display-line-numbers] `(menu-item "Line Numbers for All Lines" - ,(lambda () - (interactive) - (toggle-display-line-numbers)) - :help "Show the line number alongside each line" - :button (:toggle . display-line-numbers))) + ,menu-bar-showhide-line-numbers-menu)) (bindings--define-key menu [column-number-mode] (menu-bar-make-mm-toggle column-number-mode commit c7df97f8fadeae528f4667aec3e9d4b4fab55004 Author: Eli Zaretskii Date: Sat Jul 22 18:51:18 2017 +0300 ; * CONTRIBUTE: Rearrange sections into a more logical order. diff --git a/CONTRIBUTE b/CONTRIBUTE index 3ed587c691..365e423249 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -26,6 +26,7 @@ admin/notes/git-workflow. ** Getting involved with development +Discussion about Emacs development takes place on emacs-devel@gnu.org. You can subscribe to the emacs-devel@gnu.org mailing list, paying attention to postings with subject lines containing "emacs-announce", as these discuss important events like feature freezes. See @@ -35,11 +36,85 @@ own copy of the repository, and discuss proposed changes on the mailing list. Frequent contributors to Emacs can request write access there. -** Committing changes by others +Bug reports and fixes, feature requests and patches/implementations +should be sent to bug-gnu-emacs@gnu.org, the bug/feature list. This +is coupled to the http://debbugs.gnu.org tracker. It is best to use +the command 'M-x report-emacs-bug RET' to report issues to the tracker +(described below). Be prepared to receive comments and requests for +changes in your patches, following your submission. -If committing changes written by someone else, commit in their name, -not yours. You can use 'git commit --author="AUTHOR"' to specify a -change's author. +The Savannah info page http://savannah.gnu.org/mail/?group=emacs +describes how to subscribe to the mailing lists, or see the list +archives. + +To email a patch you can use a shell command like 'git format-patch -1' +to create a file, and then attach the file to your email. This nicely +packages the patch's commit message and changes. To send just one +such patch without additional remarks, you can use a command like +'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'. + +** Issue tracker (a.k.a. "bug tracker") + +The Emacs issue tracker at http://debbugs.gnu.org lets you view bug +reports and search the database for bugs matching several criteria. +Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned +above, are recorded by the tracker with the corresponding bugs/issues. + +GNU ELPA has a 'debbugs' package that allows accessing the tracker +database from Emacs. + +Bugs needs regular attention. A large backlog of bugs is +disheartening to the developers, and a culture of ignoring bugs is +harmful to users, who expect software that works. Bugs have to be +regularly looked at and acted upon. Not all bugs are critical, but at +the least, each bug needs to be regularly re-reviewed to make sure it +is still reproducible. + +The process of going through old or new bugs and acting on them is +called bug triage. This process is described in the file +admin/notes/bug-triage. + +** Documenting your changes + +Any change that matters to end-users should have an entry in etc/NEWS. + +Doc-strings should be updated together with the code. + +Think about whether your change requires updating the manuals. If you +know it does not, mark the NEWS entry with "---". If you know +that *all* the necessary documentation updates have been made, mark +the entry with "+++". Otherwise do not mark it. + +If your change requires updating the manuals to document new +functions/commands/variables/faces, then use the proper Texinfo +command to index them; for instance, use @vindex for variables and +@findex for functions/commands. For the full list of predefine indices, see +http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html +or run the shell command 'info "(texinfo)Predefined Indices"'. + +For more specific tips on Emacs's doc style, see +http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html +Use 'checkdoc' to check for documentation errors before submitting a patch. + +** Testing your changes + +Please test your changes before committing them or sending them to the +list. If possible, add a new test along with any bug fix or new +functionality you commit (of course, some changes cannot be easily +tested). + +Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See +http://www.gnu.org/software/emacs/manual/html_node/ert/ +or run 'info "(ert)"' for for more information on writing and running +tests. + +If your test lasts longer than some few seconds, mark it in its +'ert-deftest' definition with ":tags '(:expensive-test)". + +To run tests on the entire Emacs tree, run "make check" from the +top-level directory. Most tests are in the directory "test/". From +the "test/" directory, run "make " to run the tests for +.el(c). See "test/README" for more information. ** Commit messages @@ -176,6 +251,12 @@ them right the first time, so here are guidelines for formatting them: with Emacs commands like 'C-x 4 a', and commit the change using the shell command 'vc-dwim --commit'. Type 'vc-dwim --help' for more. +** Committing changes by others + +If committing changes written by someone else, commit in their name, +not yours. You can use 'git commit --author="AUTHOR"' to specify a +change's author. + ** Branches Future development normally takes place on the master branch. @@ -218,87 +299,6 @@ This repository does not contain the Emacs Lisp package archive (elpa.gnu.org). See admin/notes/elpa for how to access the GNU ELPA repository. -** Emacs Mailing lists. - -Discussion about Emacs development takes place on emacs-devel@gnu.org. - -Bug reports and fixes, feature requests and implementations should be -sent to bug-gnu-emacs@gnu.org, the bug/feature list. This is coupled -to the http://debbugs.gnu.org tracker. - -The Savannah info page http://savannah.gnu.org/mail/?group=emacs -describes how to subscribe to the mailing lists, or see the list -archives. - -To email a patch you can use a shell command like 'git format-patch -1' -to create a file, and then attach the file to your email. This nicely -packages the patch's commit message and changes. To send just one -such patch without additional remarks, you can use a command like -'git send-email --to=bug-gnu-emacs@gnu.org 0001-DESCRIPTION.patch'. - -** Issue tracker (a.k.a. "bug tracker") - -The Emacs issue tracker at http://debbugs.gnu.org lets you view bug -reports and search the database for bugs matching several criteria. -Messages posted to the bug-gnu-emacs@gnu.org mailing list, mentioned -above, are recorded by the tracker with the corresponding bugs/issues. - -GNU ELPA has a 'debbugs' package that allows accessing the tracker -database from Emacs. - -Bugs needs regular attention. A large backlog of bugs is -disheartening to the developers, and a culture of ignoring bugs is -harmful to users, who expect software that works. Bugs have to be -regularly looked at and acted upon. Not all bugs are critical, but at -the least, each bug needs to be regularly re-reviewed to make sure it -is still reproducible. - -The process of going through old or new bugs and acting on them is -called bug triage. This process is described in the file -admin/notes/bug-triage. - -** Documenting your changes - -Any change that matters to end-users should have an entry in etc/NEWS. - -Doc-strings should be updated together with the code. - -Think about whether your change requires updating the manuals. If you -know it does not, mark the NEWS entry with "---". If you know -that *all* the necessary documentation updates have been made, mark -the entry with "+++". Otherwise do not mark it. - -If your change requires updating the manuals to document new -functions/commands/variables/faces, then use the proper Texinfo -command to index them; for instance, use @vindex for variables and -@findex for functions/commands. For the full list of predefine indices, see -http://www.gnu.org/software/texinfo/manual/texinfo/html_node/Predefined-Indices.html -or run the shell command 'info "(texinfo)Predefined Indices"'. - -For more specific tips on Emacs's doc style, see -http://www.gnu.org/software/emacs/manual/html_node/elisp/Documentation-Tips.html -Use 'checkdoc' to check for documentation errors before submitting a patch. - -** Testing your changes - -Please test your changes before committing them or sending them to the -list. If possible, add a new test along with any bug fix or new -functionality you commit (of course, some changes cannot be easily -tested). - -Emacs uses ERT, Emacs Lisp Regression Testing, for testing. See -http://www.gnu.org/software/emacs/manual/html_node/ert/ -or run 'info "(ert)"' for for more information on writing and running -tests. - -If your test lasts longer than some few seconds, mark it in its -'ert-deftest' definition with ":tags '(:expensive-test)". - -To run tests on the entire Emacs tree, run "make check" from the -top-level directory. Most tests are in the directory "test/". From -the "test/" directory, run "make " to run the tests for -.el(c). See "test/README" for more information. - ** Understanding Emacs internals The best way to understand Emacs internals is to read the code. Some commit 8b18911a5c7c6c8a15b3cff12a4376ba68205e1c Author: Noam Postavsky Date: Wed Jun 7 19:59:09 2017 -0400 Signal error for symbol names with strange quotes (Bug#2967) * src/lread.c (read1): Signal an error when a symbol starts with a non-escaped quote-like character. * test/src/lread-tests.el (lread-tests--funny-quote-symbols): New test. * etc/NEWS: Announce change. diff --git a/etc/NEWS b/etc/NEWS index 50945f0cfa..4324d87991 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1154,6 +1154,10 @@ instead of its first. renamed to 'lread--old-style-backquotes'. No user code should use this variable. +** To avoid confusion caused by "smart quotes", the reader no longer +accepts Lisp symbols which begin with the following quotation +characters: ‘’‛“”‟〞＂＇, unless they are escaped with backslash. + +++ ** Module functions are now implemented slightly differently; in particular, the function 'internal--module-call' has been removed. diff --git a/src/lread.c b/src/lread.c index 901e40b348..dbaadce4b4 100644 --- a/src/lread.c +++ b/src/lread.c @@ -3479,6 +3479,24 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (! NILP (result)) return unbind_to (count, result); } + if (!quoted && multibyte) + { + int ch = STRING_CHAR ((unsigned char *) read_buffer); + switch (ch) + { + case 0x2018: /* LEFT SINGLE QUOTATION MARK */ + case 0x2019: /* RIGHT SINGLE QUOTATION MARK */ + case 0x201B: /* SINGLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x201C: /* LEFT DOUBLE QUOTATION MARK */ + case 0x201D: /* RIGHT DOUBLE QUOTATION MARK */ + case 0x201F: /* DOUBLE HIGH-REVERSED-9 QUOTATION MARK */ + case 0x301E: /* DOUBLE PRIME QUOTATION MARK */ + case 0xFF02: /* FULLWIDTH QUOTATION MARK */ + case 0xFF07: /* FULLWIDTH APOSTROPHE */ + xsignal2 (Qinvalid_read_syntax, build_string ("strange quote"), + CALLN (Fstring, make_number (ch))); + } + } { Lisp_Object result; ptrdiff_t nbytes = p - read_buffer; diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index a0a317feee..dd5a2003b4 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -142,6 +142,23 @@ literals (Bug#20852)." "unescaped character literals " "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) +(ert-deftest lread-tests--funny-quote-symbols () + "Check that 'smart quotes' or similar trigger errors in symbol names." + (dolist (quote-char + '(#x2018 ;; LEFT SINGLE QUOTATION MARK + #x2019 ;; RIGHT SINGLE QUOTATION MARK + #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK + #x201C ;; LEFT DOUBLE QUOTATION MARK + #x201D ;; RIGHT DOUBLE QUOTATION MARK + #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK + #x301E ;; DOUBLE PRIME QUOTATION MARK + #xFF02 ;; FULLWIDTH QUOTATION MARK + #xFF07 ;; FULLWIDTH APOSTROPHE + )) + (let ((str (format "%cfoo" quote-char))) + (should-error (read str) :type 'invalid-read-syntax) + (should (eq (read (concat "\\" str)) (intern str)))))) + (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." (let ((load-path (cons commit 37954f39168e0dbfe3a82feb9b58fecfc5f1f318 Author: Noam Postavsky Date: Sat Jul 22 08:07:37 2017 -0400 Revert "Let delete-selection-mode work with popup-menu commands (Bug#27569)" It turns out that this change is not needed, and it leaves several command loops settings not done. https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00757.html https://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00840.html diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 4a56978329..3ca7d1b5b3 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2375,10 +2375,6 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." ;; `setup-specified-language-environment', for instance, ;; expects this to be set from a menu keymap. (setq last-command-event (car (last event))) - ;; Update `this-command' and run `pre-command-hook' so that - ;; things like `delete-selection-pre-hook' will work correctly. - (setq this-command cmd) - (run-hooks 'pre-command-hook) ;; mouse-major-mode-menu was using `command-execute' instead. (call-interactively cmd)))) commit ebb78a7bfa3e6a87cfb53f1f2b17fc2f61add595 Author: Alexander Gramiak Date: Sat Jul 22 12:16:08 2017 +0300 Add a minor mode interface for display-line-numbers * lisp/cus-start.el: Use the new display-line-numbers group. * lisp/display-line-numbers.el: New file. * doc/emacs/custom.texi (Init Rebinding): Re-add entry that used to belong to linum-mode. * doc/emacs/modes.texi (Minor Modes): Summarize the mode. * etc/NEWS: Document display-line-numbers-mode and its customization variables, and mention that display-line-numbers-width is buffer-local. * src/xdisp.c (syms_of_xdisp) : Fix a typo. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index a756a89e3f..1c9c14a962 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1701,6 +1701,7 @@ and mouse events: (global-set-key (kbd "C-c y") 'clipboard-yank) (global-set-key (kbd "C-M-q") 'query-replace) (global-set-key (kbd "") 'flyspell-mode) +(global-set-key (kbd "C-") 'display-line-numbers-mode) (global-set-key (kbd "C-") 'forward-sentence) (global-set-key (kbd "") 'mouse-save-then-kill) @end example diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi index eb0c88b290..876431aa9e 100644 --- a/doc/emacs/modes.texi +++ b/doc/emacs/modes.texi @@ -225,6 +225,13 @@ Font-Lock mode automatically highlights certain textual units found in programs. It is enabled globally by default, but you can disable it in individual buffers. @xref{Faces}. +@findex display-line-numbers-mode +@cindex display-line-numbers-mode +@item +Display Line Numbers mode is a convenience wrapper around +@code{display-line-numbers}, setting it using the value of +@code{display-line-numbers-type}. @xref{Display Custom}. + @item Outline minor mode provides similar facilities to the major mode called Outline mode. @xref{Outline Mode}. diff --git a/etc/NEWS b/etc/NEWS index 04971544d3..50945f0cfa 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -438,13 +438,18 @@ range of indentation. This is similar to what linum-mode provides, but much faster and doesn't usurp the display margin for the line numbers. Customize the buffer-local variable 'display-line-numbers' to activate this optional -display. If set to t, Emacs will display the number of each line -before the line. If set to 'relative', Emacs will display the line -number relative to the line showing point, with that line's number -displayed as absolute. If set to 'visual', Emacs will display a -relative number for every screen line, i.e. it will count screen lines -rather than buffer lines. The default is nil, which doesn't display -the line numbers. +display. Alternatively, you can use the `display-line-numbers-mode' +minor mode or the global `global-display-line-numbers-mode'. When +using these modes, customize `display-line-numbers-type' with the same +value as you would use with `display-line-numbers'. + +If `display-line-numbers' is set to t, Emacs will display the number +of each line before the line. If set to 'relative', Emacs will +display the line number relative to the line showing point, with that +line's number displayed as absolute. If set to 'visual', Emacs will +display a relative number for every screen line, i.e. it will count +screen lines rather than buffer lines. The default is nil, which +doesn't display the line numbers. In 'relative' and 'visual' modes, the variable 'display-line-numbers-current-absolute' controls what number is @@ -462,14 +467,23 @@ new face 'line-number-current-line' can be customized to display the current line's number differently from all the other line numbers; by default these two faces are identical. -You can also customize the new variable 'display-line-numbers-width' to -specify a fixed minimal with of the area allocated to line-number -display. The default is nil, meaning that Emacs will dynamically -calculate the area width, enlarging or shrinking it as needed. -Setting it to a non-negative integer specifies that as the minimal -width; selecting a value that is large enough to display all line -numbers in a buffer will then keep the line-number display area of -constant width at all times, if that is desired. +You can also customize the new buffer-local variable +'display-line-numbers-width' to specify a fixed minimal with of the +area allocated to line-number display. The default is nil, meaning +that Emacs will dynamically calculate the area width, enlarging or +shrinking it as needed. Setting it to a non-negative integer +specifies that as the minimal width; selecting a value that is large +enough to display all line numbers in a buffer will then keep the +line-number display area of constant width at all times, if that is +desired. + +When using `display-line-numbers-mode', you can customize the variable +`display-line-numbers-grow-only' to a non-nil value; this means that +Emacs may grow the above area width dynamically, but never shrink it. +Under this mode, customizing the variable +`display-line-numbers-width-start' to a non-nil value will cause Emacs +to set `display-line-numbers-width' to the minimum width necessary to +display all line numbers in the current buffer when first visiting it. Lisp programs can disable line-number display for a particular screen line by putting the 'display-line-numbers-disable' text property or diff --git a/lisp/cus-start.el b/lisp/cus-start.el index ed913e3268..c28b8a147f 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -584,7 +584,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Grow only" :value grow-only)) "25.1") (display-raw-bytes-as-hex display boolean "26.1") - (display-line-numbers display + (display-line-numbers display-line-numbers (choice (const :tag "Off (nil)" :value nil) (const :tag "Absolute line numbers" @@ -594,7 +594,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Visually relative line numbers" :value visual)) "26.1") - (display-line-numbers-width display + (display-line-numbers-width display-line-numbers (choice (const :tag "Dynamically computed" :value nil) @@ -602,14 +602,14 @@ since it could result in memory overflow and make Emacs crash." :value 2 :format "%v")) "26.1") - (display-line-numbers-current-absolute display + (display-line-numbers-current-absolute display-line-numbers (choice (const :tag "Display actual number of current line" :value t) (const :tag "Display zero as number of current line" :value nil)) "26.1") - (display-line-numbers-widen display + (display-line-numbers-widen display-line-numbers (choice (const :tag "Disregard narrowing when calculating line numbers" :value t) diff --git a/lisp/display-line-numbers.el b/lisp/display-line-numbers.el new file mode 100644 index 0000000000..95237250f9 --- /dev/null +++ b/lisp/display-line-numbers.el @@ -0,0 +1,103 @@ +;;; display-line-numbers.el --- interface for display-line-numbers -*- lexical-binding: t -*- + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org +;; Keywords: convenience + +;; 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: + +;; Provides a minor mode interface for `display-line-numbers'. +;; +;; Toggle display of line numbers with M-x display-line-numbers-mode. +;; To enable line numbering in all buffers, use M-x +;; global-display-line-numbers-mode. To change the default type of +;; line numbers displayed, customize display-line-numbers-type. + +;; NOTE: Customization variables for `display-line-numbers' itself are +;; defined in cus-start.el. + +;;; Code: + +(defgroup display-line-numbers nil + "Display line numbers in the buffer." + :group 'display) + +(defcustom display-line-numbers-type t + "The default type of line numbers to use in `display-line-numbers-mode'. +See `display-line-numbers' for value options." + :group 'display-line-numbers + :type '(choice (const :tag "Relative line numbers" relative) + (const :tag "Relative visual line numbers" visual) + (other :tag "Absolute line numbers" t)) + :version "26.1") + +(defcustom display-line-numbers-grow-only nil + "If non-nil, do not shrink line number width." + :group 'display-line-numbers + :type 'boolean + :version "26.1") + +(defcustom display-line-numbers-width-start nil + "If non-nil, count number of lines to use for line number width. +When `display-line-numbers-mode' is turned on, +`display-line-numbers-width' is set to the minimum width necessary +to display all line numbers in the buffer." + :group 'display-line-numbers + :type 'boolean + :version "26.1") + +(defun display-line-numbers-update-width () + "Prevent the line number width from shrinking." + (let ((width (line-number-display-width))) + (when (> width (or display-line-numbers-width 1)) + (setq display-line-numbers-width width)))) + +;;;###autoload +(define-minor-mode display-line-numbers-mode + "Toggle display of line numbers in the buffer. +This uses `display-line-numbers' internally. + +To change the type of line numbers displayed by default, +customize `display-line-numbers-type'. To change the type while +the mode is on, set `display-line-numbers' directly." + :lighter nil + (if display-line-numbers-mode + (progn + (when display-line-numbers-width-start + (setq display-line-numbers-width + (length (number-to-string + (count-lines (point-min) (point-max)))))) + (when display-line-numbers-grow-only + (add-hook 'pre-command-hook #'display-line-numbers-update-width nil t)) + (setq display-line-numbers display-line-numbers-type)) + (remove-hook 'pre-command-hook #'display-line-numbers-update-width t) + (setq display-line-numbers nil))) + +;;;###autoload +(define-globalized-minor-mode global-display-line-numbers-mode + display-line-numbers-mode + (lambda () + (unless (or (minibufferp) + ;; taken from linum.el + (and (daemonp) (null (frame-parameter nil 'client)))) + (display-line-numbers-mode)))) + +(provide 'display-line-numbers) + +;;; display-line-numbers.el ends here diff --git a/src/xdisp.c b/src/xdisp.c index 3e5657ffe6..422912e57a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32745,7 +32745,7 @@ even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); Vdisplay_line_numbers_width = Qnil; - DEFSYM (Qdisplay_line_numbers_width, "display-line-number-width"); + DEFSYM (Qdisplay_line_numbers_width, "display-line-numbers-width"); Fmake_variable_buffer_local (Qdisplay_line_numbers_width); DEFVAR_LISP ("display-line-numbers-current-absolute", commit 6d7e34b692edd61ac2f0872db521bcec321453cf Author: vividsnow Date: Sat Jul 22 12:07:55 2017 +0300 Support indented HERE-DOCs in cperl-mode * lisp/progmodes/cperl-mode.el (cperl-find-pods-heres): Support indented here-docs. (Bug#27254) (Bug#27697) Copyright-paperwork-exempt: yes diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index c0f1aaf39d..c69eca2241 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -3734,7 +3734,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', "\\(\\`\n?\\|^\n\\)=" ; POD "\\|" ;; One extra () before this: - "<<" ; HERE-DOC + "<<~?" ; HERE-DOC "\\(" ; 1 + 1 ;; First variant "BLAH" or just ``. "[ \t]*" ; Yes, whitespace is allowed! @@ -4000,7 +4000,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', (setq b (point)) ;; We do not search to max, since we may be called from ;; some hook of fontification, and max is random - (or (and (re-search-forward (concat "^" qtag "$") + (or (and (re-search-forward (concat "^[ \t]*" qtag "$") stop-point 'toend) ;;;(eq (following-char) ?\n) ; XXXX WHY??? ) commit 47932ca9262f4f6fc29d95a4d08ad84608714e0e Author: Eli Zaretskii Date: Sat Jul 22 12:02:16 2017 +0300 Document the support for "scrollBar" X resource * doc/emacs/xresources.texi (Table of Resources): Document the new 'scrollBar' setting. * etc/NEWS: Document the new 'scrollBar' setting. diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 7e27ddd1d9..eaefcee21c 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -250,6 +250,11 @@ specified if @samp{off}. Gamma correction for colors, equivalent to the frame parameter @code{screen-gamma}. +@item @code{scrollBar} (class @code{ScrollBar}) +@cindex tool bar +If the value of this resource is @samp{off} or @samp{false} or +@samp{0}, Emacs disables Scroll Bar mode at startup (@pxref{Scroll Bars}). + @item @code{scrollBarWidth} (class @code{ScrollBarWidth}) @cindex scrollbar width The scroll bar width in pixels, equivalent to the frame parameter diff --git a/etc/NEWS b/etc/NEWS index 460b40d266..04971544d3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -97,6 +97,10 @@ Terminal is automatically initialized to use 24-bit colors if the required capabilities are found in terminfo. See the FAQ node "Colors on a TTY" for more information. ++++ +** Emacs now obeys the X resource "scrollBar" at startup. +The effect is similar to that of "toolBar" resource on the tool bar. + * Changes in Emacs 26.1 commit 9c9e8bd660a5beb0d8dd3e85e1183babbf184cd1 Author: Matthew Bauer Date: Sat Jul 22 11:53:58 2017 +0300 Add 'scroll-bar-mode' to settings in 'x-apply-session-resources' * lisp/startup.el (x-apply-session-resources): Add scroll-bar-mode settings. Copyright-paperwork-exempt: yes diff --git a/lisp/startup.el b/lisp/startup.el index bc60bbd08b..0fbba1bea2 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1432,6 +1432,7 @@ settings will be marked as \"CHANGED outside of Customize\"." (let ((no-vals '("no" "off" "false" "0")) (settings '(("menuBar" "MenuBar" menu-bar-mode nil) ("toolBar" "ToolBar" tool-bar-mode nil) + ("scrollBar" "ScrollBar" scroll-bar-mode nil) ("cursorBlink" "CursorBlink" no-blinking-cursor t)))) (dolist (x settings) (if (member (x-get-resource (nth 0 x) (nth 1 x)) no-vals) commit 813b3e49d157c09f8cb07c5f17927b531863dff0 Author: Alexander Kuleshov Date: Sat Jul 22 11:47:33 2017 +0300 Update ld-script mode (bug#27629) * lisp/progmodes/ld-script.el: (ld-script-keywords): New commands NOCROSSREFS_TO and HIDDEN added. Fix documentation sections numbers for PROVIDE/PROVIDE_HIDDEN commands. (ld-script-builtins): New builtin function LOG2CEIL added. diff --git a/lisp/progmodes/ld-script.el b/lisp/progmodes/ld-script.el index 389ddfca6b..7a666e9529 100644 --- a/lisp/progmodes/ld-script.el +++ b/lisp/progmodes/ld-script.el @@ -85,10 +85,12 @@ ;; 3.4.5 Other Linker Script Commands "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "INHIBIT_COMMON_ALLOCATION" "INSERT" "AFTER" "BEFORE" - "NOCROSSREFS" "OUTPUT_ARCH" "LD_FEATURE" - ;; 3.5.2 PROVIDE + "NOCROSSREFS" "NOCROSSREFS_TO" "OUTPUT_ARCH" "LD_FEATURE" + ;; 3.5.2 HIDDEN + "HIDDEN" + ;; 3.5.3 PROVIDE "PROVIDE" - ;; 3.5.3 PROVIDE_HIDDEN + ;; 3.5.4 PROVIDE_HIDDEN "PROVIDE_HIDDEN" ;; 3.6 SECTIONS Command "SECTIONS" @@ -142,6 +144,7 @@ "DEFINED" "LENGTH" "len" "l" "LOADADDR" + "LOG2CEIL" "MAX" "MIN" "NEXT" commit 35838ed5221a55e8b2465aa8e535bf956b42d6eb Author: Eli Zaretskii Date: Sat Jul 22 11:41:09 2017 +0300 Index 'rectangle' in the ELisp manual * doc/lispref/text.texi (Registers): Index the "rectangle" value. (Bug#27541) diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 7108520e79..b825b1d790 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4236,6 +4236,7 @@ A marker represents a buffer position to jump to. A string is text saved in the register. @item a rectangle +@cindex rectangle, as contents of a register A rectangle is represented by a list of strings. @item @code{(@var{window-configuration} @var{position})} commit 6ec43f8ddb54f96d4721c642396a4a9148719915 Author: Eli Zaretskii Date: Sat Jul 22 11:34:55 2017 +0300 * lisp/subr.el (add-to-history): Doc fix. (Bug#27494) diff --git a/lisp/subr.el b/lisp/subr.el index d9d918ed12..79a28d301e 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1789,7 +1789,8 @@ Return the new history list. If MAXELT is non-nil, it specifies the maximum length of the history. Otherwise, the maximum history length is the value of the `history-length' property on symbol HISTORY-VAR, if set, or the value of the `history-length' -variable. +variable. The possible values of maximum length have the same meaning as +the values of `history-length'. Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even if it is empty or a duplicate." commit 45c2544c347bbc239d04c9a276ee1988ebbc1a7c Author: Eli Zaretskii Date: Sat Jul 22 11:24:05 2017 +0300 Doc fixes for kmacro.el functions * lisp/kmacro.el (kmacro-start-macro, kmacro-call-macro) (kmacro-end-and-call-macro): Don't use "permanent name", as that could be misinterpreted. (Bug#27492) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 838a492b6c..472972e3ed 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -565,7 +565,8 @@ Use \\[kmacro-insert-counter] to insert (and increment) the macro counter. The counter value can be set or modified via \\[kmacro-set-counter] and \\[kmacro-add-counter]. The format of the counter can be modified via \\[kmacro-set-format]. -Use \\[kmacro-name-last-macro] to give it a permanent name. +Use \\[kmacro-name-last-macro] to give it a name that will remain valid even +after another macro is defined. Use \\[kmacro-bind-to-key] to bind it to a key sequence." (interactive "P") (if (or defining-kbd-macro executing-kbd-macro) @@ -628,8 +629,8 @@ just the last key in the key sequence that you used to call this command. See `kmacro-call-repeat-key' and `kmacro-call-repeat-with-arg' for details on how to adjust or disable this behavior. -To make a macro permanent so you can call it even after defining -others, use \\[kmacro-name-last-macro]." +To give a macro a name so you can call it even after defining others, +use \\[kmacro-name-last-macro]." (interactive "p") (let ((repeat-key (and (or (and (null no-repeat) (> (length (this-single-command-keys)) 1)) @@ -730,8 +731,8 @@ With \\[universal-argument], call second macro in macro ring." With numeric prefix ARG, repeat macro that many times. Zero argument means repeat until there is an error. -To give a macro a permanent name, so you can call it -even after defining other macros, use \\[kmacro-name-last-macro]." +To give a macro a name, so you can call it even after defining other +macros, use \\[kmacro-name-last-macro]." (interactive "P") (if defining-kbd-macro (kmacro-end-macro nil)) commit d37a82b4a35bdffa0462ba9954bd432cf7d54659 Author: Charles A. Roelli Date: Sat Jul 22 11:09:36 2017 +0300 ElDoc: add docstrings and minor refactoring * lisp/emacs-lisp/eldoc.el (eldoc-edit-message-commands): Add docstring. (turn-on-eldoc-mode): Fix capitalization. (eldoc--supported-p): Add docstring. (eldoc-schedule-timer): Add docstring and use 'eldoc--supported-p'. (eldoc-message): Add docstring and make calling convention clearer. (eldoc--message-command-p): (eldoc-pre-command-refresh-echo-area): (eldoc-display-message-p): (eldoc-display-message-no-interference-p): (eldoc-print-current-symbol-info): (eldoc-docstring-format-sym-doc): (eldoc-add-command, eldoc-add-command-completions): (eldoc-remove-command, eldoc-remove-command-completions): Add docstring. (Bug#27230) diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el index a05bd7cc4d..bca40ab87d 100644 --- a/lisp/emacs-lisp/eldoc.el +++ b/lisp/emacs-lisp/eldoc.el @@ -160,6 +160,10 @@ This is used to determine if `eldoc-idle-delay' is changed by the user.") It should receive the same arguments as `message'.") (defun eldoc-edit-message-commands () + "Return an obarray containing common editing commands. + +When `eldoc-print-after-edit' is non-nil, ElDoc messages are only +printed after commands contained in this obarray." (let ((cmds (make-vector 31 0)) (re (regexp-opt '("delete" "insert" "edit" "electric" "newline")))) (mapatoms (lambda (s) @@ -211,16 +215,21 @@ expression point is on." ;;;###autoload (defun turn-on-eldoc-mode () - "Turn on `eldoc-mode' if the buffer has eldoc support enabled. + "Turn on `eldoc-mode' if the buffer has ElDoc support enabled. See `eldoc-documentation-function' for more detail." (when (eldoc--supported-p) (eldoc-mode 1))) (defun eldoc--supported-p () + "Non-nil if an ElDoc function is set for this buffer." (not (memq eldoc-documentation-function '(nil ignore)))) (defun eldoc-schedule-timer () + "Ensure `eldoc-timer' is running. + +If the user has changed `eldoc-idle-delay', update the timer to +reflect the change." (or (and eldoc-timer (memq eldoc-timer timer-idle-list)) ;FIXME: Why? (setq eldoc-timer @@ -229,8 +238,7 @@ See `eldoc-documentation-function' for more detail." (lambda () (when (or eldoc-mode (and global-eldoc-mode - (not (memq eldoc-documentation-function - '(nil ignore))))) + (eldoc--supported-p))) (eldoc-print-current-symbol-info)))))) ;; If user has changed the idle delay, update the timer. @@ -268,16 +276,19 @@ Otherwise work like `message'." (force-mode-line-update))) (apply 'message format-string args))) -(defun eldoc-message (&rest args) +(defun eldoc-message (&optional format-string &rest args) + "Display FORMAT-STRING formatted with ARGS as an ElDoc message. + +Store the message (if any) in `eldoc-last-message', and return it." (let ((omessage eldoc-last-message)) (setq eldoc-last-message - (cond ((eq (car args) eldoc-last-message) eldoc-last-message) - ((null (car args)) nil) + (cond ((eq format-string eldoc-last-message) eldoc-last-message) + ((null format-string) nil) ;; If only one arg, no formatting to do, so put it in ;; eldoc-last-message so eq test above might succeed on ;; subsequent calls. - ((null (cdr args)) (car args)) - (t (apply #'format-message args)))) + ((null args) format-string) + (t (apply #'format-message format-string args)))) ;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages ;; are recorded in a log. Do not put eldoc messages in that log since ;; they are Legion. @@ -289,6 +300,7 @@ Otherwise work like `message'." eldoc-last-message) (defun eldoc--message-command-p (command) + "Return non-nil if COMMAND is in `eldoc-message-commands'." (and (symbolp command) (intern-soft (symbol-name command) eldoc-message-commands))) @@ -299,6 +311,7 @@ Otherwise work like `message'." ;; before the next command executes, which does away with the flicker. ;; This doesn't seem to be required for Emacs 19.28 and earlier. (defun eldoc-pre-command-refresh-echo-area () + "Reprint `eldoc-last-message' in the echo area." (and eldoc-last-message (not (minibufferp)) ;We don't use the echo area when in minibuffer. (if (and (eldoc-display-message-no-interference-p) @@ -310,6 +323,7 @@ Otherwise work like `message'." ;; Decide whether now is a good time to display a message. (defun eldoc-display-message-p () + "Return non-nil when it is appropriate to display an ElDoc message." (and (eldoc-display-message-no-interference-p) ;; If this-command is non-nil while running via an idle ;; timer, we're still in the middle of executing a command, @@ -322,6 +336,7 @@ Otherwise work like `message'." ;; Check various conditions about the current environment that might make ;; it undesirable to print eldoc messages right this instant. (defun eldoc-display-message-no-interference-p () + "Return nil if displaying a message would cause interference." (not (or executing-kbd-macro (bound-and-true-p edebug-active)))) @@ -347,6 +362,7 @@ variable) is taken into account if the major mode specific function does not return any documentation.") (defun eldoc-print-current-symbol-info () + "Print the text produced by `eldoc-documentation-function'." ;; This is run from post-command-hook or some idle timer thing, ;; so we need to be careful that errors aren't ignored. (with-demoted-errors "eldoc error: %s" @@ -361,6 +377,13 @@ return any documentation.") ;; truncated or eliminated entirely from the output to make room for the ;; description. (defun eldoc-docstring-format-sym-doc (prefix doc &optional face) + "Combine PREFIX and DOC, and shorten the result to fit in the echo area. + +When PREFIX is a symbol, propertize its symbol name with FACE +before combining it with DOC. If FACE is not provided, just +apply the nil face. + +See also: `eldoc-echo-area-use-multiline-p'." (when (symbolp prefix) (setq prefix (concat (propertize (symbol-name prefix) 'face face) ": "))) (let* ((ea-multi eldoc-echo-area-use-multiline-p) @@ -390,22 +413,26 @@ return any documentation.") ;; These functions do display-command table management. (defun eldoc-add-command (&rest cmds) + "Add each of CMDS to the obarray `eldoc-message-commands'." (dolist (name cmds) (and (symbolp name) (setq name (symbol-name name))) (set (intern name eldoc-message-commands) t))) (defun eldoc-add-command-completions (&rest names) + "Pass every prefix completion of NAMES to `eldoc-add-command'." (dolist (name names) (apply #'eldoc-add-command (all-completions name obarray 'commandp)))) (defun eldoc-remove-command (&rest cmds) + "Remove each of CMDS from the obarray `eldoc-message-commands'." (dolist (name cmds) (and (symbolp name) (setq name (symbol-name name))) (unintern name eldoc-message-commands))) (defun eldoc-remove-command-completions (&rest names) + "Pass every prefix completion of NAMES to `eldoc-remove-command'." (dolist (name names) (apply #'eldoc-remove-command (all-completions name eldoc-message-commands)))) @@ -418,9 +445,9 @@ return any documentation.") "down-list" "end-of-" "exchange-point-and-mark" "forward-" "goto-" "handle-select-window" "indent-for-tab-command" "left-" "mark-page" "mark-paragraph" "mouse-set-point" "move-" "move-beginning-of-" - "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" "previous-" - "recenter" "right-" "scroll-" "self-insert-command" "split-window-" - "up-list") + "move-end-of-" "newline" "next-" "other-window" "pop-global-mark" + "previous-" "recenter" "right-" "scroll-" "self-insert-command" + "split-window-" "up-list") (provide 'eldoc) commit 842ac11c0d3f4fe24a30c35e3ae8d810cf56c549 Author: Fabrice Bauzac Date: Sat Jul 22 10:56:26 2017 +0300 Mention 'C-M-i' as key binding for 'ispell-complete-word' * doc/emacs/fixit.texi (Spelling): ispell-complete-word can also be invoked by C-M-i. (Bug#27349) Copyright-paperwork-exempt: yes diff --git a/doc/emacs/fixit.texi b/doc/emacs/fixit.texi index 2ba3e26c48..f833f572df 100644 --- a/doc/emacs/fixit.texi +++ b/doc/emacs/fixit.texi @@ -254,6 +254,7 @@ Restart the Aspell/Ispell/Hunspell process, using @var{dict} as the dictionary. Kill the Aspell/Ispell/Hunspell subprocess. @item M-@key{TAB} @itemx @key{ESC} @key{TAB} +@itemx C-M-i Complete the word before point based on the spelling dictionary (@code{ispell-complete-word}). @item M-x flyspell-mode commit efa754d2c15485f8da22807e5d06b00b088aca92 Author: Eli Zaretskii Date: Sat Jul 22 10:52:52 2017 +0300 ; * doc/emacs/search.texi (Word Search): Update for changes in bug#27341. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 0950670c83..c9e83da173 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -624,8 +624,9 @@ matching}) has no effect on them. To search the Web for the text in region, type @kbd{M-s M-w}. This command performs an Internet search for the words in region using the search engine whose @acronym{URL} is specified by the variable -@code{eww-search-prefix}. @xref{Basics, EWW, , eww, The Emacs Web -Wowser Manual}. +@code{eww-search-prefix} (@pxref{Basics, EWW, , eww, The Emacs Web +Wowser Manual}). If the region is not active, or doesn't contain any +words, this command prompts the user for a URL or keywords to search. @node Symbol Search commit 353d138517e3418857068e071d0b0b5fced4fca4 Author: Fabrice Bauzac Date: Sat Jul 22 10:43:11 2017 +0300 Fix the eww-search-words description in the Emacs manual * doc/emacs/search.texi (Word Search): Include the key binding for eww-search-words in the manual. Fix the spelling of the 'eww-search-words' command. Copyright-paperwork-exempt: yes diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index 905df025d2..0950670c83 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -582,6 +582,8 @@ word search (@code{isearch-forward-word}). Search for @var{words}, using a forward nonincremental word search. @item M-s w C-r @key{RET} @var{words} @key{RET} Search backward for @var{words}, using a nonincremental word search. +@item M-s M-w +Search the Web for the text in region. @end table @kindex M-s w @@ -617,12 +619,14 @@ toggling lax whitespace matching (@pxref{Lax Search, lax space matching}) has no effect on them. @kindex M-s M-w -@findex eww-search-word +@findex eww-search-words @vindex eww-search-prefix - Search the Web for the text in region. This command performs an -Internet search for the words in region using the search engine whose -@acronym{URL} is specified by the variable @code{eww-search-prefix}. -@xref{Basics, EWW, , eww, The Emacs Web Wowser Manual}. + To search the Web for the text in region, type @kbd{M-s M-w}. This +command performs an Internet search for the words in region using the +search engine whose @acronym{URL} is specified by the variable +@code{eww-search-prefix}. @xref{Basics, EWW, , eww, The Emacs Web +Wowser Manual}. + @node Symbol Search @section Symbol Search commit 2ec8f28c59902ee1b533f9042c08f782422c2d86 Author: Andrew L. Moore Date: Sat Jul 22 10:34:18 2017 +0300 Introduce defcustom 'executable-prefix-env' * lisp/progmodes/executable.el (executable-prefix): Update the doc string. (executable-prefix-env): New defcustom. (executable-set-magic): Use executable-prefix-env. * etc/NEWS: Document the new variable. diff --git a/etc/NEWS b/etc/NEWS index 5c52dc0cca..460b40d266 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -105,6 +105,16 @@ required capabilities are found in terminfo. See the FAQ node This argument, when non-nil, is used for comparison instead of 'equal'. +--- +** New variable 'executable-prefix-env' for inserting magic signatures. +This variable affects the format of the interpreter magic number +inserted by 'executable-set-magic'. If non-nil, the magic number now +takes the form "#!/usr/bin/env interpreter", otherwise the value +determined by 'executable-prefix', which is by default +"#!/path/to/interpreter". By default, 'executable-prefix-env' is nil, +so the default behavior is not changed. + ++++ ** The variable 'emacs-version' no longer includes the build number. This is now stored separately in a new variable, 'emacs-build-number'. diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el index da148bd39a..7c040e7495 100644 --- a/lisp/progmodes/executable.el +++ b/lisp/progmodes/executable.el @@ -83,13 +83,21 @@ When this is `function', only ask when called non-interactively." :type 'regexp :group 'executable) - (defcustom executable-prefix "#!" - "Interpreter magic number prefix inserted when there was no magic number." - :version "24.3" ; "#! " -> "#!" + "Interpreter magic number prefix inserted when there was no magic number. +Use of `executable-prefix-env' is preferable to this option." + :version "26.1" ; deprecated :type 'string :group 'executable) +(defcustom executable-prefix-env nil + "If non-nil, use \"/usr/bin/env\" in interpreter magic number. +If this variable is non-nil, the interpreter magic number inserted +by `executable-set-magic' will be \"#!/usr/bin/env INTERPRETER\", +otherwise it will be \"#!/path/to/INTERPRETER\"." + :version "26.1" + :type 'boolean + :group 'executable) (defcustom executable-chmod 73 "After saving, if the file is not executable, set this mode. @@ -199,7 +207,7 @@ command to find the next error. The buffer is also in `comint-mode' and (defun executable-set-magic (interpreter &optional argument no-query-flag insert-flag) "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT. -The variables `executable-magicless-file-regexp', `executable-prefix', +The variables `executable-magicless-file-regexp', `executable-prefix-env', `executable-insert', `executable-query' and `executable-chmod' control when and how magic numbers are inserted or replaced and scripts made executable." @@ -220,6 +228,14 @@ executable." (and argument (string< "" argument) " ") argument)) + ;; For backward compatibilty, allow `executable-prefix-env' to be + ;; overriden by custom `executable-prefix'. + (if (string-match "#!\\([ \t]*/usr/bin/env[ \t]*\\)?$" executable-prefix) + (if executable-prefix-env + (setq argument (concat "/usr/bin/env " + (file-name-nondirectory argument)))) + (setq argument (concat (substring executable-prefix 2) argument))) + (or buffer-read-only (if buffer-file-name (string-match executable-magicless-file-regexp @@ -241,15 +257,13 @@ executable." ;; Make buffer visible before question. (switch-to-buffer (current-buffer)) (y-or-n-p (format-message - "Replace magic number by `%s%s'? " - executable-prefix argument)))) + "Replace magic number by `#!%s'? " + argument)))) (progn (replace-match argument t t nil 1) - (message "Magic number changed to `%s'" - (concat executable-prefix argument))))) - (insert executable-prefix argument ?\n) - (message "Magic number changed to `%s'" - (concat executable-prefix argument))))) + (message "Magic number changed to `#!%s'" argument)))) + (insert "#!" argument ?\n) + (message "Magic number changed to `#!%s'" argument)))) interpreter) commit 959fcb113a4680175db5274efb1e0e23fdd69cfe Author: Glenn Morris Date: Fri Jul 21 21:22:49 2017 -0400 * test/lisp/ibuffer-tests.el: Delete temporary files. diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index 56b0d36afd..af75aa0ec7 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -150,6 +150,7 @@ ;; Test Filter Inclusion (let* (test-buffer-list ; accumulated buffers to clean up + test-file-list ;; Utility functions without polluting the environment (set-buffer-mode (lambda (buffer mode) @@ -192,6 +193,7 @@ (file (make-temp-file prefix nil suffix)) (buf (find-file-noselect file t))) (push buf test-buffer-list) ; record for cleanup + (push file test-file-list) (funcall set-buffer-mode buf mode) (funcall set-buffer-contents buf size include) buf))) @@ -213,6 +215,8 @@ (clean-up (lambda () "Restore all emacs state modified during the tests" + (dolist (f test-file-list) + (and f (file-exists-p f) (delete-file f))) (while test-buffer-list ; created temporary buffers (let ((buf (pop test-buffer-list))) (with-current-buffer buf (bury-buffer)) ; ensure not selected commit 9742069276b497eb4190dade54dd239e2cf78c17 Author: Glenn Morris Date: Fri Jul 21 14:01:12 2017 -0400 Further attempt to avoid hang in network-stream-tests * test/lisp/net/network-stream-tests.el (connect-to-tls-ipv6-nowait): Limit the time we wait for the external process. diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index e7bb3e8ccf..9ee3a281c3 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -280,8 +280,11 @@ (< (setq times (1+ times)) 10)) (sit-for 0.1)) (should proc) - (while (eq (process-status proc) 'connect) - (sit-for 0.1))) + (setq times 0) + (while (and (eq (process-status proc) 'connect) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (skip-unless (not (eq (process-status proc) 'connect)))) (if (process-live-p server) (delete-process server))) (setq status (gnutls-peer-status proc)) (should (consp status)) commit 237e238cfce65ebbd1fbac2e05b9ce8ecf9ab2c1 Author: Glenn Morris Date: Fri Jul 21 13:49:37 2017 -0400 Stop skipping many ibuffer tests by default * test/lisp/ibuffer-tests.el (ibuffer-0autoload): Rename so it sorts first. (ibuffer-save-filters, ibuffer-filter-inclusion-1) (ibuffer-filter-inclusion-2, ibuffer-filter-inclusion-3) (ibuffer-filter-inclusion-4, ibuffer-filter-inclusion-5) (ibuffer-filter-inclusion-6, ibuffer-filter-inclusion-7) (ibuffer-filter-inclusion-8, ibuffer-decompose-filter) (ibuffer-and-filter, ibuffer-or-filter, ibuffer-format-qualifier) (ibuffer-unary-operand): Require ibuf-ext so tests not skipped. diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el index b9f7fe7cde..56b0d36afd 100644 --- a/test/lisp/ibuffer-tests.el +++ b/test/lisp/ibuffer-tests.el @@ -32,7 +32,7 @@ (declare-function ibuffer-format-qualifier "ibuf-ext" (qualifier)) (declare-function ibuffer-unary-operand "ibuf-ext" (filter)) -(ert-deftest ibuffer-autoload () +(ert-deftest ibuffer-0autoload () ; sort first "Tests to see whether ibuffer has been autoloaded" (skip-unless (not (featurep 'ibuf-ext))) (should @@ -76,7 +76,7 @@ (ert-deftest ibuffer-save-filters () "Tests that `ibuffer-save-filters' saves in the proper format." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (let ((ibuffer-save-with-custom nil) (ibuffer-saved-filters nil) (test1 '((mode . org-mode) @@ -220,7 +220,7 @@ ;; Tests (ert-deftest ibuffer-filter-inclusion-1 () "Tests inclusion using basic filter combinators with a single buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-file-buffer "ibuf-test-1" :size 100 @@ -263,7 +263,7 @@ (ert-deftest ibuffer-filter-inclusion-2 () "Tests inclusion of basic filters in combination on a single buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-file-buffer "ibuf-test-2" :size 200 @@ -298,7 +298,7 @@ (ert-deftest ibuffer-filter-inclusion-3 () "Tests inclusion with filename filters on specified buffers." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let* ((bufA (funcall create-file-buffer "ibuf-test-3.a" :size 50 @@ -332,7 +332,7 @@ (ert-deftest ibuffer-filter-inclusion-4 () "Tests inclusion with various filters on a single buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-file-buffer "ibuf-test-4" @@ -366,7 +366,7 @@ (ert-deftest ibuffer-filter-inclusion-5 () "Tests inclusion with various filters on a single buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-non-file-buffer "ibuf-test-5.el" @@ -392,7 +392,7 @@ (ert-deftest ibuffer-filter-inclusion-6 () "Tests inclusion using saved filters and DeMorgan's laws." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-non-file-buffer "*ibuf-test-6*" :size 65 @@ -425,7 +425,7 @@ (ert-deftest ibuffer-filter-inclusion-7 () "Tests inclusion with various filters on a single buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((buf (funcall create-non-file-buffer "ibuf-test-7" @@ -446,7 +446,7 @@ (ert-deftest ibuffer-filter-inclusion-8 () "Tests inclusion with various filters." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((bufA (funcall create-non-file-buffer "ibuf-test-8a" @@ -534,7 +534,7 @@ ;; Tests (ert-deftest ibuffer-decompose-filter () "Tests `ibuffer-decompose-filter' for and, or, not, and saved." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((ibuf (funcall get-test-ibuffer))) (with-current-buffer ibuf @@ -583,7 +583,7 @@ (ert-deftest ibuffer-and-filter () "Tests `ibuffer-and-filter' in an Ibuffer buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((ibuf (funcall get-test-ibuffer))) (with-current-buffer ibuf @@ -660,7 +660,7 @@ (ert-deftest ibuffer-or-filter () "Tests `ibuffer-or-filter' in an Ibuffer buffer." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (unwind-protect (let ((ibuf (funcall get-test-ibuffer))) (with-current-buffer ibuf @@ -737,7 +737,7 @@ (ert-deftest ibuffer-format-qualifier () "Tests string recommendation of filter from `ibuffer-format-qualifier'." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (let ((test1 '(mode . org-mode)) (test2 '(size-lt . 100)) (test3 '(derived-mode . prog-mode)) @@ -802,7 +802,7 @@ (ert-deftest ibuffer-unary-operand () "Tests `ibuffer-unary-operand': (not cell) or (not . cell) -> cell." - (skip-unless (featurep 'ibuf-ext)) + (require 'ibuf-ext) (should (equal (ibuffer-unary-operand '(not . (mode "foo"))) '(mode "foo"))) (should (equal (ibuffer-unary-operand '(not (mode "foo"))) commit 16001d1a97311f8404325f7b3b3c101caffb1f8a Author: Stefan Monnier Date: Fri Jul 21 18:54:07 2017 +0200 Use lexical-binding in todo-mode.el Adjust code accordingly and make various minor improvements. * lisp/calendar/todo-mode.el: Enable lexical-binding. (dayname, monthname, day, month, year): Make forward defvars of these keywords from macros defined in calendar.el; wrap them in with-no-warnings. (todo-files, todo-files-function, todo-date-pattern) (todo-mode-line-function, todo-show, todo-forward-category) (todo-edit-item--header, todo-set-category-number) (todo-adjusted-category-label-length) (todo-total-item-counts, todo-filter-items) (todo-print-buffer-function, todo-convert-legacy-date-time) (todo-category-number, todo-category-completions) (todo-read-file-name, todo-read-category) (todo-validate-name, todo-read-date) (todo-set-show-current-file, todo-modes-set-1) (todo-modes-set-2, todo-modes-set-3, todo-mode): Use #' instead of ' to quote functions. (todo-files): Use \' instead of $ in regexp. (todo--files-type-list): New function. (todo-default-todo-file, todo-category-completions-files) (todo-filter-files, todo-multiple-filter-files) (todo-reevaluate-default-file-defcustom) (todo-reevaluate-category-completions-files-defcustom) (todo-reevaluate-filter-files-defcustom): Use it. (todo-show, todo-rename-file, todo-move-category) (todo-edit-item--text, todo-edit-quit, todo-edit-item--header) (todo-item-undone, todo-unarchive-items, todo-search) (todo-filter-items, todo-filter-items-1, todo-find-item) (todo-category-select, todo-read-date) (todo-nondiary-marker-matcher, todo-date-string-matcher) (todo-diary-expired-matcher, todo-convert-legacy-files) (todo-read-category): Reformat to avoid code hiding behind a more deeply embedded element. (todo-forward-category, todo-set-category-number): Use 'funcall' instead of 'apply'. (todo-toggle-mark-item, todo-edit-item--diary-inclusion) (todo-edit-category-diary-inclusion) (todo-insert-sort-button, todo-insert-category-line) (todo-multiple-filter-files): Mark unused local variables. (todo-edit-item--header, todo-move-item, todo-print-buffer) (todo-edit-item--header, todo-move-item, todo-check-file) (todo-edit-item--next-key): Remove unused local variables. (todo-insert-sort-button, todo-insert-category-line): Use a closure instead of a backquoted lambda. (todo-update-categories-display, todo-print-buffer): Simplify code. (todo-print-buffer-function): Document calling convention. (todo-category-completions): Use cl-pushnew instead of add-to-list. (todo-mode-map, todo-archive-mode-map) (todo-categories-mode-map, todo-filtered-items-mode-map): Remove superfluous call of suppress-keymap, since it's already in the parent special-mode-map. diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index e184fdc591..b89c1c2bbd 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -1,4 +1,4 @@ -;;; todo-mode.el --- facilities for making and maintaining todo lists +;;; todo-mode.el --- facilities for making and maintaining todo lists -*- lexical-binding:t -*- ;; Copyright (C) 1997, 1999, 2001-2017 Free Software Foundation, Inc. @@ -72,14 +72,14 @@ file truenames in `todo-directory' with the extension \".todo\". With non-nil ARCHIVES return the list of archive file truenames (those with the extension \".toda\")." (let ((files (if (file-exists-p todo-directory) - (mapcar 'file-truename + (mapcar #'file-truename (directory-files todo-directory t - (if archives "\\.toda$" "\\.todo$") t))))) + (if archives "\\.toda\\'" "\\.todo\\'") t))))) (sort files (lambda (s1 s2) (let ((cis1 (upcase s1)) (cis2 (upcase s2))) (string< cis1 cis2)))))) -(defcustom todo-files-function 'todo-files +(defcustom todo-files-function #'todo-files "Function returning the value of the variable `todo-files'. This function should take an optional argument that, if non-nil, makes it return the value of the variable `todo-archives'." @@ -188,6 +188,15 @@ The final element is \"*\", indicating an unspecified month.") "Array of abbreviated month names, in order. The final element is \"*\", indicating an unspecified month.") +(with-no-warnings + ;; FIXME: These vars lack a prefix, but this is out of our control, because + ;; they're defined by Calendar, e.g. for calendar-date-display-form. + (defvar dayname) + (defvar monthname) + (defvar day) + (defvar month) + (defvar year)) + (defconst todo-date-pattern (let ((dayname (diary-name-pattern calendar-day-name-array nil t))) (concat "\\(?4:\\(?5:" dayname "\\)\\|" @@ -198,7 +207,7 @@ The final element is \"*\", indicating an unspecified month.") (month "\\(?7:[0-9]+\\|\\*\\)") (day "\\(?8:[0-9]+\\|\\*\\)") (year "-?\\(?9:[0-9]+\\|\\*\\)")) - (mapconcat 'eval calendar-date-display-form "")) + (mapconcat #'eval calendar-date-display-form "")) "\\)")) "Regular expression matching a todo item date header.") @@ -260,7 +269,7 @@ This function is the value of the user variable (let ((file (todo-short-file-name todo-current-todo-file))) (format "%s category %d: %s" file todo-category-number cat))) -(defcustom todo-mode-line-function 'todo-mode-line-control +(defcustom todo-mode-line-function #'todo-mode-line-control "Function that returns a mode line control for Todo mode buffers. The function expects one argument holding the name of the current todo category. The resulting control becomes the local value of @@ -555,13 +564,15 @@ This lacks the extension and directory components." (when (stringp file) (file-name-sans-extension (file-name-nondirectory file)))) +(defun todo--files-type-list () + (mapcar (lambda (f) (list 'const (todo-short-file-name f))) + (funcall todo-files-function))) + (defcustom todo-default-todo-file (todo-short-file-name (car (funcall todo-files-function))) "Todo file visited by first session invocation of `todo-show'." :type (when todo-files - `(radio ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function))))) + `(radio ,@(todo--files-type-list))) :group 'todo) (defcustom todo-show-current-file t @@ -598,9 +609,7 @@ Otherwise, `todo-show' always visits `todo-default-todo-file'." (defcustom todo-category-completions-files nil "List of files for building `todo-read-category' completions." - :type `(set ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function)))) + :type `(set ,@(todo--files-type-list)) :group 'todo) (defcustom todo-completion-ignore-case nil @@ -707,11 +716,12 @@ and done items are always shown on visiting a category." (let ((rxfiles (directory-files todo-directory t ".*\\.todr$" t))) (when (and rxfiles (> (length rxfiles) 1)) - (let ((rxf (mapcar 'todo-short-file-name rxfiles))) + (let ((rxf (mapcar #'todo-short-file-name rxfiles))) (setq fi-file (todo-absolute-file-name (completing-read "Choose a regexp items file: " - rxf) 'regexp)))))) + rxf) + 'regexp)))))) (if (file-exists-p fi-file) (progn (set-window-buffer @@ -857,7 +867,7 @@ category is the first)." (zerop (todo-get-count 'done)) (not (zerop (todo-get-count 'archived)))) (setq todo-category-number - (apply (if back '1- '1+) (list todo-category-number))))) + (funcall (if back #'1- #'1+) todo-category-number)))) (todo-category-select) (goto-char (point-min))) @@ -1117,7 +1127,8 @@ these files, also rename them accordingly." (snname (todo-short-file-name nname)) (files (directory-files todo-directory t (concat ".*" (regexp-quote soname) - ".*\\.tod[aorty]$") t))) + ".*\\.tod[aorty]$") + t))) (dolist (f files) (let* ((sfname (todo-short-file-name f)) (fext (file-name-extension f t)) @@ -1363,10 +1374,12 @@ todo or done items." (let ((buffer-read-only) (beg (re-search-backward (concat "^" (regexp-quote (concat todo-category-beg cat)) - "\n") nil t)) + "\n") + nil t)) (end (if (re-search-forward (concat "\n\\(" (regexp-quote todo-category-beg) - ".*\n\\)") nil t) + ".*\n\\)") + nil t) (match-beginning 1) (point-max)))) (remove-overlays beg end) @@ -1475,7 +1488,8 @@ the archive of the file moved to, creating it if it does not exist." (goto-char (point-max)) (re-search-backward (concat "^" (regexp-quote todo-category-beg) - "\\(" (regexp-quote cat) "\\)$") nil t) + "\\(" (regexp-quote cat) "\\)$") + nil t) (replace-match new nil nil nil 1)) (setq todo-categories (append todo-categories (list (cons (or new cat) counts)))) @@ -1746,7 +1760,7 @@ consist of the the last todo items and the first done items." (let ((cat (todo-current-category))) (unless (> n 1) (setq n 1)) (catch 'end - (dotimes (i n) + (dotimes (_ n) (let* ((marks (assoc cat todo-categories-with-marks)) (ov (progn (unless (looking-at todo-item-start) @@ -2134,7 +2148,8 @@ the item at point." (todo-item-start) (re-search-forward (concat " \\[" (regexp-quote todo-comment-string) - ": \\([^]]+\\)\\]") end t))) + ": \\([^]]+\\)\\]") + end t))) (prompt (if comment "Edit comment: " "Enter a comment: ")) (buffer-read-only nil)) ;; When there are marked items, user can invoke todo-edit-item @@ -2150,7 +2165,8 @@ the item at point." (todo-item-start) (if (re-search-forward (concat " \\[" (regexp-quote todo-comment-string) - ": \\([^]]+\\)\\]") end t) + ": \\([^]]+\\)\\]") + end t) (if comment-delete (when (todo-y-or-n-p "Delete comment? ") (delete-region (match-beginning 0) (match-end 0))) @@ -2182,7 +2198,8 @@ the item at point." (cons item 0)))))) (when include-header (while (not (string-match (concat todo-date-string-start - todo-date-pattern) new)) + todo-date-pattern) + new)) (setq new (read-from-minibuffer "Item must start with a date: " new)))) ;; Ensure lines following hard newlines are indented. @@ -2211,7 +2228,8 @@ made in the number or names of categories." (regex "\\(\n\\)[^[:blank:]]") (buf (buffer-base-buffer))) (while (not (string-match (concat todo-date-string-start - todo-date-pattern) item)) + todo-date-pattern) + item)) (setq item (read-from-minibuffer "Item must start with a date: " item))) ;; Ensure lines following hard newlines are indented. @@ -2270,8 +2288,7 @@ made in the number or names of categories." "\\)\\(?2: " diary-time-regexp "\\)?" (regexp-quote todo-nondiary-end) "?") (line-end-position) t) - (let* ((odate (match-string-no-properties 1)) - (otime (match-string-no-properties 2)) + (let* ((otime (match-string-no-properties 2)) (odayname (match-string-no-properties 5)) (omonthname (match-string-no-properties 6)) (omonth (match-string-no-properties 7)) @@ -2382,7 +2399,8 @@ made in the number or names of categories." (calendar-current-date)))) (date (calendar-gregorian-from-absolute (+ (calendar-absolute-from-gregorian - (list mm dd yy)) inc))) + (list mm dd yy)) + inc))) (adjmm (nth 0 date))) ;; Set year and month(name) to adjusted values. (unless (string= year "*") @@ -2396,7 +2414,7 @@ made in the number or names of categories." ;; If year, month or day date string components were ;; changed, rebuild the date string. (when (memq what '(year month day)) - (setq ndate (mapconcat 'eval calendar-date-display-form "")))) + (setq ndate (mapconcat #'eval calendar-date-display-form "")))) (when ndate (replace-match ndate nil nil nil 1)) ;; Add new time string to the header, if it was supplied. (when ntime @@ -2423,7 +2441,7 @@ made in the number or names of categories." (when marked (goto-char (point-min))) (while (not (eobp)) (unless (and marked (not (todo-marked-item-p))) - (let* ((beg (todo-item-start)) + (let* ((_beg (todo-item-start)) (lim (save-excursion (todo-item-end))) (end (save-excursion (or (todo-time-string-matcher lim) @@ -2470,7 +2488,7 @@ items." (while (not (eobp)) (if (todo-done-item-p) ; We've gone too far. (throw 'stop nil) - (let* ((beg (todo-item-start)) + (let* ((_beg (todo-item-start)) (lim (save-excursion (todo-item-end))) (end (save-excursion (or (todo-time-string-matcher lim) @@ -2682,9 +2700,7 @@ section in the category moved to." (not marked)) (let* ((buffer-read-only) (file1 todo-current-todo-file) - (num todo-category-number) (item (todo-item-string)) - (diary-item (todo-diary-item-p)) (done-item (and (todo-done-item-p) item)) (omark (save-excursion (todo-item-start) (point-marker))) (todo 0) @@ -2956,7 +2972,8 @@ comments without asking." ;; affirmed, omit subsequent comments without asking. (when (re-search-forward (concat " \\[" (regexp-quote todo-comment-string) - ": [^]]+\\]") end t) + ": [^]]+\\]") + end t) (unwind-protect (if (eq first 'first) (setq first @@ -3216,7 +3233,8 @@ the only category in the archive, the archive file is deleted." (let* ((cat (todo-current-category)) (tbuf (find-file-noselect (concat (file-name-sans-extension todo-current-todo-file) - ".todo") t)) + ".todo") + t)) (marked (assoc cat todo-categories-with-marks)) (item (concat (todo-item-string) "\n")) (marked-count 0) @@ -3241,7 +3259,8 @@ the only category in the archive, the archive file is deleted." ;; one, add it. (unless (re-search-forward (concat "^" (regexp-quote (concat todo-category-beg cat)) - "$") nil t) + "$") + nil t) (todo-add-category nil cat) (setq newcat t)) ;; Go to top of category's done section. @@ -3449,9 +3468,9 @@ decreasing or increasing its number." (unless prompt (setq priority candidate))) (let* ((lower (< curnum priority)) ; Priority is being lowered. (head (butlast todo-categories - (apply (if lower 'identity '1+) - (list (- maxnum priority))))) - (tail (nthcdr (apply (if lower 'identity '1-) (list priority)) + (funcall (if lower #'identity #'1+) + (- maxnum priority)))) + (tail (nthcdr (funcall (if lower #'identity #'1-) priority) todo-categories)) ;; Category's name and items counts list. (catcons (nth (1- curnum) todo-categories)) @@ -3537,7 +3556,7 @@ decreasing or increasing its number." "Return adjusted length of category label button. The adjustment ensures proper tabular alignment in Todo Categories mode." - (let* ((categories (mapcar 'car todo-categories)) + (let* ((categories (mapcar #'car todo-categories)) (longest (todo-longest-category-name-length categories)) (catlablen (length todo-categories-category-label)) (lc-diff (- longest catlablen))) @@ -3623,24 +3642,24 @@ LABEL determines which type of count is sorted." ov) (insert-button str 'face nil 'action - `(lambda (button) - (let ((key (todo-label-to-key ,label))) - (if (and (member key todo-descending-counts) - (eq key 'alpha)) - (progn - ;; If display is alphabetical, switch back to - ;; category priority order. - (todo-display-sorted nil) - (setq todo-descending-counts - (delete key todo-descending-counts))) - (todo-display-sorted key))))) + (lambda (_button) + (let ((key (todo-label-to-key label))) + (if (and (member key todo-descending-counts) + (eq key 'alpha)) + (progn + ;; If display is alphabetical, switch back to + ;; category priority order. + (todo-display-sorted nil) + (setq todo-descending-counts + (delete key todo-descending-counts))) + (todo-display-sorted key))))) (setq ov (make-overlay beg end)) (overlay-put ov 'face 'todo-button))) (defun todo-total-item-counts () "Return a list of total item counts for the current file." - (mapcar (lambda (i) (apply '+ (mapcar (lambda (l) (aref l i)) - (mapcar 'cdr todo-categories)))) + (mapcar (lambda (i) (apply #'+ (mapcar (lambda (x) (aref (cdr x) i)) + todo-categories))) (list 0 1 2 3))) (defvar todo-categories-category-number 0 @@ -3685,9 +3704,10 @@ which is the value of the user option (not (zerop (todo-get-count 'archived cat)))) 'todo-archived-only nil) - 'action `(lambda (button) (let ((buf (current-buffer))) - (todo-jump-to-category nil ,cat) - (kill-buffer buf)))) + 'action (lambda (_button) + (let ((buf (current-buffer))) + (todo-jump-to-category nil cat) + (kill-buffer buf)))) ;; Highlight the sorted count column. (let* ((beg (+ opoint 7 (length str))) end ovl) @@ -3766,8 +3786,8 @@ which is the value of the user option (delete-region (point) (point-max)) ;; Fill in the table with buttonized lines, each showing a category and ;; its item counts. - (mapc (lambda (cat) (todo-insert-category-line cat sortkey)) - (mapcar 'car cats)) + (dolist (cat cats) + (todo-insert-category-line (car cat) sortkey)) (newline) ;; Add a line showing item count totals. (insert (make-string (+ 4 (length todo-categories-number-separator)) 32) @@ -3823,7 +3843,8 @@ face." (when (looking-at todo-done-string-start) (setq in-done t)) (re-search-backward (concat "^" (regexp-quote todo-category-beg) - "\\(.*\\)\n") nil t) + "\\(.*\\)\n") + nil t) (setq cat (match-string-no-properties 1)) (todo-category-number cat) (todo-category-select) @@ -3885,9 +3906,7 @@ This variable should be set interactively by (defcustom todo-filter-files nil "List of default files for multifile item filtering." - :type `(set ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function)))) + :type `(set ,@(todo--files-type-list)) :group 'todo-filtered) (defcustom todo-filter-done-items nil @@ -4067,19 +4086,17 @@ regexp items." (widget-insert "Select files for generating the top priorities list.\n\n") (setq todo-multiple-filter-files-widget (widget-create - `(set ,@(mapcar (lambda (x) (list 'const x)) - (mapcar 'todo-short-file-name - (funcall todo-files-function)))))) + `(set ,@(todo--files-type-list)))) (widget-insert "\n") (widget-create 'push-button - :notify (lambda (widget &rest ignore) + :notify (lambda (&rest _) (setq todo-multiple-filter-files 'quit) (quit-window t) (exit-recursive-edit)) "Cancel") (widget-insert " ") (widget-create 'push-button - :notify (lambda (&rest ignore) + :notify (lambda (&rest _) (setq todo-multiple-filter-files (mapcar (lambda (f) (file-truename @@ -4137,7 +4154,7 @@ multifile commands for further details." ;; Pressed `cancel' in t-m-f-f file selection dialog. (keyboard-quit) (concat todo-directory - (mapconcat 'todo-short-file-name flist "-") + (mapconcat #'todo-short-file-name flist "-") (cond (top ".todt") (diary ".tody") (regexp ".todr"))))) @@ -4150,10 +4167,11 @@ multifile commands for further details." (todo-filter-items-1 (cons 'top new) flist)) ((and (not new) file-exists) (when (and rxfiles (> (length rxfiles) 1)) - (let ((rxf (mapcar 'todo-short-file-name rxfiles))) + (let ((rxf (mapcar #'todo-short-file-name rxfiles))) (setq fname (todo-absolute-file-name (completing-read "Choose a regexp items file: " - rxf) 'regexp)))) + rxf) + 'regexp)))) (find-file fname) (unless (derived-mode-p 'todo-filtered-items-mode) (todo-filtered-items-mode)) @@ -4164,12 +4182,13 @@ multifile commands for further details." (dolist (s (split-string (todo-short-file-name fname) "-")) (setq bufname (if bufname (concat bufname (if (member s (mapcar - 'todo-short-file-name + #'todo-short-file-name todo-files)) - ", " "-") s) + ", " "-") + s) s))) - (rename-buffer (format (concat "%s for file" (if multi "s" "") - " \"%s\"") buf bufname)))) + (rename-buffer (format (concat "%s for file" (if multi "s" "") " \"%s\"") + buf bufname)))) (defun todo-filter-items-1 (filter file-list) "Build a list of items by applying FILTER to FILE-LIST. @@ -4235,7 +4254,8 @@ the values of FILTER and FILE-LIST." todo-top-priorities))) (while (re-search-forward (concat "^" (regexp-quote todo-category-beg) - "\\(.+\\)\n") nil t) + "\\(.+\\)\n") + nil t) (setq cat (match-string 1)) (let (cnum) ;; Unless the number of top priorities to show was @@ -4389,7 +4409,8 @@ its priority has changed, and `same' otherwise." "\\]" (regexp-quote todo-nondiary-end)) "?" "\\(?4: \\[\\(?3:(archive) \\)?\\(?2:.*:\\)?" - "\\(?1:.*\\)\\]\\).*$") str) + "\\(?1:.*\\)\\]\\).*$") + str) (let ((cat (match-string 1 str)) (file (match-string 2 str)) (archive (string= (match-string 3 str) "(archive) ")) @@ -4504,8 +4525,13 @@ If the file already exists, overwrite it only on confirmation." ;;; Printing Todo mode buffers ;; ----------------------------------------------------------------------------- -(defcustom todo-print-buffer-function 'ps-print-buffer-with-faces - "Function called by the command `todo-print-buffer'." +(defcustom todo-print-buffer-function #'ps-print-buffer-with-faces + "Function called by `todo-print-buffer' to print Todo mode buffers. +The function should take an optional argument whose non-nil value +is a string naming a file to save the print image to; calling +`todo-print-buffer-to-file' prompts for the file name, which is +passed to this function. Calling this function with no or a nil +argument sends the image to the printer." :type 'symbol :group 'todo) @@ -4531,8 +4557,7 @@ otherwise, send it to the default printer." 'face 'todo-prefix-string)) (num 0) (fill-prefix (make-string todo-indent-to-here 32)) - (content (buffer-string)) - file) + (content (buffer-string))) (with-current-buffer (get-buffer-create buf) (insert content) (goto-char (point-min)) @@ -4556,10 +4581,9 @@ otherwise, send it to the default printer." (goto-char (point-min)) (insert header) (newline 2) - (if to-file - (let ((file (read-file-name "Print to file: "))) - (funcall todo-print-buffer-function file)) - (funcall todo-print-buffer-function))) + (funcall todo-print-buffer-function + (if to-file nil + (read-file-name "Print to file: ")))) (kill-buffer buf))) (defun todo-print-buffer-to-file () @@ -4596,7 +4620,7 @@ Helper function for `todo-convert-legacy-files'." (time (match-string 4)) dayname) (replace-match "") - (insert (mapconcat 'eval calendar-date-display-form "") + (insert (mapconcat #'eval calendar-date-display-form "") (when time (concat " " time))))) (defun todo-convert-legacy-files () @@ -4720,7 +4744,8 @@ name in `todo-directory'. See also the documentation string of (unless (save-excursion (re-search-backward (concat "^" (regexp-quote todo-category-beg) - "\\(.*\\)$") nil t) + "\\(.*\\)$") + nil t) (string= (match-string 1) cat)) ;; Else move it to its category. (setq item (buffer-substring-no-properties beg end)) @@ -4734,7 +4759,8 @@ name in `todo-directory'. See also the documentation string of (forward-line) (if (re-search-forward (concat "^" (regexp-quote todo-category-beg) - "\\(.*\\)$") nil t) + "\\(.*\\)$") + nil t) (progn (goto-char (match-beginning 0)) (newline) (forward-line -1)) @@ -4828,10 +4854,7 @@ buffer, clean up the state and return nil." (setq todo-files (funcall todo-files-function)) (setq todo-archives (funcall todo-files-function t)) t) - (let* ((files (append todo-files todo-archives)) - (tctf todo-current-todo-file) - (tgctf todo-global-current-todo-file) - (tdtf (todo-absolute-file-name todo-default-todo-file))) + (let* ((files (append todo-files todo-archives))) (unless (or (not todo-current-todo-file) (member todo-current-todo-file files)) (setq todo-current-todo-file nil)) @@ -4850,7 +4873,7 @@ buffer, clean up the state and return nil." "Return the number of category CAT in this todo file. The buffer-local variable `todo-category-number' holds this number as its value." - (let ((categories (mapcar 'car todo-categories))) + (let ((categories (mapcar #'car todo-categories))) (setq todo-category-number ;; Increment by one, so that the number of the first ;; category is one rather than zero. @@ -4880,7 +4903,8 @@ number as its value." (todo-prefix-overlays) (goto-char (point-min)) (if (re-search-forward (concat "\n\\(" (regexp-quote todo-category-done) - "\\)") nil t) + "\\)") + nil t) (progn (setq done-start (match-beginning 0)) (setq done-sep-start (match-beginning 1)) @@ -5264,7 +5288,8 @@ Overrides `diary-goto-entry'." (when (eq major-mode 'todo-mode) (let ((opoint (point))) (re-search-backward (concat "^" (regexp-quote todo-category-beg) - "\\(.*\\)\n") nil t) + "\\(.*\\)\n") + nil t) (todo-category-number (match-string 1)) (todo-category-select) (goto-char opoint)))))) @@ -5647,8 +5672,7 @@ already entered and those still available." (defvar todo-edit-item--prompt "Press a key (so far `e'): ") (defun todo-edit-item--next-key (params &optional arg) - (let* ((map (make-sparse-keymap)) - (p->k (mapconcat (lambda (elt) + (let* ((p->k (mapconcat (lambda (elt) (format "%s=>%s" (propertize (cdr elt) 'face 'todo-key-prompt) @@ -5736,14 +5760,14 @@ have been removed." todo-global-current-todo-file) (todo-absolute-file-name todo-default-todo-file))) (files (or (unless archive - (mapcar 'todo-absolute-file-name + (mapcar #'todo-absolute-file-name todo-category-completions-files)) (list curfile))) listall listf) ;; If file was just added, it has no category completions. (unless (zerop (buffer-size (find-buffer-visiting curfile))) (unless (member curfile todo-archives) - (add-to-list 'files curfile)) + (cl-pushnew curfile files :test #'equal)) (dolist (f files listall) (with-current-buffer (find-file-noselect f 'nowarn) (if archive @@ -5783,7 +5807,7 @@ return the absolute truename of a todo archive file. With non-nil MUSTMATCH the name of an existing file must be chosen; otherwise, a new file name is allowed." (let* ((completion-ignore-case todo-completion-ignore-case) - (files (mapcar 'todo-short-file-name + (files (mapcar #'todo-short-file-name ;; (funcall todo-files-function archive))) (if archive todo-archives todo-files))) (file (completing-read prompt files nil mustmatch nil nil @@ -5832,7 +5856,8 @@ categories from `todo-category-completions-files'." (todo-read-file-name (concat "Choose a" (if archive "n archive" " todo") - " file: ") archive t))) + " file: ") + archive t))) (completions (unless file0 (todo-category-completions archive))) (categories (cond (file0 (with-current-buffer @@ -5873,7 +5898,7 @@ categories from `todo-category-completions-files'." (if (atom catfil) catfil (todo-absolute-file-name - (let ((files (mapcar 'todo-short-file-name catfil))) + (let ((files (mapcar #'todo-short-file-name catfil))) (completing-read (format str cat) files))))))) ;; Default to the current file. (unless file0 (setq file0 todo-current-todo-file)) @@ -5907,7 +5932,7 @@ categories from `todo-category-completions-files'." "Prompt for new NAME for TYPE until it is valid, then return it. TYPE can be either of the symbols `file' or `category'." (let ((categories todo-categories) - (files (mapcar 'todo-short-file-name todo-files)) + (files (mapcar #'todo-short-file-name todo-files)) prompt) (while (and @@ -5981,8 +6006,8 @@ number of the last the day of the month." (setq monthname (completing-read "Month name (RET for current month, * for any month): " mlist nil t nil nil - (calendar-month-name (calendar-extract-month - (calendar-current-date)) t)) + (calendar-month-name + (calendar-extract-month (calendar-current-date)) t)) month (1+ (- (length mlist) (length (or (member monthname mlist) (member monthname mablist)))))) @@ -6023,7 +6048,7 @@ number of the last the day of the month." (if (memq 'month calendar-date-display-form) month monthname))) - (mapconcat 'eval calendar-date-display-form "")))) + (mapconcat #'eval calendar-date-display-form "")))) (defun todo-read-dayname () "Choose name of a day of the week with completion and return it." @@ -6088,8 +6113,8 @@ the empty string (i.e., no time string)." "The :set function for user option `todo-show-current-file'." (custom-set-default symbol value) (if value - (add-hook 'pre-command-hook 'todo-show-current-file nil t) - (remove-hook 'pre-command-hook 'todo-show-current-file t))) + (add-hook 'pre-command-hook #'todo-show-current-file nil t) + (remove-hook 'pre-command-hook #'todo-show-current-file t))) (defun todo-reset-prefix (symbol value) "The :set function for `todo-prefix' and `todo-number-prefix'." @@ -6228,6 +6253,8 @@ the empty string (i.e., no time string)." (defun todo-reevaluate-filelist-defcustoms () "Reevaluate defcustoms that provide choice list of todo files." + ;; FIXME: This is hideous! I don't know enough about Custom to + ;; offer something better, but please ask on emacs-devel! (custom-set-default 'todo-default-todo-file (symbol-value 'todo-default-todo-file)) (todo-reevaluate-default-file-defcustom) @@ -6242,15 +6269,15 @@ the empty string (i.e., no time string)." Called after adding or deleting a todo file. If the value of `todo-default-todo-file' before calling this function was associated with an existing file, keep that value." + ;; FIXME: This is hideous! I don't know enough about Custom to + ;; offer something better, but please ask on emacs-devel! ;; (let ((curval todo-default-todo-file)) (eval (defcustom todo-default-todo-file (todo-short-file-name (car (funcall todo-files-function))) "Todo file visited by first session invocation of `todo-show'." :type (when todo-files - `(radio ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function))))) + `(radio ,@(todo--files-type-list))) :group 'todo)) ;; (when (and curval (file-exists-p (todo-absolute-file-name curval))) ;; (custom-set-default 'todo-default-todo-file curval) @@ -6261,21 +6288,21 @@ associated with an existing file, keep that value." (defun todo-reevaluate-category-completions-files-defcustom () "Reevaluate defcustom of `todo-category-completions-files'. Called after adding or deleting a todo file." + ;; FIXME: This is hideous! I don't know enough about Custom to + ;; offer something better, but please ask on emacs-devel! (eval (defcustom todo-category-completions-files nil "List of files for building `todo-read-category' completions." - :type `(set ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function)))) + :type `(set ,@(todo--files-type-list)) :group 'todo))) (defun todo-reevaluate-filter-files-defcustom () "Reevaluate defcustom of `todo-filter-files'. Called after adding or deleting a todo file." + ;; FIXME: This is hideous! I don't know enough about Custom to + ;; offer something better, but please ask on emacs-devel! (eval (defcustom todo-filter-files nil "List of files for multifile item filtering." - :type `(set ,@(mapcar (lambda (f) (list 'const f)) - (mapcar 'todo-short-file-name - (funcall todo-files-function)))) + :type `(set ,@(todo--files-type-list)) :group 'todo))) ;; ----------------------------------------------------------------------------- @@ -6292,7 +6319,8 @@ Called after adding or deleting a todo file." (defun todo-diary-nonmarking-matcher (lim) "Search for diary nonmarking symbol within LIM for font-locking." (re-search-forward (concat "^\\(?1:" (regexp-quote diary-nonmarking-symbol) - "\\)" todo-date-pattern) lim t)) + "\\)" todo-date-pattern) + lim t)) (defun todo-date-string-matcher (lim) "Search for todo item date string within LIM for font-locking." @@ -6302,14 +6330,16 @@ Called after adding or deleting a todo file." (defun todo-time-string-matcher (lim) "Search for todo item time string within LIM for font-locking." (re-search-forward (concat todo-date-string-start todo-date-pattern - " \\(?1:" diary-time-regexp "\\)") lim t)) + " \\(?1:" diary-time-regexp "\\)") + lim t)) (defun todo-diary-expired-matcher (lim) "Search for expired diary item date within LIM for font-locking." (when (re-search-forward (concat "^\\(?:" (regexp-quote diary-nonmarking-symbol) "\\)?\\(?1:" todo-date-pattern "\\) \\(?2:" - diary-time-regexp "\\)?") lim t) + diary-time-regexp "\\)?") + lim t) (let* ((date (match-string-no-properties 1)) (time (match-string-no-properties 2)) ;; Function days-between requires a non-empty time string. @@ -6464,8 +6494,6 @@ Filtered Items mode following todo (not done) items." (defvar todo-mode-map (let ((map (make-keymap))) - ;; Don't suppress digit keys, so they can supply prefix arguments. - (suppress-keymap map) (dolist (kb todo-key-bindings-t) (define-key map (nth 0 kb) (nth 1 kb))) (dolist (kb todo-key-bindings-t+a+f) @@ -6479,7 +6507,6 @@ Filtered Items mode following todo (not done) items." (defvar todo-archive-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) (dolist (kb todo-key-bindings-t+a+f) (define-key map (nth 0 kb) (nth 1 kb))) (dolist (kb todo-key-bindings-t+a) @@ -6498,7 +6525,6 @@ Filtered Items mode following todo (not done) items." (defvar todo-categories-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) (define-key map "c" 'todo-sort-categories-alphabetically-or-numerically) (define-key map "t" 'todo-sort-categories-by-todo) (define-key map "y" 'todo-sort-categories-by-diary) @@ -6517,7 +6543,6 @@ Filtered Items mode following todo (not done) items." (defvar todo-filtered-items-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) (dolist (kb todo-key-bindings-t+a+f) (define-key map (nth 0 kb) (nth 1 kb))) (dolist (kb todo-key-bindings-t+f) @@ -6651,9 +6676,9 @@ Added to `window-configuration-change-hook' in Todo mode." (defun todo-modes-set-1 () "Make some settings that apply to multiple Todo modes." (setq-local font-lock-defaults '(todo-font-lock-keywords t)) - (setq-local revert-buffer-function 'todo-revert-buffer) + (setq-local revert-buffer-function #'todo-revert-buffer) (setq-local tab-width todo-indent-to-here) - (setq-local indent-line-function 'todo-indent) + (setq-local indent-line-function #'todo-indent) (when todo-wrap-lines (visual-line-mode) (setq wrap-prefix (make-string todo-indent-to-here 32)))) @@ -6671,13 +6696,13 @@ Added to `window-configuration-change-hook' in Todo mode." (setq buffer-read-only t) (setq-local todo--item-headers-hidden nil) (setq-local desktop-save-buffer 'todo-desktop-save-buffer) - (setq-local hl-line-range-function 'todo-hl-line-range)) + (setq-local hl-line-range-function #'todo-hl-line-range)) (defun todo-modes-set-3 () "Make some settings that apply to multiple Todo modes." (setq-local todo-categories (todo-set-categories)) (setq-local todo-category-number 1) - ;; (add-hook 'find-file-hook 'todo-display-as-todo-file nil t) + ;; (add-hook 'find-file-hook #'todo-display-as-todo-file nil t) ) (put 'todo-mode 'mode-class 'special) @@ -6700,13 +6725,13 @@ Added to `window-configuration-change-hook' in Todo mode." (setq-local todo-current-todo-file (file-truename (buffer-file-name)))) (setq-local todo-show-done-only nil) (setq-local todo-categories-with-marks nil) - ;; (add-hook 'find-file-hook 'todo-add-to-buffer-list nil t) - (add-hook 'post-command-hook 'todo-update-buffer-list nil t) + ;; (add-hook 'find-file-hook #'todo-add-to-buffer-list nil t) + (add-hook 'post-command-hook #'todo-update-buffer-list nil t) (when todo-show-current-file - (add-hook 'pre-command-hook 'todo-show-current-file nil t)) + (add-hook 'pre-command-hook #'todo-show-current-file nil t)) (add-hook 'window-configuration-change-hook - 'todo-reset-and-enable-done-separator nil t) - (add-hook 'kill-buffer-hook 'todo-reset-global-current-todo-file nil t))) + #'todo-reset-and-enable-done-separator nil t) + (add-hook 'kill-buffer-hook #'todo-reset-global-current-todo-file nil t))) (put 'todo-archive-mode 'mode-class 'special) commit 1d559e384b467b3f74e8b78695f124b561c884d9 Author: Tino Calancha Date: Fri Jul 21 13:32:48 2017 +0900 dired: Revert buffer when DIRNAME is a cons * lisp/dired.el (dired-internal-noselect): Revert buffer if DIR-OR-LIST is a cons, or dired-directory is a cons and DIR-OR-LIST a string (Bug#7131). Update the comments. * test/lisp/dired-tests.el (dired-test-bug7131): Test should pass. diff --git a/lisp/dired.el b/lisp/dired.el index 4fb4fe78f8..9d500a9f52 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -872,13 +872,15 @@ periodically reverts at specified time intervals." :version "23.2") (defun dired-internal-noselect (dir-or-list &optional switches mode) - ;; If there is an existing dired buffer for DIRNAME, just leave - ;; buffer as it is (don't even call dired-revert). + ;; If DIR-OR-LIST is a string and there is an existing dired buffer + ;; for it, just leave buffer as it is (don't even call dired-revert). ;; This saves time especially for deep trees or with ange-ftp. ;; The user can type `g' easily, and it is more consistent with find-file. ;; But if SWITCHES are given they are probably different from the ;; buffer's old value, so call dired-sort-other, which does ;; revert the buffer. + ;; Revert the buffer if DIR-OR-LIST is a cons or `dired-directory' + ;; is a cons and DIR-OR-LIST is a string. ;; A pity we can't possibly do "Directory has changed - refresh? " ;; like find-file does. ;; Optional argument MODE is passed to dired-find-buffer-nocreate, @@ -898,6 +900,11 @@ periodically reverts at specified time intervals." (setq dired-directory dir-or-list) ;; this calls dired-revert (dired-sort-other switches)) + ;; Always revert when `dir-or-list' is a cons. Also revert + ;; if `dired-directory' is a cons but `dir-or-list' is not. + ((or (consp dir-or-list) (consp dired-directory)) + (setq dired-directory dir-or-list) + (revert-buffer)) ;; Always revert regardless of whether it has changed or not. ((eq dired-auto-revert-buffer t) (revert-buffer)) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 791ba07fb6..bd1816172e 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -131,7 +131,6 @@ (ert-deftest dired-test-bug7131 () "Test for http://debbugs.gnu.org/7131 ." - :expected-result :failed (let* ((dir (expand-file-name "lisp" source-directory)) (buf (dired dir))) (unwind-protect commit 76268499ddde14f84426ddf84d4997bf8dfb5b65 Author: Tino Calancha Date: Fri Jul 21 13:23:38 2017 +0900 ; * etc/NEWS: Fix format of an entry. diff --git a/etc/NEWS b/etc/NEWS index 954fe0d547..5c52dc0cca 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -571,7 +571,9 @@ paragraphs, for the purposes of bidirectional display. * Changes in Specialized Modes and Packages in Emacs 26.1 ** Dired -You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced + ++++ +*** You can now use '`?`' in 'dired-do-shell-command'; as ' ? ', it gets replaced by the current file name. *** html2text is now marked obsolete. commit d881b33595c8192d93bb861ca4766cfd5a39b1eb Author: Tino Calancha Date: Fri Jul 21 13:17:14 2017 +0900 Handle when dired-directory is a cons in some Dired functions * lisp/dired-aux.el (dired-rename-subdir-1) * lisp/dired-x.el (dired-mark-omitted): Handle when dired-directory is a cons. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 095ce8ba89..17dae6085d 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1623,10 +1623,14 @@ Special value `always' suppresses confirmation." (setq default-directory to dired-directory (expand-file-name;; this is correct ;; with and without wildcards - (file-name-nondirectory dired-directory) + (file-name-nondirectory (if (stringp dired-directory) + dired-directory + (car dired-directory))) to)) (let ((new-name (file-name-nondirectory - (directory-file-name dired-directory)))) + (directory-file-name (if (stringp dired-directory) + dired-directory + (car dired-directory)))))) ;; try to rename buffer, but just leave old name if new ;; name would already exist (don't try appending "<%d>") (or (get-buffer new-name) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 7ceb672bf2..915550991d 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -546,7 +546,9 @@ Should never be used as marker by the user or other packages.") (interactive) (let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp - (dired-omit-case-fold-p dired-directory))) + (dired-omit-case-fold-p (if (stringp dired-directory) + dired-directory + (car dired-directory))))) (defcustom dired-omit-extensions (append completion-ignored-extensions @@ -591,7 +593,9 @@ This functions works by temporarily binding `dired-marker-char' to (let ((dired-marker-char dired-omit-marker-char)) (when dired-omit-verbose (message "Omitting...")) (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp - (dired-omit-case-fold-p dired-directory)) + (dired-omit-case-fold-p (if (stringp dired-directory) + dired-directory + (car dired-directory)))) (progn (setq count (dired-do-kill-lines nil commit 7a0ca227af1081ca7ada2e82a87b1a575ef04759 Author: Noam Postavsky Date: Tue Jul 11 22:11:19 2017 -0400 Make eshell-next-prompt more reliable (Bug#27405) * lisp/eshell/em-prompt.el (eshell-next-prompt): Search for `eshell-prompt-regexp' (and `read-only' text-property if `eshell-highlight-prompt' is set) rather than trying to use `forward-paragraph'. (eshell-previous-prompt): Don't count prompt on current line. diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index 8c81b43b1f..2fd1db2113 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -161,14 +161,25 @@ If N is negative, find the previous or Nth previous match." "Move to end of Nth next prompt in the buffer. See `eshell-prompt-regexp'." (interactive "p") - (forward-paragraph n) + (if eshell-highlight-prompt + (progn + (while (< n 0) + (while (and (re-search-backward eshell-prompt-regexp nil t) + (not (get-text-property (match-beginning 0) 'read-only)))) + (setq n (1+ n))) + (while (> n 0) + (while (and (re-search-forward eshell-prompt-regexp nil t) + (not (get-text-property (match-beginning 0) 'read-only)))) + (setq n (1- n)))) + (re-search-forward eshell-prompt-regexp nil t n)) (eshell-skip-prompt)) (defun eshell-previous-prompt (n) "Move to end of Nth previous prompt in the buffer. See `eshell-prompt-regexp'." (interactive "p") - (eshell-next-prompt (- (1+ n)))) + (beginning-of-line) ; Don't count prompt on current line. + (eshell-next-prompt (- n))) (defun eshell-skip-prompt () "Skip past the text matching regexp `eshell-prompt-regexp'. commit ffde1e9b9e9aa763e18f009e0d54345f509134db Author: Paul Eggert Date: Thu Jul 20 16:21:57 2017 -0700 Simplify recent gnutls.c changes * src/gnutls.c (clear_storage) [HAVE_GNUTLS3_AEAD]: Remove. All uses replaced by calls to explicit_bzero; that’s clear enough. (gnutls_symmetric_aead) [HAVE_GNUTLS3_AEAD]: Simplify by coalescing duplicate actions. There is no need to invoke SAFE_FREE before calling ‘error’. diff --git a/src/gnutls.c b/src/gnutls.c index 7c98840852..59694074e1 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1891,26 +1891,6 @@ The alist key is the cipher name. */) return ciphers; } -#ifdef HAVE_GNUTLS3_AEAD - -/* Zero out STORAGE (even if it will become inaccessible. It has - STORAGE_LENGTH bytes. The goal is to improve security a bit, in - case an Emacs module or some buggy part of Emacs attempts to - inspect STORAGE later to retrieve a secret. - - Calls to this function document when storage containing a secret is - known to go out of scope. This function is not guaranteed to erase - the secret, as copies of STORAGE may well be accessible elsewhere - on the machine. */ - -static void -clear_storage (void *storage, ptrdiff_t storage_length) -{ - explicit_bzero (storage, storage_length); -} - -#endif /* HAVE_GNUTLS3_AEAD */ - static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, @@ -1975,23 +1955,18 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, (acipher, vdata, vsize, aead_auth_data, aead_auth_size, cipher_tag_size, idata, isize, storage, &storage_length)); - if (ret < GNUTLS_E_SUCCESS) - { - clear_storage (storage, storage_length); - SAFE_FREE (); - gnutls_aead_cipher_deinit (acipher); - if (encrypting) - error ("GnuTLS AEAD cipher %s encryption failed: %s", - gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); - else - error ("GnuTLS AEAD cipher %s decryption failed: %s", - gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); - } - + Lisp_Object output; + if (GNUTLS_E_SUCCESS <= ret) + output = make_unibyte_string (storage, storage_length); + explicit_bzero (storage, storage_length); gnutls_aead_cipher_deinit (acipher); - Lisp_Object output = make_unibyte_string (storage, storage_length); - clear_storage (storage, storage_length); + if (ret < GNUTLS_E_SUCCESS) + error ((encrypting + ? "GnuTLS AEAD cipher %s encryption failed: %s" + : "GnuTLS AEAD cipher %s decryption failed: %s"), + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + SAFE_FREE (); return list2 (output, actual_iv); #else commit df26f09f0c62f678fccb7a64dfa7d24202883c2b Author: Paul Eggert Date: Thu Jul 20 15:40:48 2017 -0700 ; Spelling fixes diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 5b8f58c1fd..f5c73e55a4 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7476,7 +7476,7 @@ best to anchor it, i.e., begin it with a @code{"^"}. @defvar bidi-paragraph-separate-re If non-@code{nil}, this variable's value should be a regular expression matching a line separates two paragraphs. The regular -expression is always matched after a newline, so it is best to anch +expression is always matched after a newline, so it is best to anchor it, i.e., begin it with a @code{"^"}. @end defvar diff --git a/lisp/ses.el b/lisp/ses.el index ed5e166d95..8c5ff2136f 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -2526,7 +2526,7 @@ cell formula was unsafe and user declined confirmation." (setq initial (cons initial (length initial)))) (dolist (key ses-completion-keys) (define-key ses-mode-edit-map key 'ses-edit-cell-complete-symbol)) - ;; make it globally visible, so that it can be visbile from the minibuffer. + ;; make it globally visible, so that it can be visible from the minibuffer. (setq ses--completion-table ses--named-cell-hashmap) (list row col (read-from-minibuffer (format "Cell %s: " ses--curcell) @@ -2670,7 +2670,7 @@ canceled." default))) (dolist (key ses-completion-keys) (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol)) - ;; make it globally visible, so that it can be visbile from the minibuffer. + ;; make it globally visible, so that it can be visible from the minibuffer. (setq ses--completion-table ses--local-printer-hashmap) (let ((new (read-from-minibuffer prompt nil ; Initial contents. diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index add94ae98f..8fff6f7352 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -57,8 +57,8 @@ equal to 2. This is done using interactive calls." (ert-deftest ses-tests-lowlevel-renamed-cell () "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 to (1+ foo), makes A2 value equal to 2. This is done using low level functions, `ses-rename-cell' is not -called but instead we use text replacement in the buffer priorly -passed in text mode." +called but instead we use text replacement in the buffer +previously passed in text mode." (let ((ses-initial-size '(2 . 1))) (with-temp-buffer (ses-mode) diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el index 6721e348e1..ad43426dd2 100644 --- a/test/manual/image-size-tests.el +++ b/test/manual/image-size-tests.el @@ -90,7 +90,7 @@ ;; Both max-width/height. (im-should :h 50 100 :max-width 75 :max-height 100) (im-should :h 25 50 :max-width 25 :max-height 100) - ;; :hieght and :max-width (max-width wins). + ;; :height and :max-width (max-width wins). (im-should :h 200 400 :height 400 :max-width 200) (im-should :h 200 400 :height 500 :max-width 200) ) commit 10e5280bdf10b6b412ecb42ec18710e6d9606dd5 Merge: 290d0e733f 8c09f11a32 Author: Michael Albinus Date: Thu Jul 20 20:28:17 2017 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 290d0e733f15135696365be79285bceaaa2067f2 Author: Michael Albinus Date: Thu Jul 20 20:27:55 2017 +0200 Stylistic changes in tramp-cache.el * test/lisp/net/tramp-cache.el (tramp-get-file-property) (tramp-set-file-property): Use `bound-and-true-p'. Add counter variables to `tramp-cache-unload-hook'. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index 7227c9bf7c..a162ab00a5 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -136,9 +136,9 @@ Returns DEFAULT if not set." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (and (boundp var) (symbol-value var)) + (val (or (bound-and-true-p var) (progn - (add-hook 'tramp-unload-hook + (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) 0)))) (set var (1+ val)))) @@ -160,9 +160,9 @@ Returns VALUE." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (and (boundp var) (symbol-value var)) + (val (or (bound-and-true-p var) (progn - (add-hook 'tramp-unload-hook + (add-hook 'tramp-cache-unload-hook (lambda () (makunbound var))) 0)))) (set var (1+ val)))) commit 8c09f11a328223aec4a7c198c99b348e75b78e9b Author: Glenn Morris Date: Thu Jul 20 14:00:27 2017 -0400 * admin/notes/hydra: Small updates. diff --git a/admin/notes/hydra b/admin/notes/hydra index 66d34209e2..4c1944a57d 100644 --- a/admin/notes/hydra +++ b/admin/notes/hydra @@ -7,13 +7,11 @@ NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA A continuous build for Emacs can be found at https://hydra.nixos.org/jobset/gnu/emacs-trunk -https://hydra.nixos.org/jobset/gnu/emacs-24 -https://hydra.nixos.org/jobset/gnu/emacs-25 * It builds Emacs on various platforms. Sometimes jobs fail due to hydra problems rather than Emacs problems. -Eg it seems like the cygwin build will never work again. -https://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html +Eg it seems like the darwin build will never work again. +https://lists.gnu.org/archive/html/hydra-users/2016-01/msg00000.html * Mail notifications In addition to the web interface, Hydra can send notifications by commit ee5ec64624b72fb5c18945949437c6371c76d14c Author: Glenn Morris Date: Thu Jul 20 13:46:52 2017 -0400 Make tramp unloading handle debug counter variables * lisp/net/tramp-cache.el (tramp-get-file-property) (tramp-set-file-property): Add counter variables to tramp-unload-hook. diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index ac5a9c45bb..7227c9bf7c 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -136,7 +136,11 @@ Returns DEFAULT if not set." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-get-count-" property))) - (val (or (and (boundp var) (symbol-value var)) 0))) + (val (or (and (boundp var) (symbol-value var)) + (progn + (add-hook 'tramp-unload-hook + (lambda () (makunbound var))) + 0)))) (set var (1+ val)))) value)) @@ -156,7 +160,11 @@ Returns VALUE." (tramp-message key 8 "%s %s %s" file property value) (when (>= tramp-verbose 10) (let* ((var (intern (concat "tramp-cache-set-count-" property))) - (val (or (and (boundp var) (symbol-value var)) 0))) + (val (or (and (boundp var) (symbol-value var)) + (progn + (add-hook 'tramp-unload-hook + (lambda () (makunbound var))) + 0)))) (set var (1+ val)))) value)) commit 9c6cacd338c90180bc377cae923c716c1dc3d14c Author: Eli Zaretskii Date: Thu Jul 20 16:25:11 2017 +0300 Fix hscrolling calculations when display-line-numbers is set * src/xdisp.c (move_it_in_display_line_to): Account for line numbers in hscrolled lines. (Bug#27756) diff --git a/src/xdisp.c b/src/xdisp.c index c415bf2131..3e5657ffe6 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -8631,6 +8631,7 @@ move_it_in_display_line_to (struct it *it, ptrdiff_t closest_pos UNINIT; ptrdiff_t prev_pos = IT_CHARPOS (*it); bool saw_smaller_pos = prev_pos < to_charpos; + bool line_number_pending = false; /* Don't produce glyphs in produce_glyphs. */ saved_glyph_row = it->glyph_row; @@ -8682,9 +8683,13 @@ move_it_in_display_line_to (struct it *it, if (it->hpos == 0) { /* If line numbers are being displayed, produce a line number. */ - if (should_produce_line_number (it) - && it->current_x == it->first_visible_x) - maybe_produce_line_number (it); + if (should_produce_line_number (it)) + { + if (it->current_x == it->first_visible_x) + maybe_produce_line_number (it); + else + line_number_pending = true; + } /* If there's a line-/wrap-prefix, handle it. */ if (it->method == GET_FROM_BUFFER) handle_line_prefix (it); @@ -9055,6 +9060,15 @@ move_it_in_display_line_to (struct it *it, if (new_x > it->first_visible_x) { + /* If we have reached the visible portion of the + screen line, produce the line number if needed. */ + if (line_number_pending) + { + line_number_pending = false; + it->current_x = it->first_visible_x; + maybe_produce_line_number (it); + it->current_x += new_x - it->first_visible_x; + } /* Glyph is visible. Increment number of glyphs that would be displayed. */ ++it->hpos; commit 371565f7d7746fe5682f4ddc3ab4ea820efccec7 Author: Katsumi Yamaoka Date: Thu Jul 20 07:16:48 2017 +0000 Fix the bogus change made 13 years ago (bug#27084) * lisp/gnus/gnus-sum.el (gnus-summary-toggle-header): Fix the way to test if there is no visible header (bug#27084). diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 9bdd0c66f5..f2e51fb225 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -9780,8 +9780,11 @@ If ARG is a negative number, hide the unwanted header lines." (inhibit-point-motion-hooks t) (hidden (if (numberp arg) (>= arg 0) - (or (not (looking-at "[^ \t\n]+:")) - (gnus-article-hidden-text-p 'headers)))) + (or + ;; The case where there's no visible header + ;; that matches `gnus-visible-headers'. + (looking-at "\n?\\'") + (gnus-article-hidden-text-p 'headers)))) s e) (delete-region (point-min) (point-max)) (with-current-buffer gnus-original-article-buffer commit 644cdd1aa0a10dbfffa3b9b4c7a97f8cddded0b8 Author: Noam Postavsky Date: Tue Sep 13 20:48:09 2016 -0400 Use grep's --null option (Bug#6843) * lisp/progmodes/grep.el (grep-use-null-filename-separator): New option. (grep--regexp-alist-column, grep--regexp-alist-bin-matcher) (grep-with-null-regexp-alist, grep-fallback-regexp-alist): New constants, replacing `grep-regexp-alist'. (grep-regex-alist): Mark the variable obsolete, add a new function of the same name to replace it. (grep-compute-defaults): Compute default for `grep-use-null-filename-separator'. (grep-mode): Set compilation-error-regexp-alist (buffer locally) to the value of `grep-with-null-regexp-alist' or `grep-fallback-regexp-alist' according to `grep-use-null-filename-separator'. * lisp/progmodes/xref.el (xref-collect-matches): Call `grep-regex-alist' instead of the obsolete variable. Don't hardcode grep-regexp-alist match groups. * etc/NEWS: Announce new use of --null. Move 'grep-save-buffers' item under "Grep" heading as well. diff --git a/etc/NEWS b/etc/NEWS index 0c2db0c398..954fe0d547 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -705,6 +705,18 @@ this is controlled by the 'wdired-create-parent-directories' variable. *** 'W' is now bound to 'browse-url-of-dired-file', and is useful for viewing HTML files and the like. +** Grep + +--- +*** Grep commands will now use GNU grep's '--null' option if +available, which allows distinguishing the filename from contents if +they contain colons. This can be controlled by the new custom option +'grep-use-null-filename-separator'. + +*** The grep/rgrep/lgrep functions will now ask about saving files +before running. This is controlled by the 'grep-save-buffers' +variable. + ** Edebug *** Edebug can be prevented from pausing 1 second after reaching a @@ -1053,10 +1065,6 @@ things like forward-word in readline work. ** hideshow mode got four key bindings that are analogous to outline mode bindings: 'C-c @ C-a', 'C-c @ C-t', 'C-c @ C-d', and 'C-c @ C-e.' -** The grep/rgrep/lgrep functions will now ask about saving files -before running. This is controlled by the 'grep-save-buffers' -variable. - --- ** Customizable variable 'query-replace-from-to-separator' now doesn't propertize the string value of the separator. diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index b3d8a51cee..2ddaf884bc 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -47,8 +47,8 @@ to avoid computing them again.") (defun grep-apply-setting (symbol value) "Set SYMBOL to VALUE, and update `grep-host-defaults-alist'. SYMBOL should be one of `grep-command', `grep-template', -`grep-use-null-device', `grep-find-command', -`grep-find-template', `grep-find-use-xargs', or +`grep-use-null-device', `grep-find-command' `grep-find-template', +`grep-find-use-xargs', `grep-use-null-filename-separator', or `grep-highlight-matches'." (when grep-host-defaults-alist (let* ((host-id @@ -160,6 +160,15 @@ Customize or call the function `grep-apply-setting'." :set 'grep-apply-setting :group 'grep) +(defcustom grep-use-null-filename-separator 'auto-detect + "If non-nil, use `grep's `--null' option. +This is done to disambiguate file names in `grep's output." + :type '(choice (const :tag "Do Not Use `--null'" nil) + (const :tag "Use `--null'" t) + (other :tag "Not Set" auto-detect)) + :set 'grep-apply-setting + :group 'grep) + ;;;###autoload (defcustom grep-find-command nil "The default find command for \\[grep-find]. @@ -357,33 +366,53 @@ A grep buffer becomes most recent when you select Grep mode in it. Notice that using \\[next-error] or \\[compile-goto-error] modifies `compilation-last-buffer' rather than `grep-last-buffer'.") -;;;###autoload -(defconst grep-regexp-alist - '( - ;; Use a tight regexp to handle weird file names (with colons +(defconst grep--regexp-alist-column + ;; Calculate column positions (col . end-col) of first grep match on a line + (cons + (lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face))) + (when mbeg + (- mbeg beg))))) + (lambda () + (when grep-highlight-matches + (let* ((beg (match-end 0)) + (end (save-excursion (goto-char beg) (line-end-position))) + (mbeg (text-property-any beg end 'font-lock-face 'grep-match-face)) + (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) + (when mend + (- mend beg))))))) +(defconst grep--regexp-alist-bin-matcher + '("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) +(defconst grep-with-null-regexp-alist + `(("^\\([^\0]+\\)\\(\0\\)\\([0-9]+\\):" 1 3 ,grep--regexp-alist-column nil nil + (2 '(face unspecified display ":"))) + ,grep--regexp-alist-bin-matcher) + "Regexp used to match grep hits. +See `compilation-error-regexp-alist'.") +(defconst grep-fallback-regexp-alist + `(;; Use a tight regexp to handle weird file names (with colons ;; in them) as well as possible. E.g., use [1-9][0-9]* rather ;; than [0-9]+ so as to accept ":034:" in file names. ("^\\(.*?[^/\n]\\):[ \t]*\\([1-9][0-9]*\\)[ \t]*:" - 1 2 - ;; Calculate column positions (col . end-col) of first grep match on a line - ((lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face))) - (when mbeg - (- mbeg beg))))) - . - (lambda () - (when grep-highlight-matches - (let* ((beg (match-end 0)) - (end (save-excursion (goto-char beg) (line-end-position))) - (mbeg (text-property-any beg end 'font-lock-face grep-match-face)) - (mend (and mbeg (next-single-property-change mbeg 'font-lock-face nil end)))) - (when mend - (- mend beg))))))) - ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) - "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") + 1 2 ,grep--regexp-alist-column) + ,grep--regexp-alist-bin-matcher) + "Regexp used to match grep hits when `--null' is not supported. +See `compilation-error-regexp-alist'.") + +(defvaralias 'grep-regex-alist 'grep-with-null-regexp-alist) +(make-obsolete-variable + 'grep-regex-alist "Call `grep-regexp-alist' instead." "26.1") + +;;;###autoload +(defun grep-regexp-alist () + "Return a regexp alist to match grep hits. +The regexp used depends on `grep-use-null-filename-separator'. +See `compilation-error-regexp-alist' for format details." + (if grep-use-null-filename-separator + grep-with-null-regexp-alist grep-fallback-regexp-alist)) (defvar grep-first-column 0 ; bug#10594 "Value to use for `compilation-first-column' in grep buffers.") @@ -538,6 +567,8 @@ This function is called from `compilation-filter-hook'." (grep-use-null-device ,grep-use-null-device) (grep-find-command ,grep-find-command) (grep-find-template ,grep-find-template) + (grep-use-null-filename-separator + ,grep-use-null-filename-separator) (grep-find-use-xargs ,grep-find-use-xargs) (grep-highlight-matches ,grep-highlight-matches))))) (let* ((host-id @@ -550,7 +581,8 @@ This function is called from `compilation-filter-hook'." ;; computed for every host once. (dolist (setting '(grep-command grep-template grep-use-null-device grep-find-command - grep-find-template grep-find-use-xargs + grep-use-null-filename-separator + grep-find-template grep-find-use-xargs grep-highlight-matches)) (set setting (cadr (or (assq setting host-defaults) @@ -576,6 +608,21 @@ This function is called from `compilation-filter-hook'." (concat (regexp-quote hello-file) ":[0-9]+:English"))))))))) + (when (eq grep-use-null-filename-separator 'auto-detect) + (setq grep-use-null-filename-separator + (with-temp-buffer + (let* ((hello-file (expand-file-name "HELLO" data-directory)) + (args `("--null" "-ne" "^English" ,hello-file))) + (if grep-use-null-device + (setq args (append args (list null-device))) + (push "-H" args)) + (and (grep-probe grep-program `(nil t nil ,@args)) + (progn + (goto-char (point-min)) + (looking-at + (concat (regexp-quote hello-file) + "\0[0-9]+:English")))))))) + (when (eq grep-highlight-matches 'auto-detect) (setq grep-highlight-matches (with-temp-buffer @@ -591,6 +638,7 @@ This function is called from `compilation-filter-hook'." grep-template grep-find-template) (let ((grep-options (concat (if grep-use-null-device "-n" "-nH") + (if grep-use-null-filename-separator " --null") (if (grep-probe grep-program `(nil nil nil "-e" "foo" ,null-device) nil 1) @@ -733,7 +781,7 @@ This function is called from `compilation-filter-hook'." (set (make-local-variable 'compilation-error-face) grep-hit-face) (set (make-local-variable 'compilation-error-regexp-alist) - grep-regexp-alist) + (grep-regexp-alist)) ;; compilation-directory-matcher can't be nil, so we set it to a regexp that ;; can never match. (set (make-local-variable 'compilation-directory-matcher) '("\\`a\\`")) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index b8ec50f14a..cc9b794c5a 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -917,20 +917,21 @@ IGNORES is a list of glob patterns." (grep-compute-defaults) (defvar grep-find-template) (defvar grep-highlight-matches) - (let* ((grep-find-template (replace-regexp-in-string "" " -E" - grep-find-template t t)) - (grep-highlight-matches nil) - ;; TODO: Sanitize the regexp to remove Emacs-specific terms, - ;; so that Grep can search for the "relaxed" version. Can we - ;; do that reliably enough, without creating false negatives? - (command (xref--rgrep-command (xref--regexp-to-extended regexp) - files - (expand-file-name dir) - ignores)) - (buf (get-buffer-create " *xref-grep*")) - (grep-re (caar grep-regexp-alist)) - status - hits) + (pcase-let* + ((grep-find-template (replace-regexp-in-string "" " -E" + grep-find-template t t)) + (grep-highlight-matches nil) + ;; TODO: Sanitize the regexp to remove Emacs-specific terms, + ;; so that Grep can search for the "relaxed" version. Can we + ;; do that reliably enough, without creating false negatives? + (command (xref--rgrep-command (xref--regexp-to-extended regexp) + files + (expand-file-name dir) + ignores)) + (buf (get-buffer-create " *xref-grep*")) + (`(,grep-re ,file-group ,line-group . ,_) (car (grep-regexp-alist))) + (status nil) + (hits nil)) (with-current-buffer buf (erase-buffer) (setq status @@ -944,8 +945,8 @@ IGNORES is a list of glob patterns." (not (looking-at grep-re))) (user-error "Search failed with status %d: %s" status (buffer-string))) (while (re-search-forward grep-re nil t) - (push (list (string-to-number (match-string 2)) - (match-string 1) + (push (list (string-to-number (match-string line-group)) + (match-string file-group) (buffer-substring-no-properties (point) (line-end-position))) hits))) (xref--convert-hits (nreverse hits) regexp))) commit eda9aa0d314ca8e8919d4c17927aa86290449f8d Author: Philipp Stephani Date: Wed Jul 19 21:21:40 2017 +0200 * src/gnutls.c (clear_storage): Define only if needed. diff --git a/src/gnutls.c b/src/gnutls.c index e406d66519..7c98840852 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1891,6 +1891,8 @@ The alist key is the cipher name. */) return ciphers; } +#ifdef HAVE_GNUTLS3_AEAD + /* Zero out STORAGE (even if it will become inaccessible. It has STORAGE_LENGTH bytes. The goal is to improve security a bit, in case an Emacs module or some buggy part of Emacs attempts to @@ -1907,6 +1909,8 @@ clear_storage (void *storage, ptrdiff_t storage_length) explicit_bzero (storage, storage_length); } +#endif /* HAVE_GNUTLS3_AEAD */ + static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, commit 0ef1b7ceeb2c32c464236f486355114fa94688ea Author: Stephen Berman Date: Wed Jul 19 15:41:59 2017 +0200 Adjust todo-quit to recent change in dired * lisp/calendar/todo-mode.el (todo-quit): Use quit-window instead of bury-buffer to exit todo-mode. This restores the desired behavior of not immediately returning to the exited todo-mode buffer on quitting another buffer, which a dired bug fix had changed (see http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00739.html). diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 235eb83e85..e184fdc591 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -823,7 +823,7 @@ buries it and restores state as needed." (when (buffer-live-p buf) (kill-buffer buf))) ((eq major-mode 'todo-mode) (todo-save) - (bury-buffer))))) + (quit-window))))) ;; ----------------------------------------------------------------------------- ;;; Navigation between and within categories commit 458057ee29bae8ca450d11905130e90fbe40d727 Author: Michael Albinus Date: Wed Jul 19 11:34:29 2017 +0200 ; Editorial changes in admin/notes/hydra diff --git a/admin/notes/hydra b/admin/notes/hydra index 2cd4dbcb96..66d34209e2 100644 --- a/admin/notes/hydra +++ b/admin/notes/hydra @@ -6,14 +6,14 @@ See the end of the file for license conditions. NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA A continuous build for Emacs can be found at -http://hydra.nixos.org/jobset/gnu/emacs-trunk -http://hydra.nixos.org/jobset/gnu/emacs-24 -http://hydra.nixos.org/jobset/gnu/emacs-25 +https://hydra.nixos.org/jobset/gnu/emacs-trunk +https://hydra.nixos.org/jobset/gnu/emacs-24 +https://hydra.nixos.org/jobset/gnu/emacs-25 * It builds Emacs on various platforms. Sometimes jobs fail due to hydra problems rather than Emacs problems. Eg it seems like the cygwin build will never work again. -http://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html +https://lists.gnu.org/archive/html/hydra-users/2013-08/msg00000.html * Mail notifications In addition to the web interface, Hydra can send notifications by @@ -22,7 +22,7 @@ SUCCEEDED to FAILED. It sends notifications about build status in Emacs trunk to emacs-buildstatus@gnu.org. If you want to receive these notifications, please subscribe at -http://lists.gnu.org/mailman/listinfo/emacs-buildstatus +https://lists.gnu.org/mailman/listinfo/emacs-buildstatus * The Emacs jobset consists of the following jobs: @@ -32,14 +32,15 @@ by running make-dist to create a tarball. If this job fails, all the others will too (because they use the tarball as input). ** The 'build' job -which starts from the tarball and does a normal build +which starts from the tarball and does a normal build. ** The 'coverage' job -does a gcov build and then runs 'make check'. Fails if any test fails. +does a gcov build and then runs 'make check-expensive'. Fails if any +test fails. * Nix expressions The recipe for GNU Emacs are available via Git: -http://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs +https://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs To modify the build job, email the patch to hydra-users@gnu.org. The build recipes are written in the Nix language. @@ -51,9 +52,9 @@ EMACS_HYDRA_CI. * Other Information For a list of other GNU packages that have a continuous build on -Hydra, see http://hydra.nixos.org/project/gnu +Hydra, see https://hydra.nixos.org/project/gnu -See http://www.gnu.org/software/devel.html#Hydra for more information. +See https://www.gnu.org/software/devel.html#Hydra for more information. This file is part of GNU Emacs. commit 47429dcb4afd502e5bff9d37a09b030c0b7e0eb0 Author: Tino Calancha Date: Wed Jul 19 17:46:14 2017 +0900 Add test for bugs 7131, 27762 Require 'ls-lisp' at top of the file. * test/lisp/dired-tests.el (dired-test-bug7131, dired-test-bug27762): New tests. (dired-test-bug27693): Delete Dired buffer at the end. diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 87a83c4f86..791ba07fb6 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -21,7 +21,7 @@ (require 'ert) (require 'dired) (require 'nadvice) - +(require 'ls-lisp) (ert-deftest dired-autoload () "Tests to see whether dired-x has been autoloaded" @@ -116,15 +116,58 @@ (ert-deftest dired-test-bug27693 () "Test for http://debbugs.gnu.org/27693 ." - (require 'ls-lisp) - (let ((size "") - ls-lisp-use-insert-directory-program) - (dired (list (expand-file-name "lisp" source-directory) "simple.el" "subr.el")) - (setq size (number-to-string - (file-attribute-size - (file-attributes (dired-get-filename))))) - (search-backward-regexp size nil t) - (should (looking-back "[[:space:]]" (1- (point)))))) + (let ((dir (expand-file-name "lisp" source-directory)) + (size "") + ls-lisp-use-insert-directory-program buf) + (unwind-protect + (progn + (setq buf (dired (list dir "simple.el" "subr.el")) + size (number-to-string + (file-attribute-size + (file-attributes (dired-get-filename))))) + (search-backward-regexp size nil t) + (should (looking-back "[[:space:]]" (1- (point))))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest dired-test-bug7131 () + "Test for http://debbugs.gnu.org/7131 ." + :expected-result :failed + (let* ((dir (expand-file-name "lisp" source-directory)) + (buf (dired dir))) + (unwind-protect + (progn + (setq buf (dired (list dir "simple.el"))) + (dired-toggle-marks) + (should-not (cdr (dired-get-marked-files))) + (kill-buffer buf) + (setq buf (dired (list dir "simple.el")) + buf (dired dir)) + (dired-toggle-marks) + (should (cdr (dired-get-marked-files)))) + (when (buffer-live-p buf) (kill-buffer buf))))) + +(ert-deftest dired-test-bug27762 () + "Test for http://debbugs.gnu.org/27762 ." + :expected-result :failed + (let* ((dir source-directory) + (default-directory dir) + (files (mapcar (lambda (f) (concat "src/" f)) + (directory-files + (expand-file-name "src") nil "\\.*\\.c\\'"))) + ls-lisp-use-insert-directory-program buf) + (unwind-protect + (let ((file1 "src/cygw32.c") + (file2 "src/atimer.c")) + (setq buf (dired (nconc (list dir) files))) + (dired-goto-file (expand-file-name file2 default-directory)) + (should-not (looking-at "^ -")) ; Must be 2 spaces not 3. + (setq files (cons file1 (delete file1 files))) + (kill-buffer buf) + (setq buf (dired (nconc (list dir) files))) + (should (looking-at "src")) + (next-line) ; File names must be aligned. + (should (looking-at "src"))) + (when (buffer-live-p buf) (kill-buffer buf))))) (provide 'dired-tests) ;; dired-tests.el ends here commit be79366410703a788c3c8ce7951e89bc9dfdac88 Author: Michael Albinus Date: Tue Jul 18 22:40:23 2017 +0200 * admin/notes/hydra: Mention environment variable EMACS_HYDRA_CI. diff --git a/admin/notes/hydra b/admin/notes/hydra index d5959354b0..2cd4dbcb96 100644 --- a/admin/notes/hydra +++ b/admin/notes/hydra @@ -8,6 +8,7 @@ NOTES FOR EMACS CONTINUOUS BUILD ON HYDRA A continuous build for Emacs can be found at http://hydra.nixos.org/jobset/gnu/emacs-trunk http://hydra.nixos.org/jobset/gnu/emacs-24 +http://hydra.nixos.org/jobset/gnu/emacs-25 * It builds Emacs on various platforms. Sometimes jobs fail due to hydra problems rather than Emacs problems. @@ -43,6 +44,11 @@ http://git.savannah.gnu.org/cgit/hydra-recipes.git/tree/emacs To modify the build job, email the patch to hydra-users@gnu.org. The build recipes are written in the Nix language. +* Identifying hydra +Lisp packages, Makefiles, scripts, and other software could determine +whether they run on hydra by checking for the environment variable +EMACS_HYDRA_CI. + * Other Information For a list of other GNU packages that have a continuous build on Hydra, see http://hydra.nixos.org/project/gnu commit 24bd52565a7652817e6bf9b7a5cb9ad99c955a13 Author: Stefan Monnier Date: Tue Jul 18 14:07:16 2017 -0400 * lisp/emacs-lisp/nadvice.el (advice--defalias-fset): Strip advices This tries to make sure that (defalias F (symbol-function F)) stays a no-op. diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index fd1cd2c7aa..c68ecbc59e 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -385,6 +385,18 @@ of the piece of advice." (defun advice--defalias-fset (fsetfun symbol newdef) (unless fsetfun (setq fsetfun #'fset)) + ;; `newdef' shouldn't include advice wrappers, since that's what *we* manage! + ;; So if `newdef' includes advice wrappers, it's usually because someone + ;; naively took (symbol-function F) and then passed that back to `defalias': + ;; let's strip them away. + (cond + ((advice--p newdef) (setq newdef (advice--cd*r newdef))) + ((and (eq 'macro (car-safe newdef)) + (advice--p (cdr newdef))) + (setq newdef `(macro . ,(advice--cd*r (cdr newdef)))))) + ;; The saved-rewrite is specific to the current value, so since we are about + ;; to overwrite that current value with new value, the old saved-rewrite is + ;; not relevant any more. (when (get symbol 'advice--saved-rewrite) (put symbol 'advice--saved-rewrite nil)) (setq newdef (advice--normalize symbol newdef)) commit 5ab91020fbc2f3bf75aa732a7456d9119ccbc347 Author: Glenn Morris Date: Tue Jul 18 12:53:46 2017 -0400 Use a more specific test for running on hydra.nixos.org * lisp/emacs-lisp/ert.el (ert-summarize-tests-batch-and-exit): * test/Makefile.in (WRITE_LOG): * test/lisp/filenotify-tests.el: * test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el (eieio-test-method-order-list-6): * test/lisp/emacs-lisp/eieio-tests/eieio-tests.el (eieio-test-37-obsolete-name-in-constructor): * test/lisp/net/tramp-tests.el: Replace NIX_STORE with EMACS_HYDRA_CI. diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index eb2b2e3e11..cee225cc8e 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1512,7 +1512,7 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (message "%d files contained unexpected results:" (length unexpected)) (mapc (lambda (l) (message " %s" l)) unexpected)) ;; More details on hydra, where the logs are harder to get to. - (when (and (getenv "NIX_STORE") + (when (and (getenv "EMACS_HYDRA_CI") (not (zerop (+ nunexpected nskipped)))) (message "\nDETAILS") (message "-------") diff --git a/test/Makefile.in b/test/Makefile.in index 4e1a120d5c..ba823ec7e3 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -136,7 +136,7 @@ endif $(AM_V_ELC)$(emacs) -f batch-byte-compile $< ## Save logs, and show logs for failed tests. -WRITE_LOG = $(if $(and ${NIX_STORE}, $(findstring tramp, $@)), |& tee $@, > $@ 2>&1) \ +WRITE_LOG = $(if $(and ${EMACS_HYDRA_CI}, $(findstring tramp, $@)), |& tee $@, > $@ 2>&1) \ || { STAT=$$?; cat $@; exit $$STAT; } ifeq ($(TEST_LOAD_EL), yes) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el index 241ca65122..3df2157cc8 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el @@ -192,7 +192,7 @@ (ert-deftest eieio-test-method-order-list-6 () ;; FIXME repeated intermittent failures on hydra (bug#24503) ;; ((:STATIC C) (:STATIC C-base1) (:STATIC C-base2)) != ((:STATIC C))") - (skip-unless (not (getenv "NIX_STORE"))) + (skip-unless (not (getenv "EMACS_HYDRA_CI"))) (let ((eieio-test-method-order-list nil) (ans '( (:STATIC C) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el index c34560ab58..1a6ab9da08 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-tests.el @@ -894,7 +894,7 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-37-obsolete-name-in-constructor () ;; FIXME repeated intermittent failures on hydra (bug#24503) - (skip-unless (not (getenv "NIX_STORE"))) + (skip-unless (not (getenv "EMACS_HYDRA_CI"))) (should (equal (eieio--testing "toto") '("toto" 2)))) (ert-deftest eieio-autoload () diff --git a/test/lisp/filenotify-tests.el b/test/lisp/filenotify-tests.el index 8d05ceacee..3456d31fda 100644 --- a/test/lisp/filenotify-tests.el +++ b/test/lisp/filenotify-tests.el @@ -173,8 +173,8 @@ Return nil when any other file notification watch is still active." tramp-verbose 0 tramp-message-show-message nil) -;; This shall happen on hydra only. -(when (getenv "NIX_STORE") +;; This should happen on hydra only. +(when (getenv "EMACS_HYDRA_CI") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) ;; We do not want to try and fail `file-notify-add-watch'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index de4fc8e051..94e91b7930 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -86,8 +86,8 @@ tramp-message-show-message nil tramp-persistency-file-name nil) -;; This shall happen on hydra only. -(when (getenv "NIX_STORE") +;; This should happen on hydra only. +(when (getenv "EMACS_HYDRA_CI") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) (defvar tramp--test-expensive-test @@ -3706,7 +3706,7 @@ process sentinels. They shall not disturb each other." ;; On hydra, timings are bad. (timer-repeat (cond - ((getenv "NIX_STORE") 10) + ((getenv "EMACS_HYDRA_CI") 10) (t 1))) ;; We must distinguish due to performance reasons. (timer-operation commit c2049489090141311bf8f460bf366d9784950861 Author: Eli Zaretskii Date: Tue Jul 18 19:13:58 2017 +0300 Avoid infloop due to Eshell's "smart" redisplay * src/xdisp.c (pos_visible_p): Save and restore the window's mode-line and header-line height. (Bug#27752) diff --git a/src/xdisp.c b/src/xdisp.c index a3bc5a5fcc..c415bf2131 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -1326,6 +1326,15 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, if (charpos >= 0 && CHARPOS (top) > charpos) return visible_p; + /* Some Lisp hook could call us in the middle of redisplaying this + very window. If, by some bad luck, we are retrying redisplay + because we found that the mode-line height and/or header-line + height needs to be updated, the assignment of mode_line_height + and header_line_height below could disrupt that, due to the + selected/nonselected window dance during mode-line display, and + we could infloop. Avoid that. */ + int prev_mode_line_height = w->mode_line_height; + int prev_header_line_height = w->header_line_height; /* Compute exact mode line heights. */ if (window_wants_mode_line (w)) { @@ -1672,6 +1681,10 @@ pos_visible_p (struct window *w, ptrdiff_t charpos, int *x, int *y, fprintf (stderr, "-pv pt=%d vs=%d\n", charpos, w->vscroll); #endif + /* Restore potentially overwritten values. */ + w->mode_line_height = prev_mode_line_height; + w->header_line_height = prev_header_line_height; + return visible_p; } commit 3d432a180b3ac867d1d028af17cee14d481cfc01 Author: Michael Albinus Date: Tue Jul 18 18:10:09 2017 +0200 ; Add further traces to tramp-tests.el diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 7a240826b5..de4fc8e051 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3806,7 +3806,10 @@ process sentinels. They shall not disturb each other." (tramp--test-message "Trace 3 action %d %s %s" count buf (current-time-string)) (if (= count 2) - (should-not (file-attributes file)) + (if (= (length buffers) 1) + (tramp--test-instrument-test-case 10 + (should-not (file-attributes file))) + (should-not (file-attributes file))) (should (file-attributes file))) (tramp--test-message "Stop action %d %s %s" count buf (current-time-string)) @@ -3929,8 +3932,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix `tramp-test05-expand-file-name-relative' in `expand-file-name'. ;; * Fix `tramp-test06-directory-file-name' for `ftp'. ;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?). -;; * Fix Bug#27009. Set expected error of -;; `tramp-test29-environment-variables-and-port-numbers'. ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. (defun tramp-test-all (&optional interactive) commit fa72de6cf74735c1983720c818b6d67af832e646 Author: Stefan Monnier Date: Tue Jul 18 12:01:27 2017 -0400 * emacs-lisp/cl-lib.el (cl--old-struct-type-of): Accept `[]' diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index c183852fd3..6ac08d839b 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -631,7 +631,7 @@ If ALIST is non-nil, the new pairs are prepended to it." (require 'cl-seq)) (defun cl--old-struct-type-of (orig-fun object) - (or (and (vectorp object) + (or (and (vectorp object) (> (length object) 0) (let ((tag (aref object 0))) (when (and (symbolp tag) (string-prefix-p "cl-struct-" (symbol-name tag))) commit a20f4f02c69544fdc23be9b61bad3387476e102d Author: Eli Zaretskii Date: Tue Jul 18 17:25:30 2017 +0300 Fix indentation when display-line-numbers is non-nil * src/xdisp.c (x_produce_glyphs): Fix a typo in deciding whether to go one more tab stop to display a TAB. (Bug#27743) diff --git a/src/xdisp.c b/src/xdisp.c index 2aceb89c00..a3bc5a5fcc 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -28082,7 +28082,7 @@ x_produce_glyphs (struct it *it) /* If the distance from the current position to the next tab stop is less than a space character width, use the tab stop after that. */ - if (next_tab_x - x0 < font->space_width) + if (next_tab_x - x < font->space_width) next_tab_x += tab_width; if (!NILP (Vdisplay_line_numbers) && x0 >= it->lnum_pixel_width) next_tab_x += (it->lnum_pixel_width commit 742caff3b80b199020ea3d66b5f162cc43ec6174 Author: Lars Ingebrigtsen Date: Tue Jul 18 15:31:28 2017 +0200 Don't use gtk_widget_get_scale_factor on old GTK3 versions * src/gtkutil.c (xg_get_scale): gtk_widget_get_scale_factor is only present since GTK 3.10. diff --git a/src/gtkutil.c b/src/gtkutil.c index 03319726f0..0c8395efe9 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -223,7 +223,7 @@ xg_get_gdk_scale (void) int xg_get_scale (struct frame *f) { -#ifdef HAVE_GTK3 +#if GTK_CHECK_VERSION (3, 10, 0) if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); #endif commit a2ee81911bdf0f37b992989a9d36bb4d2ba14052 Author: Noam Postavsky Date: Tue Jul 11 21:09:10 2017 -0400 Let delete-selection-mode work with popup-menu commands (Bug#27569) * lisp/menu-bar.el (popup-menu): Run `pre-command-hook' with `this-command' set to the selected command. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 3ca7d1b5b3..4a56978329 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -2375,6 +2375,10 @@ FROM-MENU-BAR, if non-nil, means we are dropping one of menu-bar's menus." ;; `setup-specified-language-environment', for instance, ;; expects this to be set from a menu keymap. (setq last-command-event (car (last event))) + ;; Update `this-command' and run `pre-command-hook' so that + ;; things like `delete-selection-pre-hook' will work correctly. + (setq this-command cmd) + (run-hooks 'pre-command-hook) ;; mouse-major-mode-menu was using `command-execute' instead. (call-interactively cmd)))) commit 1a62721f2d82f7a35a9fc84864f6df0ede2c05c5 Author: Paul Eggert Date: Tue Jul 18 00:37:03 2017 -0700 Port gnutls.c to older (buggier?) GnuTLS Problem reported for GnuTLS 3.2.1 by Glenn Morris in: http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00716.html http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00742.html Although I don't see how this bug can occur with vanilla GnuTLS 3.2.1, perhaps hydra was using a modified GnuTLS. * src/gnutls.c (Fgnutls_ciphers): Don't assume GNUTLS_CIPHER_NULL is at the end of the list returned by gnutls_cipher_list, or that the earlier ciphers all have non-null names. diff --git a/src/gnutls.c b/src/gnutls.c index 9fbaea2f40..e406d66519 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1854,12 +1854,17 @@ The alist key is the cipher name. */) #ifdef HAVE_GNUTLS3_CIPHER const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); - for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + for (ptrdiff_t pos = 0; gciphers[pos] != 0; pos++) { gnutls_cipher_algorithm_t gca = gciphers[pos]; + if (gca == GNUTLS_CIPHER_NULL) + continue; + char const *cipher_name = gnutls_cipher_get_name (gca); + if (!cipher_name) + continue; /* A symbol representing the GnuTLS cipher. */ - Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + Lisp_Object cipher_symbol = intern (cipher_name); ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); commit 0083123499cc29e301c197218d3809b225675e57 Author: Vincent Belaïche Date: Mon Jul 17 20:54:20 2017 +0200 Fix relocation with named cell referred to by a one-symbol formula. * lisp/ses.el (ses-replace-name-in-formula): Fix bug for it to work also with one symbol formulas. * test/lisp/ses-tests.el (ses-tests-renaming-cell-with-one-symbol-formula): Add new test for renaming with relocating a one symbol formula. diff --git a/lisp/ses.el b/lisp/ses.el index 2e214348eb..ed5e166d95 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -3634,8 +3634,12 @@ highlighted range in the spreadsheet." (defun ses-replace-name-in-formula (formula old-name new-name) (let ((new-formula formula)) - (unless (and (consp formula) - (eq (car-safe formula) 'quote)) + (cond + ((eq (car-safe formula) 'quote)) + ((symbolp formula) + (if (eq formula old-name) + (setq new-formula new-name))) + ((consp formula) (while formula (let ((elt (car-safe formula))) (cond @@ -3644,8 +3648,8 @@ highlighted range in the spreadsheet." ((and (symbolp elt) (eq (car-safe formula) old-name)) (setcar formula new-name)))) - (setq formula (cdr formula)))) - new-formula)) + (setq formula (cdr formula))))) + new-formula)) (defun ses-rename-cell (new-name &optional cell) "Rename current cell." diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 196f710072..add94ae98f 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -106,6 +106,28 @@ renaming A1 to `foo' makes `foo' value equal to 2." (should (equal (ses-cell-formula 1 0) '(1+ foo))) (should (eq A2 2))))) +(ert-deftest ses-tests-renaming-cell-with-one-symbol-formula () + "Check that setting A1 to 1 and A2 to A1, and then renaming A1 +to `foo' makes `foo' value equal to 1. Then set A1 to 2 and check +that `foo' becomes 2." + (let ((ses-initial-size '(3 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 A1))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook); deferred recalc + (ses-rename-cell 'foo (ses-get-cell 0 0)) + (ses-command-hook); deferred recalc + (should-not (local-variable-p 'A1)) + (should (eq foo 1)) + (should (equal (ses-cell-formula 1 0) 'foo)) + (should (eq A2 1)) + (funcall-interactively 'ses-edit-cell 0 0 2) + (ses-command-hook); deferred recalc + (should (eq A2 2)) + (should (eq foo 2))))) + + ;; ROW INSERTION TESTS ;; ====================================================================== commit 002d6abcc76a8a83e5ea191e6f8d6dbed6b714eb Author: Vincent Belaïche Date: Mon Jul 17 19:58:12 2017 +0200 Fix symbol completion and document it. * doc/misc/ses.texi (Configuring what printer function applies): Add description of keys for completing local printer symbols and listing local printers in a help buffer. (Formulas): Add decription for key to list the named cell symbols in a help buffer. * lisp/ses.el (ses-completion-keys): New constant. (ses--completion-table): New defvar. (ses--list-orig-buffer): New defvar. (ses-mode-edit-map): Fixed for symbol completion, plus add help functions to list named cells or local printers. (ses-edit-cell-complete-symbol) (ses--edit-cell-completion-at-point-function): New defuns for completion during formula edition. (ses-edit-cell): Redefine dynamically edit keymap for completion keys to point at the right function. (ses-read-printer-complete-symbol) (ses--read-printer-completion-at-point-function): New defuns for completion during printer edition. (ses-read-printer): Redefine dynamically edit keymap for completion keys to point at the right function. (ses-list-local-printers): New defun. (ses-list-named-cells): New defun. diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index cac874d0f0..fc79b027a1 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -292,7 +292,13 @@ Self-insert an expression. The right-parenthesis is inserted for you (@code{ses-read-cell}). To access another cell's value, just use its identifier in your expression. Whenever the other cell is changed, this cell's formula will be reevaluated. While typing in the -expression, you can use @kbd{M-@key{TAB}} to complete symbol names. +expression, you can use the following keys: +@table @kbd +@item M-@key{TAB} +to complete symbol names, and +@item C-h C-n +to list the named cells symbols in a help buffer. +@end table @item ' @r{(apostrophe)} Enter a symbol (ses-read-symbol). @acronym{SES} remembers all symbols that have @@ -458,11 +464,22 @@ Enter the default printer for the spreadsheet (@code{ses-read-default-printer}). @end table -The @code{ses-read-@var{xxx}-printer} commands have their own -minibuffer history, which is preloaded with the set of all printers -used in this spreadsheet, plus the standard printers (@pxref{Standard -printer functions}) and the local printers (@pxref{Local printer -functions}). +The @code{ses-read-@var{xxx}-printer} allows the following commands during editing: + +@table @kbd +@item @key{arrow-up} +@itemx @key{arrow-down} +To browse history: the @code{ses-read-@var{xxx}-printer} commands have +their own minibuffer history, which is preloaded with the set of all +printers used in this spreadsheet, plus the standard printers +(@pxref{Standard printer functions}) and the local printers +(@pxref{Local printer functions}). +@item @key{TAB} +To complete the local printer symbols, and +@item C-h C-p +To list the local printers in a help buffer. +@end table + @node Standard printer functions @subsection Standard printer functions diff --git a/lisp/ses.el b/lisp/ses.el index 5c560efb70..2e214348eb 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -167,12 +167,32 @@ Each function is called with ARG=1." ["Export values" ses-export-tsv t] ["Export formulas" ses-export-tsf t])) +(defconst ses-completion-keys '("\M-\C-i" "\C-i") + "List for keys that can be used for completion while editing.") + +(defvar ses--completion-table nil + "Set globally to what completion table to use depending on type + of completion (local printers, cells, etc.). We need to go + through a local variable to pass the SES buffer local variable + to completing function while the current buffer is the + minibuffer.") + +(defvar ses--list-orig-buffer nil + "Calling buffer for SES listing help. Used for listing local + printers or renamed cells.") + + (defconst ses-mode-edit-map (let ((keys '("\C-c\C-r" ses-insert-range "\C-c\C-s" ses-insert-ses-range [S-mouse-3] ses-insert-range-click [C-S-mouse-3] ses-insert-ses-range-click - "\M-\C-i" lisp-complete-symbol)) ; FIXME obsolete + "\C-h\C-p" ses-list-local-printers + "\C-h\C-n" ses-list-named-cells + "\M-\C-i" lisp-complete-symbol)) ; redefined + ; dynamically in + ; editing + ; functions (newmap (make-sparse-keymap))) (set-keymap-parent newmap minibuffer-local-map) (while keys @@ -2447,6 +2467,42 @@ to are recalculated first." ;;---------------------------------------------------------------------------- ;; Input of cell formulas ;;---------------------------------------------------------------------------- +(defun ses-edit-cell-complete-symbol () + (interactive) + (let ((completion-at-point-functions (cons 'ses--edit-cell-completion-at-point-function + completion-at-point-functions))) + (completion-at-point))) + +(defun ses--edit-cell-completion-at-point-function () + (and + ses--completion-table + (let* ((bol (save-excursion (move-beginning-of-line nil) (point))) + start end collection + (prefix + (save-excursion + (setq end (point)) + (backward-sexp) + (if (< (point) bol) + (progn + (setq start bol) + (buffer-substring start end)) + (setq start (point)) + (forward-sexp) + (if (>= (point) end) + (progn + (setq end (point)) + (buffer-substring start end)) + nil)))) + prefix-length) + (when (and prefix (null (string= prefix ""))) + (setq prefix-length (length prefix)) + (maphash (lambda (key val) + (let ((key-name (symbol-name key))) + (when (and (>= (length key-name) prefix-length) + (string= prefix (substring key-name 0 prefix-length))) + (push key-name collection)))) + ses--completion-table) + (and collection (list start end collection)))))) (defun ses-edit-cell (row col newval) "Display current cell contents in minibuffer, for editing. Returns nil if @@ -2468,6 +2524,10 @@ cell formula was unsafe and user declined confirmation." (if (stringp formula) ;; Position cursor inside close-quote. (setq initial (cons initial (length initial)))) + (dolist (key ses-completion-keys) + (define-key ses-mode-edit-map key 'ses-edit-cell-complete-symbol)) + ;; make it globally visible, so that it can be visbile from the minibuffer. + (setq ses--completion-table ses--named-cell-hashmap) (list row col (read-from-minibuffer (format "Cell %s: " ses--curcell) initial @@ -2562,6 +2622,40 @@ cells." ;;---------------------------------------------------------------------------- ;; Input of cell-printer functions ;;---------------------------------------------------------------------------- +(defun ses-read-printer-complete-symbol () + (interactive) + (let ((completion-at-point-functions (cons 'ses--read-printer-completion-at-point-function + completion-at-point-functions))) + (completion-at-point))) + +(defun ses--read-printer-completion-at-point-function () + (let* ((bol (save-excursion (move-beginning-of-line nil) (point))) + start end collection + (prefix + (save-excursion + (setq end (point)) + (backward-sexp) + (if (< (point) bol) + (progn + (setq start bol) + (buffer-substring start end)) + (setq start (point)) + (forward-sexp) + (if (>= (point) end) + (progn + (setq end (point)) + (buffer-substring start end)) + nil)))) + prefix-length) + (when prefix + (setq prefix-length (length prefix)) + (maphash (lambda (key val) + (let ((key-name (symbol-name key))) + (when (and (>= (length key-name) prefix-length) + (string= prefix (substring key-name 0 prefix-length))) + (push key-name collection)))) + ses--completion-table) + (and collection (list start end collection))))) (defun ses-read-printer (prompt default) "Common code for functions `ses-read-cell-printer', `ses-read-column-printer', @@ -2574,6 +2668,10 @@ canceled." (setq prompt (format "%s (default %S): " (substring prompt 0 -2) default))) + (dolist (key ses-completion-keys) + (define-key ses-mode-edit-map key 'ses-read-printer-complete-symbol)) + ;; make it globally visible, so that it can be visbile from the minibuffer. + (setq ses--completion-table ses--local-printer-hashmap) (let ((new (read-from-minibuffer prompt nil ; Initial contents. ses-mode-edit-map @@ -3282,6 +3380,78 @@ is non-nil. Newlines and tabs in the export text are escaped." (setq result (apply #'concat (nreverse result))) (kill-new result))) +;;---------------------------------------------------------------------------- +;; Interactive help on symbols +;;---------------------------------------------------------------------------- + +(defun ses-list-local-printers (&optional local-printer-hashmap) + "List local printers in a help buffer. Can be called either +during editing a printer or a formula, or while in the SES +buffer." + (interactive + (list (cond + ((derived-mode-p 'ses-mode) ses--local-printer-hashmap) + ((minibufferp) ses--completion-table) + ((derived-mode-p 'help-mode) nil) + (t (error "Not in a SES buffer"))))) + (when local-printer-hashmap + (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer)))) + (help-setup-xref + (list (lambda (local-printer-hashmap buffer) + (let ((ses--list-orig-buffer + (if (buffer-live-p buffer) buffer))) + (ses-list-local-printers local-printer-hashmap))) + local-printer-hashmap ses--list-orig-buffer) + (called-interactively-p 'interactive)) + + (save-excursion + (with-help-window (help-buffer) + (if (= 0 (hash-table-count local-printer-hashmap)) + (princ "No local printers defined.") + (princ "List of local printers definitions:\n") + (maphash (lambda (key val) + (princ key) + (princ " as ") + (prin1 (ses--locprn-def val)) + (princ "\n")) + local-printer-hashmap)) + (with-current-buffer standard-output + (buffer-string))))))) + +(defun ses-list-named-cells (&optional named-cell-hashmap) + "List named cells in a help buffer. Can be called either +during editing a printer or a formula, or while in the SES +buffer." + (interactive + (list (cond + ((derived-mode-p 'ses-mode) ses--named-cell-hashmap) + ((minibufferp) ses--completion-table) + ((derived-mode-p 'help-mode) nil) + (t (error "Not in a SES buffer"))))) + (when named-cell-hashmap + (let ((ses--list-orig-buffer (or ses--list-orig-buffer (current-buffer)))) + (help-setup-xref + (list (lambda (named-cell-hashmap buffer) + (let ((ses--list-orig-buffer + (if (buffer-live-p buffer) buffer))) + (ses-list-named-cells named-cell-hashmap))) + named-cell-hashmap ses--list-orig-buffer) + (called-interactively-p 'interactive)) + + (save-excursion + (with-help-window (help-buffer) + (if (= 0 (hash-table-count named-cell-hashmap)) + (princ "No cell was renamed.") + (princ "List of named cells definitions:\n") + (maphash (lambda (key val) + (princ key) + (princ " for ") + (prin1 (ses-create-cell-symbol (car val) (cdr val))) + (princ "\n")) + named-cell-hashmap)) + (with-current-buffer standard-output + (buffer-string))))))) + ;;---------------------------------------------------------------------------- ;; Other user commands commit 727b3df056d978c05bb5dbce5cef715b3b7c31db Author: Lars Ingebrigtsen Date: Sun Jul 16 17:32:43 2017 +0200 Move comments around diff --git a/src/gtkutil.c b/src/gtkutil.c index dddf8b1c25..03319726f0 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,6 +204,7 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +/* Scaling/HiDPI functions. */ static int xg_get_gdk_scale (void) { @@ -219,7 +220,6 @@ xg_get_gdk_scale (void) return 1; } -/* Scaling/HiDPI functions. */ int xg_get_scale (struct frame *f) { commit 552c90edb8cbf673b9a7d07ea39338585fce904a Author: Lars Ingebrigtsen Date: Sun Jul 16 17:31:54 2017 +0200 Make scaling work (?) on pre-GTK3 systems * src/gtkutil.c (xg_get_gdk_scale): Reinstate function. (xg_get_scale): Use it on non-GTK3 systems. diff --git a/src/gtkutil.c b/src/gtkutil.c index 6c9e069001..dddf8b1c25 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,13 +204,30 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +static int +xg_get_gdk_scale (void) +{ + const char *sscale = getenv ("GDK_SCALE"); + + if (sscale) + { + long scale = atol (sscale); + if (0 < scale) + return min (scale, INT_MAX); + } + + return 1; +} + /* Scaling/HiDPI functions. */ int xg_get_scale (struct frame *f) { +#ifdef HAVE_GTK3 if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); - return 1; +#endif + return xg_get_gdk_scale (); } /* Close display DPY. */ commit b04132754e845d84e7e1b5c8bca581c64200aa64 Author: Lars Ingebrigtsen Date: Sun Jul 16 16:54:51 2017 +0200 Always return the GDK scale * src/gtkutil.c (xg_get_scale): Return the GDK scale always. diff --git a/src/gtkutil.c b/src/gtkutil.c index ccc4277321..6c9e069001 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -208,7 +208,7 @@ xg_display_open (char *display_name, Display **dpy) int xg_get_scale (struct frame *f) { - if (FRAME_VISIBLE_P (f) && FRAME_GTK_WIDGET (f)) + if (FRAME_GTK_WIDGET (f)) return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); return 1; } commit 36cf0791ba75ee16dfbedfe437567ec6dd945b8a Author: Lars Ingebrigtsen Date: Sun Jul 16 16:50:57 2017 +0200 Remove usage of the GDK_SCALE variable * src/gtkutil.c (xg_get_gdk_scale): Remove. (xg_get_default_scrollbar_height) (xg_get_default_scrollbar_width): Pass in a frame to check for scaling. (xg_frame_set_char_size): Use the API for querying scale instead of looking at the GDK_SCALE variable. (xg_get_default_scrollbar_width): Ditto. (xg_get_default_scrollbar_height): Ditto. (xg_update_scrollbar_pos): Ditto. * src/xfns.c (x_set_scroll_bar_default_height): Pass in the frame to get the width. diff --git a/src/gtkutil.c b/src/gtkutil.c index 255091559e..ccc4277321 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -845,21 +845,6 @@ xg_set_geometry (struct frame *f) } } -static int -xg_get_gdk_scale (void) -{ - const char *sscale = getenv ("GDK_SCALE"); - - if (sscale) - { - long scale = atol (sscale); - if (0 < scale) - return min (scale, INT_MAX); - } - - return 1; -} - /* Function to handle resize of our frame. As we have a Gtk+ tool bar and a Gtk+ menu bar, we get resize events for the edit part of the frame only. We let Gtk+ deal with the Gtk+ parts. @@ -921,12 +906,8 @@ xg_frame_set_char_size (struct frame *f, int width, int height) /* Do this before resize, as we don't know yet if we will be resized. */ x_clear_under_internal_border (f); - if (FRAME_VISIBLE_P (f)) - { - int scale = xg_get_gdk_scale (); - totalheight /= scale; - totalwidth /= scale; - } + totalheight /= xg_get_scale (f); + totalwidth /= xg_get_scale (f); x_wm_set_size_hint (f, 0, 0); @@ -1352,7 +1333,7 @@ x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) int min_rows = 0, min_cols = 0; int win_gravity = f->win_gravity; Lisp_Object fs_state, frame; - int scale = xg_get_gdk_scale (); + int scale = xg_get_scale (f); /* Don't set size hints during initialization; that apparently leads to a race condition. See the thread at @@ -3668,16 +3649,16 @@ update_theme_scrollbar_height (void) } int -xg_get_default_scrollbar_width (void) +xg_get_default_scrollbar_width (struct frame *f) { - return scroll_bar_width_for_theme * xg_get_gdk_scale (); + return scroll_bar_width_for_theme * xg_get_scale (f); } int -xg_get_default_scrollbar_height (void) +xg_get_default_scrollbar_height (struct frame *f) { /* Apparently there's no default height for themes. */ - return scroll_bar_width_for_theme * xg_get_gdk_scale (); + return scroll_bar_width_for_theme * xg_get_scale (f); } /* Return the scrollbar id for X Window WID on display DPY. @@ -3867,7 +3848,7 @@ xg_update_scrollbar_pos (struct frame *f, GtkWidget *wfixed = f->output_data.x->edit_widget; GtkWidget *wparent = gtk_widget_get_parent (wscroll); gint msl; - int scale = xg_get_gdk_scale (); + int scale = xg_get_scale (f); top /= scale; left /= scale; diff --git a/src/gtkutil.h b/src/gtkutil.h index a252cbef99..f0f2981418 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -143,8 +143,8 @@ extern void xg_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, int position, int whole); extern bool xg_event_is_for_scrollbar (struct frame *, const XEvent *); -extern int xg_get_default_scrollbar_width (void); -extern int xg_get_default_scrollbar_height (void); +extern int xg_get_default_scrollbar_width (struct frame *f); +extern int xg_get_default_scrollbar_height (struct frame *f); extern void update_frame_tool_bar (struct frame *f); extern void free_frame_tool_bar (struct frame *f); diff --git a/src/xfns.c b/src/xfns.c index d8bf974719..2f8c9c2541 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -2062,7 +2062,7 @@ x_set_scroll_bar_default_width (struct frame *f) int unit = FRAME_COLUMN_WIDTH (f); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK - int minw = xg_get_default_scrollbar_width (); + int minw = xg_get_default_scrollbar_width (f); #else int minw = 16; #endif @@ -2083,7 +2083,7 @@ x_set_scroll_bar_default_height (struct frame *f) int height = FRAME_LINE_HEIGHT (f); #ifdef USE_TOOLKIT_SCROLL_BARS #ifdef USE_GTK - int min_height = xg_get_default_scrollbar_height (); + int min_height = xg_get_default_scrollbar_height (f); #else int min_height = 16; #endif commit 4198b4d985db77ad6ae372fa048250e93de5013c Author: Lars Ingebrigtsen Date: Sun Jul 16 16:42:26 2017 +0200 Get positions of menus and tooltips right on HiDPI * src/gtkutil.c (xg_get_scale): New function. (xg_show_tooltip): Use it. * src/xmenu.c (create_and_show_popup_menu): Put menus in the right place. diff --git a/src/gtkutil.c b/src/gtkutil.c index 2d4abefa96..255091559e 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -204,6 +204,14 @@ xg_display_open (char *display_name, Display **dpy) *dpy = gdpy ? GDK_DISPLAY_XDISPLAY (gdpy) : NULL; } +/* Scaling/HiDPI functions. */ +int +xg_get_scale (struct frame *f) +{ + if (FRAME_VISIBLE_P (f) && FRAME_GTK_WIDGET (f)) + return gtk_widget_get_scale_factor (FRAME_GTK_WIDGET (f)); + return 1; +} /* Close display DPY. */ @@ -724,7 +732,8 @@ xg_show_tooltip (struct frame *f, int root_x, int root_y) if (x->ttip_window) { block_input (); - gtk_window_move (x->ttip_window, root_x, root_y); + gtk_window_move (x->ttip_window, root_x / xg_get_scale (f), + root_y / xg_get_scale (f)); gtk_widget_show_all (GTK_WIDGET (x->ttip_window)); unblock_input (); } diff --git a/src/gtkutil.h b/src/gtkutil.h index 0abcb06bc7..a252cbef99 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -156,6 +156,7 @@ extern void xg_frame_resized (struct frame *f, extern void xg_frame_set_char_size (struct frame *f, int width, int height); extern GtkWidget * xg_win_to_widget (Display *dpy, Window wdesc); +extern int xg_get_scale (struct frame *f); extern void xg_display_open (char *display_name, Display **dpy); extern void xg_display_close (Display *dpy); extern GdkCursor * xg_create_default_cursor (Display *dpy); diff --git a/src/xmenu.c b/src/xmenu.c index 6c8a0c506c..64df151b28 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -1271,6 +1271,11 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, /* Child of win. */ &dummy_window); +#ifdef HAVE_GTK3 + /* Use window scaling factor to adjust position for hidpi screens. */ + x /= xg_get_scale (f); + y /= xg_get_scale (f); +#endif unblock_input (); popup_x_y.x = x; popup_x_y.y = y; commit 8729634c511cd564353ff17eb6dc06e87d081035 Author: Eli Zaretskii Date: Mon Jul 17 17:58:12 2017 +0300 ; * doc/emacs/dired.texi (Subdirectory Motion): Fix a typo. (Bug#27727) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 28cb51d88b..ddd7229b0c 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -1115,7 +1115,7 @@ parent directory. @findex dired-next-dirline @kindex > @r{(Dired)} @item > -Move down to the next directory-file line (@code{dired-prev-dirline}). +Move down to the next directory-file line (@code{dired-next-dirline}). @end table @node Hiding Subdirectories commit d7f7fef1c1cdef206860a7075873de7d6c521d8d Author: Eli Zaretskii Date: Mon Jul 17 17:50:37 2017 +0300 Allow user control on what starts and ends a paragraph for bidi * src/buffer.h (struct buffer): New members bidi_paragraph_separate_re_ and bidi_paragraph_start_re_. * src/buffer.c (bset_bidi_paragraph_start_re) (bset_bidi_paragraph_separate_re): New setters/ (Fbuffer_swap_text): Swap the values of bidi-paragraph-start-re and bidi-paragraph-separate-re. (init_buffer_once): Init the values of bidi-paragraph-start-re and bidi-paragraph-separate-re. (syms_of_buffer) : New per-buffer variables. * src/bidi.c (bidi_at_paragraph_end, bidi_find_paragraph_start): Support bidi-paragraph-start-re and bidi-paragraph-separate-re. (bidi_move_to_visually_next): Handle correctly the case when the separator matches an empty string. (Bug#27526) * doc/emacs/mule.texi (Bidirectional Editing): * doc/lispref/display.texi (Bidirectional Display): Document bidi-paragraph-start-re and bidi-paragraph-separate-re. * etc/NEWS: Mention bidi-paragraph-start-re and bidi-paragraph-separate-re. diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi index 8edf2640cf..2f27b9aa0e 100644 --- a/doc/emacs/mule.texi +++ b/doc/emacs/mule.texi @@ -1774,15 +1774,15 @@ Chars}). @cindex bidirectional editing @cindex right-to-left text - Emacs supports editing text written in scripts, such as Arabic and -Hebrew, whose natural ordering of horizontal text for display is from -right to left. However, digits and Latin text embedded in these -scripts are still displayed left to right. It is also not uncommon to -have small portions of text in Arabic or Hebrew embedded in an otherwise -Latin document; e.g., as comments and strings in a program source -file. For these reasons, text that uses these scripts is actually -@dfn{bidirectional}: a mixture of runs of left-to-right and -right-to-left characters. + Emacs supports editing text written in scripts, such as Arabic, +Farsi, and Hebrew, whose natural ordering of horizontal text for +display is from right to left. However, digits and Latin text +embedded in these scripts are still displayed left to right. It is +also not uncommon to have small portions of text in Arabic or Hebrew +embedded in an otherwise Latin document; e.g., as comments and strings +in a program source file. For these reasons, text that uses these +scripts is actually @dfn{bidirectional}: a mixture of runs of +left-to-right and right-to-left characters. This section describes the facilities and options provided by Emacs for editing bidirectional text. @@ -1811,15 +1811,21 @@ directionality when they are displayed. The default value is @cindex base direction of paragraphs @cindex paragraph, base direction +@vindex bidi-paragraph-start-re +@vindex bidi-paragraph-separate-re Each paragraph of bidirectional text can have its own @dfn{base -direction}, either right-to-left or left-to-right. (Paragraph -@c paragraph-separate etc have no influence on this? -boundaries are empty lines, i.e., lines consisting entirely of -whitespace characters.) Text in left-to-right paragraphs begins on -the screen at the left margin of the window and is truncated or -continued when it reaches the right margin. By contrast, text in -right-to-left paragraphs is displayed starting at the right margin and -is continued or truncated at the left margin. +direction}, either right-to-left or left-to-right. Text in +left-to-right paragraphs begins on the screen at the left margin of +the window and is truncated or continued when it reaches the right +margin. By contrast, text in right-to-left paragraphs is displayed +starting at the right margin and is continued or truncated at the left +margin. By default, paragraph boundaries are empty lines, i.e., lines +consisting entirely of whitespace characters. To change that, you can +customize the two variables @code{bidi-paragraph-start-re} and +@code{bidi-paragraph-separate-re}, whose values should be regular +expressions (strings); e.g., to have a single newline start a new +paragraph, set both of these variables to @code{"^"}. These two +variables are buffer-local (@pxref{Locals}). @vindex bidi-paragraph-direction Emacs determines the base direction of each paragraph dynamically, diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 98940cbc99..5b8f58c1fd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -7456,6 +7456,35 @@ truncated or continued when the text reaches the right margin. Right-to-left paragraphs are displayed beginning at the right margin, and are continued or truncated at the left margin. +@cindex paragraph-start, and bidirectional display +@cindex paragraph-separate, and bidirectional display + Where exactly paragraphs start and end, for the purpose of the Emacs +@acronym{UBA} implementation, is determined by the following two +buffer-local variables (note that that @code{paragraph-start} and +@code{paragraph-separate} have no influence on this). By default both +of these variables are @code{nil}, and paragraphs are bounded by empty +lines, i.e., lines that consist entirely of zero or more whitespace +characters followed by a newline. + +@defvar bidi-paragraph-start-re +If non-@code{nil}, this variable's value should be a regular +expression matching a line that starts or separates two paragraphs. +The regular expression is always matched after a newline, so it is +best to anchor it, i.e., begin it with a @code{"^"}. +@end defvar + +@defvar bidi-paragraph-separate-re +If non-@code{nil}, this variable's value should be a regular +expression matching a line separates two paragraphs. The regular +expression is always matched after a newline, so it is best to anch +it, i.e., begin it with a @code{"^"}. +@end defvar + + If you modify any of these two variables, you should normally modify +both, to make sure they describe paragraphs consistently. For +example, to have each new line start a new paragraph for +bidi-reordering purposes, set both variables to @code{"^"}. + By default, Emacs determines the base direction of each paragraph by looking at the text at its beginning. The precise method of determining the base direction is specified by the @acronym{UBA}; in a diff --git a/etc/NEWS b/etc/NEWS index dca562cb3b..0c2db0c398 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -561,6 +561,12 @@ current buffer with the contents of the accessible portion of a different buffer while keeping point, mark, markers, and text properties as intact as possible. ++++ +** More user control of reordering bidirectional text for display. +The two new variables, 'bidi-paragraph-start-re' and +'bidi-paragraph-separate-re', allow customization of what exactly are +paragraphs, for the purposes of bidirectional display. + * Changes in Specialized Modes and Packages in Emacs 26.1 diff --git a/src/bidi.c b/src/bidi.c index e34da778ba..763797488b 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -1448,8 +1448,14 @@ bidi_at_paragraph_end (ptrdiff_t charpos, ptrdiff_t bytepos) Lisp_Object start_re; ptrdiff_t val; - sep_re = paragraph_separate_re; - start_re = paragraph_start_re; + if (STRINGP (BVAR (current_buffer, bidi_paragraph_separate_re))) + sep_re = BVAR (current_buffer, bidi_paragraph_separate_re); + else + sep_re = paragraph_separate_re; + if (STRINGP (BVAR (current_buffer, bidi_paragraph_start_re))) + start_re = BVAR (current_buffer, bidi_paragraph_start_re); + else + start_re = paragraph_start_re; val = fast_looking_at (sep_re, charpos, bytepos, ZV, ZV_BYTE, Qnil); if (val < 0) @@ -1523,7 +1529,10 @@ bidi_paragraph_cache_on_off (void) static ptrdiff_t bidi_find_paragraph_start (ptrdiff_t pos, ptrdiff_t pos_byte) { - Lisp_Object re = paragraph_start_re; + Lisp_Object re = + STRINGP (BVAR (current_buffer, bidi_paragraph_start_re)) + ? BVAR (current_buffer, bidi_paragraph_start_re) + : paragraph_start_re; ptrdiff_t limit = ZV, limit_byte = ZV_BYTE; struct region_cache *bpc = bidi_paragraph_cache_on_off (); ptrdiff_t n = 0, oldpos = pos, next; @@ -3498,10 +3507,16 @@ bidi_move_to_visually_next (struct bidi_it *bidi_it) if (sep_len >= 0) { bidi_it->new_paragraph = 1; - /* Record the buffer position of the last character of the - paragraph separator. */ - bidi_it->separator_limit - = bidi_it->charpos + bidi_it->nchars + sep_len; + /* Record the buffer position of the last character of + the paragraph separator. If the paragraph separator + is an empty string (e.g., the regex is "^"), the + newline that precedes the end of the paragraph is + that last character. */ + if (sep_len > 0) + bidi_it->separator_limit + = bidi_it->charpos + bidi_it->nchars + sep_len; + else + bidi_it->separator_limit = bidi_it->charpos; } } } diff --git a/src/buffer.c b/src/buffer.c index e0972aac33..649ddbe183 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -173,6 +173,16 @@ bset_bidi_display_reordering (struct buffer *b, Lisp_Object val) b->bidi_display_reordering_ = val; } static void +bset_bidi_paragraph_start_re (struct buffer *b, Lisp_Object val) +{ + b->bidi_paragraph_start_re_ = val; +} +static void +bset_bidi_paragraph_separate_re (struct buffer *b, Lisp_Object val) +{ + b->bidi_paragraph_separate_re_ = val; +} +static void bset_buffer_file_coding_system (struct buffer *b, Lisp_Object val) { b->buffer_file_coding_system_ = val; @@ -2322,6 +2332,8 @@ results, see Info node `(elisp)Swapping Text'. */) swapfield_ (enable_multibyte_characters, Lisp_Object); swapfield_ (bidi_display_reordering, Lisp_Object); swapfield_ (bidi_paragraph_direction, Lisp_Object); + swapfield_ (bidi_paragraph_separate_re, Lisp_Object); + swapfield_ (bidi_paragraph_start_re, Lisp_Object); /* FIXME: Not sure what we should do with these *_marker fields. Hopefully they're just nil anyway. */ swapfield_ (pt_marker, Lisp_Object); @@ -5121,6 +5133,8 @@ init_buffer_once (void) XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_separate_re), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_start_re), idx); ++idx; XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; @@ -5202,6 +5216,8 @@ init_buffer_once (void) bset_ctl_arrow (&buffer_defaults, Qt); bset_bidi_display_reordering (&buffer_defaults, Qt); bset_bidi_paragraph_direction (&buffer_defaults, Qnil); + bset_bidi_paragraph_start_re (&buffer_defaults, Qnil); + bset_bidi_paragraph_separate_re (&buffer_defaults, Qnil); bset_cursor_type (&buffer_defaults, Qt); bset_extra_line_spacing (&buffer_defaults, Qnil); bset_cursor_in_non_selected_windows (&buffer_defaults, Qt); @@ -5616,6 +5632,49 @@ This variable is never applied to a way of decoding a file while reading it. */ &BVAR (current_buffer, bidi_display_reordering), Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); + DEFVAR_PER_BUFFER ("bidi-paragraph-start-re", + &BVAR (current_buffer, bidi_paragraph_start_re), Qnil, + doc: /* If non-nil, a regexp matching a line that starts OR separates paragraphs. + +The value of nil means to use empty lines as lines that start and +separate paragraphs. + +When Emacs displays bidirectional text, it by default computes +the base paragraph direction separately for each paragraph. +Setting this variable changes the places where paragraph base +direction is recomputed. + +The regexp is always matched after a newline, so it is best to +anchor it by beginning it with a "^". + +If you change the value of this variable, be sure to change +the value of `bidi-paragraph-separate-re' accordingly. For +example, to have a single newline behave as a paragraph separator, +set both these variables to "^". + +See also `bidi-paragraph-direction'. */); + + DEFVAR_PER_BUFFER ("bidi-paragraph-separate-re", + &BVAR (current_buffer, bidi_paragraph_separate_re), Qnil, + doc: /* If non-nil, a regexp matching a line that separates paragraphs. + +The value of nil means to use empty lines as paragraph separators. + +When Emacs displays bidirectional text, it by default computes +the base paragraph direction separately for each paragraph. +Setting this variable changes the places where paragraph base +direction is recomputed. + +The regexp is always matched after a newline, so it is best to +anchor it by beginning it with a "^". + +If you change the value of this variable, be sure to change +the value of `bidi-paragraph-start-re' accordingly. For +example, to have a single newline behave as a paragraph separator, +set both these variables to "^". + +See also `bidi-paragraph-direction'. */); + DEFVAR_PER_BUFFER ("bidi-paragraph-direction", &BVAR (current_buffer, bidi_paragraph_direction), Qnil, doc: /* If non-nil, forces directionality of text paragraphs in the buffer. diff --git a/src/buffer.h b/src/buffer.h index be270fe482..46ca6aa738 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -611,6 +611,12 @@ struct buffer direction dynamically for each paragraph. */ Lisp_Object bidi_paragraph_direction_; + /* If non-nil, a regular expression for bidi paragraph separator. */ + Lisp_Object bidi_paragraph_separate_re_; + + /* If non-nil, a regular expression for bidi paragraph start. */ + Lisp_Object bidi_paragraph_start_re_; + /* Non-nil means do selective display; see doc string in syms_of_buffer (buffer.c) for details. */ Lisp_Object selective_display_; commit 5e2ae74df54d4090c591c79ab13e7713c6654b9c Author: Tino Calancha Date: Mon Jul 17 22:01:17 2017 +0900 * lisp/emacs-lisp/map.el (map-put): Fix redundancy in docstring. diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index 31ba075c40..e098eef829 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -130,8 +130,6 @@ MAP can be a list, hash-table or array." If KEY is already present in MAP, replace the associated value with VALUE. When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'. -TESTFN, if non-nil, means use its function definition instead of -`eql'. MAP can be a list, hash-table or array." `(setf (map-elt ,map ,key nil ,testfn) ,value)) commit 76e1f7d00fbff7bf8183ba85db2f67a11aa2d5ce Author: Tino Calancha Date: Mon Jul 17 21:30:50 2017 +0900 alist-get: Add optional arg TESTFN If TESTFN is non-nil, then it is the predicate to lookup the alist. Otherwise, use 'eq' (Bug#27584). * lisp/subr.el (alist-get): Add optional arg FULL. * lisp/emacs-lisp/map.el (map-elt, map-put): Add optional arg TESTFN. * lisp/emacs-lisp/gv.el (alist-get): Update expander. * doc/lispref/lists.texi (Association Lists): Update manual. * etc/NEWS: Announce the changes. * test/lisp/emacs-lisp/map-tests.el (test-map-put-testfn-alist) (test-map-elt-testfn): New tests. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 966d8f18b1..0c99380682 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1589,16 +1589,20 @@ keys may not be symbols: @end smallexample @end defun -@defun alist-get key alist &optional default remove -This function is like @code{assq}, but instead of returning the entire -association for @var{key} in @var{alist}, -@w{@code{(@var{key} . @var{value})}}, it returns just the @var{value}. -If @var{key} is not found in @var{alist}, it returns @var{default}. - -This is a generalized variable (@pxref{Generalized Variables}) that -can be used to change a value with @code{setf}. When using it to set -a value, optional argument @var{remove} non-@code{nil} means to remove -@var{key} from @var{alist} if the new value is @code{eql} to @var{default}. +@defun alist-get key alist &optional default remove testfn +This function is similar to @code{assq}. It finds the first +association @w{@code{(@var{key} . @var{value})}} by comparing +@var{key} with @var{alist} elements, and, if found, returns the +@var{value} of that association. If no association is found, the +function returns @var{default}. Comparison of @var{key} against +@var{alist} elements uses the function specified by @var{testfn}, +defaulting to @code{eq}. + +This is a generalized variable (@pxref{Generalized Variables}) +that can be used to change a value with @code{setf}. When +using it to set a value, optional argument @var{remove} non-@code{nil} +means to remove @var{key}'s association from @var{alist} if the new +value is @code{eql} to @var{default}. @end defun @defun rassq value alist diff --git a/etc/NEWS b/etc/NEWS index edb71118ef..dca562cb3b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1119,6 +1119,9 @@ break. * Lisp Changes in Emacs 26.1 ++++ +** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. + ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c5c12a6414..27376fc7f9 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -377,10 +377,12 @@ The return value is the last VAL in the list. `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) (gv-define-expander alist-get - (lambda (do key alist &optional default remove) + (lambda (do key alist &optional default remove testfn) (macroexp-let2 macroexp-copyable-p k key (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assq ,k ,getter) + (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) + (assoc ,k ,getter ,testfn) + (assq ,k ,getter)) (funcall do (if (null default) `(cdr ,p) `(if ,p (cdr ,p) ,default)) (lambda (v) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index a89457e877..31ba075c40 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 1.1 +;; Version: 1.2 ;; Package: map ;; Maintainer: emacs-devel@gnu.org @@ -93,11 +93,13 @@ Returns the result of evaluating the form associated with MAP-VAR's type." ((arrayp ,map-var) ,(plist-get args :array)) (t (error "Unsupported map: %s" ,map-var))))) -(defun map-elt (map key &optional default) +(defun map-elt (map key &optional default testfn) "Lookup KEY in MAP and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. -If MAP is a list, `eql' is used to lookup KEY. +If MAP is a list, `eql' is used to lookup KEY. Optional argument +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." (declare @@ -106,30 +108,33 @@ MAP can be a list, hash-table or array." (gv-letplace (mgetter msetter) `(gv-delay-error ,map) (macroexp-let2* nil ;; Eval them once and for all in the right order. - ((key key) (default default)) + ((key key) (default default) (testfn testfn)) `(if (listp ,mgetter) ;; Special case the alist case, since it can't be handled by the ;; map--put function. ,(gv-get `(alist-get ,key (gv-synthetic-place ,mgetter ,msetter) - ,default) + ,default nil ,testfn) do) ,(funcall do `(map-elt ,mgetter ,key ,default) (lambda (v) `(map--put ,mgetter ,key ,v))))))))) (map--dispatch map - :list (alist-get key map default) + :list (alist-get key map default nil testfn) :hash-table (gethash key map default) :array (if (and (>= key 0) (< key (seq-length map))) (seq-elt map key) default))) -(defmacro map-put (map key value) +(defmacro map-put (map key value &optional testfn) "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value with VALUE. +When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'. +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." - `(setf (map-elt ,map ,key) ,value)) + `(setf (map-elt ,map ,key nil ,testfn) ,value)) (defun map-delete (map key) "Delete KEY from MAP and return MAP. diff --git a/lisp/subr.el b/lisp/subr.el index a9edff6166..d9d918ed12 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -725,15 +725,18 @@ Elements of ALIST that are not conses are ignored." (setq tail tail-cdr)))) alist) -(defun alist-get (key alist &optional default remove) - "Return the value associated with KEY in ALIST, using `assq'. +(defun alist-get (key alist &optional default remove testfn) + "Return the value associated with KEY in ALIST. If KEY is not found in ALIST, return DEFAULT. +Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. This is a generalized variable suitable for use with `setf'. When using it to set a value, optional argument REMOVE non-nil means to remove KEY from ALIST if the new value is `eql' to DEFAULT." (ignore remove) ;;Silence byte-compiler. - (let ((x (assq key alist))) + (let ((x (if (not testfn) + (assq key alist) + (assoc key alist testfn)))) (if x (cdr x) default))) (defun remove (elt seq) diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 07e85cc539..15b0655040 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -63,6 +63,11 @@ Evaluate BODY for each created map. (with-maps-do map (should (= 5 (map-elt map 7 5))))) +(ert-deftest test-map-elt-testfn () + (let ((map (list (cons "a" 1) (cons "b" 2)))) + (should-not (map-elt map "a")) + (should (map-elt map "a" nil 'equal)))) + (ert-deftest test-map-elt-with-nil-value () (should (null (map-elt '((a . 1) (b)) @@ -94,6 +99,13 @@ Evaluate BODY for each created map. (should (eq (map-elt alist 2) 'b)))) +(ert-deftest test-map-put-testfn-alist () + (let ((alist (list (cons "a" 1) (cons "b" 2)))) + (map-put alist "a" 3 'equal) + (should-not (cddr alist)) + (map-put alist "a" 9) + (should (cddr alist)))) + (ert-deftest test-map-put-return-value () (let ((ht (make-hash-table))) (should (eq (map-put ht 'a 'hello) 'hello)))) commit 4968aa685b85840d79258ff6b61ba2bcfb99e2bc Author: Michael Albinus Date: Mon Jul 17 14:12:20 2017 +0200 Fix `tramp-test39-unload' * test/lisp/net/tramp-tests.el (tramp--test-instrument-test-case-p) (tramp--test-instrument-test-case): Rename. Adapt all callees. (tramp-test36-asynchronous-requests): Bind `timer-max-repeats'. (tramp-test39-unload): Expect it to pass. Ignore buffer-local variables and autoload functions; they are not removed. Check also for `-function(s)'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 07d319bce0..7a240826b5 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -132,12 +132,12 @@ If QUOTED is non-nil, the local part of the file is quoted." (make-temp-name "tramp-test") (if local temporary-file-directory tramp-test-temporary-file-directory)))) -;; Don't print messages in nested `tramp--instrument-test-case' calls. -(defvar tramp--instrument-test-case-p nil - "Whether `tramp--instrument-test-case' run. +;; Don't print messages in nested `tramp--test-instrument-test-case' calls. +(defvar tramp--test-instrument-test-case-p nil + "Whether `tramp--test-instrument-test-case' run. This shall used dynamically bound only.") -(defmacro tramp--instrument-test-case (verbose &rest body) +(defmacro tramp--test-instrument-test-case (verbose &rest body) "Run BODY with `tramp-verbose' equal VERBOSE. Print the the content of the Tramp debug buffer, if BODY does not eval properly in `should' or `should-not'. `should-error' is not @@ -150,9 +150,9 @@ handled properly. BODY shall not contain a timeout." (cons "^make-symbolic-link not supported$" debug-ignored-errors)) inhibit-message) (unwind-protect - (let ((tramp--instrument-test-case-p t)) ,@body) + (let ((tramp--test-instrument-test-case-p t)) ,@body) ;; Unwind forms. - (when (and (null tramp--instrument-test-case-p) (> tramp-verbose 3)) + (when (and (null tramp--test-instrument-test-case-p) (> tramp-verbose 3)) (with-parsed-tramp-file-name tramp-test-temporary-file-directory nil (with-current-buffer (tramp-get-connection-buffer v) (message "%s" (buffer-string))) @@ -161,7 +161,7 @@ handled properly. BODY shall not contain a timeout." (defsubst tramp--test-message (fmt-string &rest arguments) "Emit a message into ERT *Messages*." - (tramp--instrument-test-case 0 + (tramp--test-instrument-test-case 0 (apply 'tramp-message (tramp-dissect-file-name tramp-test-temporary-file-directory) 0 @@ -169,7 +169,7 @@ handled properly. BODY shall not contain a timeout." (defsubst tramp--test-backtrace () "Dump a backtrace into ERT *Messages*." - (tramp--instrument-test-case 10 + (tramp--test-instrument-test-case 10 (tramp-backtrace (tramp-dissect-file-name tramp-test-temporary-file-directory)))) @@ -3699,6 +3699,9 @@ process sentinels. They shall not disturb each other." (process-file-side-effects t) ;; Suppress nasty messages. (inhibit-message t) + ;; Do not run delayed timers. + (timer-max-repeats 0) + ;; Number of asynchronous processes for test. (number-proc 10) ;; On hydra, timings are bad. (timer-repeat @@ -3879,8 +3882,6 @@ process sentinels. They shall not disturb each other." (ert-deftest tramp-test39-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." - ;; Mark as failed until all symbols are unbound. - :expected-result (if (featurep 'tramp) :failed :passed) :tags '(:expensive-test) (skip-unless noninteractive) @@ -3891,11 +3892,13 @@ Since it unloads Tramp, it shall be the last test to run." (should-not (all-completions "tramp" (delq 'tramp-tests features))) ;; `file-name-handler-alist' must be clean. (should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist))) - ;; There shouldn't be left a bound symbol. We do not regard our - ;; test symbols, and the Tramp unload hooks. + ;; There shouldn't be left a bound symbol, except buffer-local + ;; variables, and autoload functions. We do not regard our test + ;; symbols, and the Tramp unload hooks. (mapatoms (lambda (x) - (and (or (boundp x) (functionp x)) + (and (or (and (boundp x) (null (local-variable-if-set-p x))) + (and (functionp x) (null (autoloadp (symbol-function x))))) (string-match "^tramp" (symbol-name x)) (not (string-match "^tramp--?test" (symbol-name x))) (not (string-match "unload-hook$" (symbol-name x))) @@ -3905,7 +3908,7 @@ Since it unloads Tramp, it shall be the last test to run." (mapatoms (lambda (x) (and (boundp x) - (string-match "-hooks?$" (symbol-name x)) + (string-match "-\\(hook\\|function\\)s?$" (symbol-name x)) (not (string-match "unload-hook$" (symbol-name x))) (consp (symbol-value x)) (ignore-errors (all-completions "tramp" (symbol-value x))) @@ -3929,8 +3932,6 @@ Since it unloads Tramp, it shall be the last test to run." ;; * Fix Bug#27009. Set expected error of ;; `tramp-test29-environment-variables-and-port-numbers'. ;; * Fix Bug#16928 in `tramp-test36-asynchronous-requests'. -;; * Fix `tramp-test39-unload' (Not all symbols are unbound). Set -;; expected error. (defun tramp-test-all (&optional interactive) "Run all tests for \\[tramp]." commit b2150e0b02fa4a7ad4c1461e0b4ff8fd632c0fb8 Author: Stephen Berman Date: Mon Jul 17 11:09:07 2017 +0200 Preserve point under 'dired-auto-revert-buffer' (second case) * lisp/dired.el (dired): Use pop-to-buffer-same-window instead of switch-to-buffer. This preserves Dired window point when dired-auto-revert-buffer is non-nil. (Bug#27243) * test/lisp/dired-tests.el (dired-test-bug27243): New test. diff --git a/lisp/dired.el b/lisp/dired.el index 0c1f3e4af6..4fb4fe78f8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -785,7 +785,7 @@ Type \\[describe-mode] after entering Dired for more info. If DIRNAME is already in a Dired buffer, that buffer is used without refresh." ;; Cannot use (interactive "D") because of wildcards. (interactive (dired-read-dir-and-switches "")) - (switch-to-buffer (dired-noselect dirname switches))) + (pop-to-buffer-same-window (dired-noselect dirname switches))) ;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window) ;;;###autoload diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 208e1c2509..87a83c4f86 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -84,6 +84,36 @@ (advice-remove 'dired-query "advice-dired-query") (advice-remove 'completing-read "advice-completing-read")))) +(ert-deftest dired-test-bug27243 () + "Test for http://debbugs.gnu.org/27243 ." + (let ((test-dir (make-temp-file "test-dir-" t)) + (dired-auto-revert-buffer t)) + (with-current-buffer (find-file-noselect test-dir) + (make-directory "test-subdir")) + (dired test-dir) + (unwind-protect + (let ((buf (current-buffer)) + (pt1 (point)) + (test-file (concat (file-name-as-directory "test-subdir") + "test-file"))) + (write-region "Test" nil test-file nil 'silent nil 'excl) + ;; Sanity check: point should now be on the subdirectory. + (should (equal (dired-file-name-at-point) + (concat (file-name-as-directory test-dir) + (file-name-as-directory "test-subdir")))) + (dired-find-file) + (let ((pt2 (point))) ; Point is on test-file. + (switch-to-buffer buf) + ;; Sanity check: point should now be back on the subdirectory. + (should (eq (point) pt1)) + ;; Case 1: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#5 + (dired-find-file) + (should (eq (point) pt2)) + ;; Case 2: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27243#28 + (dired test-dir) + (should (eq (point) pt1)))) + (delete-directory test-dir t)))) + (ert-deftest dired-test-bug27693 () "Test for http://debbugs.gnu.org/27693 ." (require 'ls-lisp) commit b7072318334ff84dfe525e7863f1119236979395 Author: Martin Rudalics Date: Mon Jul 17 09:00:55 2017 +0200 Have Fgnutls_available_p return Qnil when GNUTLS is undefined * src/gnutls.c (Fgnutls_available_p): Return Qnil when GNUTLS is undefined to allow --with-gnutls=no builds to proceed. diff --git a/src/gnutls.c b/src/gnutls.c index bcccd7ffd3..9fbaea2f40 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2435,6 +2435,8 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) { Lisp_Object capabilities = Qnil; +#ifdef HAVE_GNUTLS + # ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); @@ -2470,7 +2472,11 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) return capabilities; -#endif +#endif /* WINDOWSNT */ + +#else /* !HAVE_GNUTLS */ + return Qnil; +#endif /* HAVE_GNUTLS */ } void commit 8250a20f9dd6c53ee1891c16a24c746110f594f6 Author: Paul Eggert Date: Sun Jul 16 17:27:03 2017 -0700 * src/gnutls.c: Restore some comments. diff --git a/src/gnutls.c b/src/gnutls.c index 7d19f90fbb..bcccd7ffd3 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1857,7 +1857,10 @@ The alist key is the cipher name. */) for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { gnutls_cipher_algorithm_t gca = gciphers[pos]; + + /* A symbol representing the GnuTLS cipher. */ Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); Lisp_Object cp @@ -2200,9 +2203,10 @@ name. */) { const gnutls_mac_algorithm_t gma = macs[pos]; - const char *name = gnutls_mac_get_name (gma); + /* A symbol representing the GnuTLS MAC algorithm. */ + Lisp_Object gma_symbol = intern (gnutls_mac_get_name (gma)); - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, intern (name), + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, gma_symbol, QCmac_algorithm_id, make_number (gma), QCtype, Qgnutls_type_mac_algorithm, @@ -2236,9 +2240,10 @@ method name. */) { const gnutls_digest_algorithm_t gda = digests[pos]; - const char *name = gnutls_digest_get_name (gda); + /* A symbol representing the GnuTLS digest algorithm. */ + Lisp_Object gda_symbol = intern (gnutls_digest_get_name (gda)); - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, intern (name), + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, gda_symbol, QCdigest_algorithm_id, make_number (gda), QCtype, Qgnutls_type_digest_algorithm, commit b740b02d2311cb5a3dd61767f824f3bfa770184e Author: Paul Eggert Date: Sun Jul 16 16:22:33 2017 -0700 Use memset, not bzero * src/ftcrfont.c (ftcrfont_glyph_extents): Use memset instead of the (less-portable) bzero. diff --git a/src/ftcrfont.c b/src/ftcrfont.c index d72005771e..9b592e6a74 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -81,9 +81,9 @@ ftcrfont_glyph_extents (struct font *font, ftcrfont_info->metrics = xrealloc (ftcrfont_info->metrics, sizeof (struct font_metrics *) * (row + 1)); - bzero (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, - (sizeof (struct font_metrics *) - * (row + 1 - ftcrfont_info->metrics_nrows))); + memset (ftcrfont_info->metrics + ftcrfont_info->metrics_nrows, 0, + (sizeof (struct font_metrics *) + * (row + 1 - ftcrfont_info->metrics_nrows))); ftcrfont_info->metrics_nrows = row + 1; } if (ftcrfont_info->metrics[row] == NULL) commit 59f6972134f312863dc761bf66a954a8036d0d86 Author: Paul Eggert Date: Sun Jul 16 16:22:33 2017 -0700 Use explicit_bzero to clear GnuTLS keys * admin/merge-gnulib (GNULIB_MODULES): Add explicit_bzero. * lib/explicit_bzero.c, m4/explicit_bzero.m4: New files. * lib/gnulib.mk.in, m4/gnulib-comp.m4: Regenerate. * src/gnutls.c (clear_storage): New function. (gnutls_symmetric_aead): Use it instead of memset. diff --git a/admin/merge-gnulib b/admin/merge-gnulib index 85921ba1ba..2b1a16a10e 100755 --- a/admin/merge-gnulib +++ b/admin/merge-gnulib @@ -30,7 +30,7 @@ GNULIB_MODULES=' careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 - diffseq dtoastr dtotimespec dup2 environ execinfo faccessat + diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c new file mode 100644 index 0000000000..262c68f9cd --- /dev/null +++ b/lib/explicit_bzero.c @@ -0,0 +1,48 @@ +/* Erasure of sensitive data, generic implementation. + Copyright (C) 2016-2017 Free Software Foundation, Inc. + This file is part of the GNU C Library. + + The GNU C Library 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. + + The GNU C Library 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 the GNU C Library; if not, see + . */ + +/* An assembler implementation of explicit_bzero can be created as an + assembler alias of an optimized bzero implementation. + Architecture-specific implementations also need to define + __explicit_bzero_chk. */ + +#if !_LIBC +# include +#endif + +#include + +/* glibc-internal users use __explicit_bzero_chk, and explicit_bzero + redirects to that. */ +#undef explicit_bzero + +/* Set LEN bytes of S to 0. The compiler will not delete a call to + this function, even if S is dead after the call. */ +void +explicit_bzero (void *s, size_t len) +{ +#ifdef HAVE_EXPLICIT_MEMSET + explicit_memset (s, 0, len); +#else + memset (s, '\0', len); +# ifdef __GNUC__ + /* Compiler barrier. */ + asm volatile ("" ::: "memory"); +# endif +#endif +} diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index ae5ae87a52..e20487b10b 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -21,7 +21,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings +# Reproduce by: gnulib-tool --import --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=build-aux --avoid=close --avoid=dup --avoid=fchdir --avoid=fstat --avoid=malloc-posix --avoid=msvc-inval --avoid=msvc-nothrow --avoid=open --avoid=openat-die --avoid=opendir --avoid=raise --avoid=save-cwd --avoid=select --avoid=setenv --avoid=sigprocmask --avoid=stat --avoid=stdarg --avoid=stdbool --avoid=threadlib --avoid=tzset --avoid=unsetenv --avoid=utime --avoid=utime-h --gnu-make --makefile-name=gnulib.mk.in --conditional-dependencies --no-libtool --macro-prefix=gl --no-vc-files alloca-opt binary-io byteswap c-ctype c-strcase careadlinkat close-stream count-leading-zeros count-one-bits count-trailing-zeros crypto/md5 crypto/sha1 crypto/sha256 crypto/sha512 diffseq dtoastr dtotimespec dup2 environ execinfo explicit_bzero faccessat fcntl fcntl-h fdatasync fdopendir filemode filevercmp flexmember fstatat fsync getloadavg getopt-gnu gettime gettimeofday gitlog-to-changelog ignore-value intprops largefile lstat manywarnings memrchr minmax mkostemp mktime pipe2 pselect pthread_sigmask putenv qcopy-acl readlink readlinkat sig2str socklen stat-time std-gnu11 stdalign stddef stdio stpcpy strftime strtoimax symlink sys_stat sys_time time time_r time_rz timegm timer-time timespec-add timespec-sub unlocked-io update-copyright utimens vla warnings MOSTLYCLEANFILES += core *.stackdump @@ -1358,6 +1358,17 @@ EXTRA_libgnu_a_SOURCES += execinfo.c endif ## end gnulib module execinfo +## begin gnulib module explicit_bzero +ifeq (,$(OMIT_GNULIB_MODULE_explicit_bzero)) + + +EXTRA_DIST += explicit_bzero.c + +EXTRA_libgnu_a_SOURCES += explicit_bzero.c + +endif +## end gnulib module explicit_bzero + ## begin gnulib module faccessat ifeq (,$(OMIT_GNULIB_MODULE_faccessat)) diff --git a/m4/explicit_bzero.m4 b/m4/explicit_bzero.m4 new file mode 100644 index 0000000000..f9dc678207 --- /dev/null +++ b/m4/explicit_bzero.m4 @@ -0,0 +1,22 @@ +dnl Copyright 2017 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_EXPLICIT_BZERO], +[ + AC_REQUIRE([gl_HEADER_STRING_H_DEFAULTS]) + + dnl Persuade glibc to declare explicit_bzero. + AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + + AC_CHECK_FUNCS_ONCE([explicit_bzero]) + if test $ac_cv_func_explicit_bzero = no; then + HAVE_EXPLICIT_BZERO=0 + fi +]) + +AC_DEFUN([gl_PREREQ_EXPLICIT_BZERO], +[ + AC_CHECK_FUNCS([explicit_memset]) +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 107645df4f..038d78aafe 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 @@ -72,6 +72,7 @@ AC_DEFUN([gl_EARLY], # Code from module errno: # Code from module euidaccess: # Code from module execinfo: + # Code from module explicit_bzero: # Code from module extensions: # Code from module extern-inline: # Code from module faccessat: @@ -210,6 +211,12 @@ AC_DEFUN([gl_INIT], gl_UNISTD_MODULE_INDICATOR([environ]) gl_HEADER_ERRNO_H gl_EXECINFO_H + gl_FUNC_EXPLICIT_BZERO + if test $HAVE_EXPLICIT_BZERO = 0; then + AC_LIBOBJ([explicit_bzero]) + gl_PREREQ_EXPLICIT_BZERO + fi + gl_STRING_MODULE_INDICATOR([explicit_bzero]) AC_REQUIRE([gl_EXTERN_INLINE]) gl_FUNC_FACCESSAT if test $HAVE_FACCESSAT = 0; then @@ -837,6 +844,7 @@ AC_DEFUN([gl_FILE_LIST], [ lib/euidaccess.c lib/execinfo.c lib/execinfo.in.h + lib/explicit_bzero.c lib/faccessat.c lib/fcntl.c lib/fcntl.in.h @@ -967,6 +975,7 @@ AC_DEFUN([gl_FILE_LIST], [ m4/errno_h.m4 m4/euidaccess.m4 m4/execinfo.m4 + m4/explicit_bzero.m4 m4/extensions.m4 m4/extern-inline.m4 m4/faccessat.m4 diff --git a/src/gnutls.c b/src/gnutls.c index e6f01a9cfe..7d19f90fbb 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1883,6 +1883,22 @@ The alist key is the cipher name. */) return ciphers; } +/* Zero out STORAGE (even if it will become inaccessible. It has + STORAGE_LENGTH bytes. The goal is to improve security a bit, in + case an Emacs module or some buggy part of Emacs attempts to + inspect STORAGE later to retrieve a secret. + + Calls to this function document when storage containing a secret is + known to go out of scope. This function is not guaranteed to erase + the secret, as copies of STORAGE may well be accessible elsewhere + on the machine. */ + +static void +clear_storage (void *storage, ptrdiff_t storage_length) +{ + explicit_bzero (storage, storage_length); +} + static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, @@ -1949,7 +1965,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, if (ret < GNUTLS_E_SUCCESS) { - memset (storage, 0, storage_length); + clear_storage (storage, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); if (encrypting) @@ -1963,7 +1979,7 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, gnutls_aead_cipher_deinit (acipher); Lisp_Object output = make_unibyte_string (storage, storage_length); - memset (storage, 0, storage_length); + clear_storage (storage, storage_length); SAFE_FREE (); return list2 (output, actual_iv); #else commit 252444aaa3a7cb9fc70289a5a3920f8a9d848109 Author: Paul Eggert Date: Sun Jul 16 16:22:33 2017 -0700 Merge from gnulib This incorporates: 2017-07-16 explicit_bzero: new module 2017-07-15 getdtablesize: Add minimal support for OpenVMS. * lib/getdtablesize.c, lib/string.in.h, m4/getdtablesize.m4: * m4/string_h.m4: Copy from Gnulib. * lib/gnulib.mk.in: Regenerate. diff --git a/lib/getdtablesize.c b/lib/getdtablesize.c index c356cf4aa9..a0928630fa 100644 --- a/lib/getdtablesize.c +++ b/lib/getdtablesize.c @@ -1,4 +1,4 @@ -/* getdtablesize() function for platforms that don't have it. +/* getdtablesize() function: Return maximum possible file descriptor value + 1. Copyright (C) 2008-2017 Free Software Foundation, Inc. Written by Bruno Haible , 2008. diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index fd0f9e5c78..ae5ae87a52 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in @@ -125,6 +125,7 @@ GNULIB_DUP2 = @GNULIB_DUP2@ GNULIB_DUP3 = @GNULIB_DUP3@ GNULIB_ENVIRON = @GNULIB_ENVIRON@ GNULIB_EUIDACCESS = @GNULIB_EUIDACCESS@ +GNULIB_EXPLICIT_BZERO = @GNULIB_EXPLICIT_BZERO@ GNULIB_FACCESSAT = @GNULIB_FACCESSAT@ GNULIB_FCHDIR = @GNULIB_FCHDIR@ GNULIB_FCHMODAT = @GNULIB_FCHMODAT@ @@ -390,6 +391,7 @@ HAVE_DPRINTF = @HAVE_DPRINTF@ HAVE_DUP2 = @HAVE_DUP2@ HAVE_DUP3 = @HAVE_DUP3@ HAVE_EUIDACCESS = @HAVE_EUIDACCESS@ +HAVE_EXPLICIT_BZERO = @HAVE_EXPLICIT_BZERO@ HAVE_FACCESSAT = @HAVE_FACCESSAT@ HAVE_FCHDIR = @HAVE_FCHDIR@ HAVE_FCHMODAT = @HAVE_FCHMODAT@ @@ -2411,6 +2413,7 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ -e 's|@''NEXT_STRING_H''@|$(NEXT_STRING_H)|g' \ + -e 's/@''GNULIB_EXPLICIT_BZERO''@/$(GNULIB_EXPLICIT_BZERO)/g' \ -e 's/@''GNULIB_FFSL''@/$(GNULIB_FFSL)/g' \ -e 's/@''GNULIB_FFSLL''@/$(GNULIB_FFSLL)/g' \ -e 's/@''GNULIB_MBSLEN''@/$(GNULIB_MBSLEN)/g' \ @@ -2449,7 +2452,8 @@ string.h: string.in.h $(top_builddir)/config.status $(CXXDEFS_H) $(ARG_NONNULL_H -e 's/@''GNULIB_STRSIGNAL''@/$(GNULIB_STRSIGNAL)/g' \ -e 's/@''GNULIB_STRVERSCMP''@/$(GNULIB_STRVERSCMP)/g' \ < $(srcdir)/string.in.h | \ - sed -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ + sed -e 's|@''HAVE_EXPLICIT_BZERO''@|$(HAVE_EXPLICIT_BZERO)|g' \ + -e 's|@''HAVE_FFSL''@|$(HAVE_FFSL)|g' \ -e 's|@''HAVE_FFSLL''@|$(HAVE_FFSLL)|g' \ -e 's|@''HAVE_MBSLEN''@|$(HAVE_MBSLEN)|g' \ -e 's|@''HAVE_MEMCHR''@|$(HAVE_MEMCHR)|g' \ diff --git a/lib/string.in.h b/lib/string.in.h index 9a6b311d00..aaff5638d0 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -74,6 +74,23 @@ /* The definition of _GL_WARN_ON_USE is copied here. */ +/* Clear a block of memory. The compiler will not delete a call to + this function, even if the block is dead after the call. */ +#if @GNULIB_EXPLICIT_BZERO@ +# if ! @HAVE_EXPLICIT_BZERO@ +_GL_FUNCDECL_SYS (explicit_bzero, void, + (void *__dest, size_t __n) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (explicit_bzero, void, (void *__dest, size_t __n)); +_GL_CXXALIASWARN (explicit_bzero); +#elif defined GNULIB_POSIXCHECK +# undef explicit_bzero +# if HAVE_RAW_DECL_EXPLICIT_BZERO +_GL_WARN_ON_USE (explicit_bzero, "explicit_bzero is unportable - " + "use gnulib module explicit_bzero for portability"); +# endif +#endif + /* Find the index of the least-significant set bit. */ #if @GNULIB_FFSL@ # if !@HAVE_FFSL@ diff --git a/m4/getdtablesize.m4 b/m4/getdtablesize.m4 index 1af2a2478f..f1e4f5f699 100644 --- a/m4/getdtablesize.m4 +++ b/m4/getdtablesize.m4 @@ -1,4 +1,4 @@ -# getdtablesize.m4 serial 6 +# getdtablesize.m4 serial 7 dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -12,29 +12,43 @@ AC_DEFUN([gl_FUNC_GETDTABLESIZE], AC_CHECK_DECLS_ONCE([getdtablesize]) if test $ac_cv_func_getdtablesize = yes && test $ac_cv_have_decl_getdtablesize = yes; then - # Cygwin 1.7.25 automatically increases the RLIMIT_NOFILE soft limit - # up to an unchangeable hard limit; all other platforms correctly - # require setrlimit before getdtablesize() can report a larger value. AC_CACHE_CHECK([whether getdtablesize works], [gl_cv_func_getdtablesize_works], - [AC_RUN_IFELSE([ - AC_LANG_PROGRAM([[#include ]], - [int size = getdtablesize(); - if (dup2 (0, getdtablesize()) != -1) - return 1; - if (size != getdtablesize()) - return 2; - ])], - [gl_cv_func_getdtablesize_works=yes], - [gl_cv_func_getdtablesize_works=no], - [case "$host_os" in - cygwin*) # on cygwin 1.5.25, getdtablesize() automatically grows - gl_cv_func_getdtablesize_works="guessing no" ;; - *) gl_cv_func_getdtablesize_works="guessing yes" ;; - esac]) + [dnl There are two concepts: the "maximum possible file descriptor value + 1" + dnl and the "maximum number of open file descriptors in a process". + dnl Per SUSv2 and POSIX, getdtablesize() should return the first one. + dnl On most platforms, the first and the second concept are the same. + dnl On OpenVMS, however, they are different and getdtablesize() returns + dnl the second one; thus the test below fails. But we don't care + dnl because there's no good way to write a replacement getdtablesize(). + case "$host_os" in + vms*) gl_cv_func_getdtablesize_works="no (limitation)" ;; + *) + dnl Cygwin 1.7.25 automatically increases the RLIMIT_NOFILE soft + dnl limit up to an unchangeable hard limit; all other platforms + dnl correctly require setrlimit before getdtablesize() can report + dnl a larger value. + AC_RUN_IFELSE([ + AC_LANG_PROGRAM([[#include ]], + [int size = getdtablesize(); + if (dup2 (0, getdtablesize()) != -1) + return 1; + if (size != getdtablesize()) + return 2; + ])], + [gl_cv_func_getdtablesize_works=yes], + [gl_cv_func_getdtablesize_works=no], + [case "$host_os" in + cygwin*) # on cygwin 1.5.25, getdtablesize() automatically grows + gl_cv_func_getdtablesize_works="guessing no" ;; + *) gl_cv_func_getdtablesize_works="guessing yes" ;; + esac + ]) + ;; + esac ]) case "$gl_cv_func_getdtablesize_works" in - *yes) ;; + *yes | "no (limitation)") ;; *) REPLACE_GETDTABLESIZE=1 ;; esac else diff --git a/m4/string_h.m4 b/m4/string_h.m4 index 3d2ad2219a..ac6311fba0 100644 --- a/m4/string_h.m4 +++ b/m4/string_h.m4 @@ -43,6 +43,7 @@ AC_DEFUN([gl_STRING_MODULE_INDICATOR], AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS], [ + GNULIB_EXPLICIT_BZERO=0; AC_SUBST([GNULIB_EXPLICIT_BZERO]) GNULIB_FFSL=0; AC_SUBST([GNULIB_FFSL]) GNULIB_FFSLL=0; AC_SUBST([GNULIB_FFSLL]) GNULIB_MEMCHR=0; AC_SUBST([GNULIB_MEMCHR]) @@ -82,6 +83,7 @@ AC_DEFUN([gl_HEADER_STRING_H_DEFAULTS], GNULIB_STRVERSCMP=0; AC_SUBST([GNULIB_STRVERSCMP]) HAVE_MBSLEN=0; AC_SUBST([HAVE_MBSLEN]) dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_EXPLICIT_BZERO=1; AC_SUBST([HAVE_EXPLICIT_BZERO]) HAVE_FFSL=1; AC_SUBST([HAVE_FFSL]) HAVE_FFSLL=1; AC_SUBST([HAVE_FFSLL]) HAVE_MEMCHR=1; AC_SUBST([HAVE_MEMCHR]) commit 7463636591ab3dedc739e9402a2fff756fef6f3e Author: Dieter Deyke Date: Mon Jul 17 02:08:30 2017 +0300 Fix vc-src-dir-status-files * lisp/vc/vc-src.el (vc-src-dir-status-files): Fix broken copy-paste from b1a765b3 (bug#27641). diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 5c8b3da6f1..0e47cc1512 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -180,7 +180,7 @@ For a description of possible values, see `vc-check-master-templates'." (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) 'RCS))) + (if (not files) (setq files (vc-expand-dirs (list dir) 'SRC))) (let ((result nil)) (dolist (file files) (let ((state (vc-state file)) commit 56da7add7845f0685dd6d5a1f7ae0a76cb2953da Author: Wilfred Hughes Date: Sun Jul 16 18:32:25 2017 +0100 Fix mismatched parens * etc/NEWS.21: Remove excess parenthesis in code example diff --git a/etc/NEWS.21 b/etc/NEWS.21 index 4a214cb3d2..9574a5d1df 100644 --- a/etc/NEWS.21 +++ b/etc/NEWS.21 @@ -3367,7 +3367,7 @@ be strings that are compared case-insensitively. (sxhash (upcase a))) (define-hash-table-test 'case-fold 'case-fold-string= - 'case-fold-string-hash)) + 'case-fold-string-hash) (make-hash-table :test 'case-fold) commit 45892db6f53cccc045da9c7215b467617c067f04 Author: Alan Third Date: Sun Jul 16 10:49:47 2017 +0100 Add missing declare-function for new function * lisp/frame.el: Add declare function for ns-mouse-absolute-pixel-position. diff --git a/lisp/frame.el b/lisp/frame.el index 1af12c7036..634367edf4 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1482,6 +1482,7 @@ FRAME." (declare-function w32-mouse-absolute-pixel-position "w32fns.c") (declare-function x-mouse-absolute-pixel-position "xfns.c") +(declare-function ns-mouse-absolute-pixel-position "nsfns.c") (defun mouse-absolute-pixel-position () "Return absolute position of mouse cursor in pixels. commit 7942679e3a5c599e5d3a287010ee134889ce6f83 Author: R. Bernstein Date: Sun Jul 16 03:51:28 2017 -0400 Realgud for tango themes diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index ba7484c8ce..91bda44286 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -140,6 +140,16 @@ Semantic, and Ansi-Color faces are included.") ;; Flyspell faces `(flyspell-duplicate ((,class (:underline ,orange-1)))) `(flyspell-incorrect ((,class (:underline ,red-1)))) + ;; Realgud + `(realgud-overlay-arrow1 ((,class (:foreground "green")))) + `(realgud-overlay-arrow2 ((,class (:foreground ,orange-1)))) + `(realgud-overlay-arrow3 ((,class (:foreground ,plum-0)))) + `(realgud-bp-disabled-face ((,class (:foreground ,blue-3)))) + `(realgud-bp-line-enabled-face ((,class (:underline "red")))) + `(realgud-bp-line-disabled-face ((,class (:underline ,blue-3)))) + `(realgud-file-name ((,class :foreground ,blue-1))) + `(realgud-line-number ((,class :foreground ,plum-0))) + `(realgud-backtrace-number ((,class :foreground ,plum-0 :weight bold))) ;; Semantic faces `(semantic-decoration-on-includes ((,class (:underline ,alum-4)))) `(semantic-decoration-on-private-members-face diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el index 50b8a964fb..9f7c0c2940 100644 --- a/etc/themes/tango-theme.el +++ b/etc/themes/tango-theme.el @@ -124,6 +124,16 @@ Semantic, and Ansi-Color faces are included.") ;; Flyspell `(flyspell-duplicate ((,class (:underline ,orange-1)))) `(flyspell-incorrect ((,class (:underline ,red-1)))) + ;; Realgud + `(realgud-overlay-arrow1 ((,class (:foreground "dark green")))) + `(realgud-overlay-arrow2 ((,class (:foreground "#7a4c02")))) + `(realgud-overlay-arrow3 ((,class (:foreground ,orange-1)))) + `(realgud-bp-disabled-face ((,class (:foreground ,plum-1)))) + `(realgud-bp-line-enabled-face ((,class (:underline "red")))) + `(realgud-bp-line-disabled-face ((,class (:underline ,plum-1)))) + `(realgud-file-name ((,class :foreground "dark green"))) + `(realgud-line-number ((,class :foreground ,blue-3))) + `(realgud-backtrace-number ((,class :foreground ,blue-3 :weight bold))) ;; Semantic faces `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) `(semantic-decoration-on-private-members-face commit 7a0fb008193960a7605e32bf0e72e8410e44f575 Author: Noam Postavsky Date: Sat Jul 15 12:12:17 2017 -0400 Fix test when running from test/lisp/subr-tests.elc * test/lisp/subr-tests.el (subr-test-backtrace-simple-tests): Don't assume a lambda expression will be `equal' to its quoted form. That's not true if the lambda expression has been compiled. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 54f4ab5d1b..7e50429a5b 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -258,9 +258,9 @@ This exercises `backtrace-frame', and indirectly `mapbacktrace'." (should (equal (mapbacktrace #'error unbound) nil))) ;; First frame is backtrace-related function (should (equal (backtrace-frame 0) '(t backtrace-frame 0))) - (should (equal (catch 'ret - (mapbacktrace (lambda (&rest args) (throw 'ret args)))) - '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil))) + (let ((throw-args (lambda (&rest args) (throw 'ret args)))) + (should (equal (catch 'ret (mapbacktrace throw-args)) + `(t mapbacktrace (,throw-args) nil)))) ;; Past-end NFRAMES is silently ignored (should (equal (backtrace-frame most-positive-fixnum) nil))) commit 30444c695ae4d1184c4b6bc994c00b7b1af5ab4a Author: Alan Third Date: Sat Jul 15 21:57:18 2017 +0100 Fix some frame handling issues on NS * lisp/frame.el (mouse-absolute-pixel-position): Use new NS function. * src/nsfns.m (Sns_mouse_absolute_pixel_position): New function. * src/nsterm.m (x_make_frame_visible): Re-establish parent-child relationship if it's broken. diff --git a/lisp/frame.el b/lisp/frame.el index 7d571791e2..1af12c7036 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1494,6 +1494,8 @@ position (0, 0) of the selected frame's terminal." (x-mouse-absolute-pixel-position)) ((eq frame-type 'w32) (w32-mouse-absolute-pixel-position)) + ((eq frame-type 'ns) + (ns-mouse-absolute-pixel-position)) (t (cons 0 0))))) diff --git a/src/nsfns.m b/src/nsfns.m index 68eba8b6a2..36748cebb8 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -3080,6 +3080,25 @@ value is a list of the form (LEFT, TOP, RIGHT, BOTTOM). All values are return Qnil; } +DEFUN ("ns-mouse-absolute-pixel-position", + Fns_mouse_absolute_pixel_position, + Sns_mouse_absolute_pixel_position, 0, 0, 0, + doc: /* Return absolute position of mouse cursor in pixels. +The position is returned as a cons cell (X . Y) of the +coordinates of the mouse cursor position in pixels relative to a +position (0, 0) of the selected frame's terminal. */) + (void) +{ + struct frame *f = SELECTED_FRAME (); + EmacsView *view = FRAME_NS_VIEW (f); + NSScreen *screen = [[view window] screen]; + NSPoint pt = [NSEvent mouseLocation]; + + return Fcons(make_number(pt.x - screen.frame.origin.x), + make_number(screen.frame.size.height - + (pt.y - screen.frame.origin.y))); +} + /* ========================================================================== Class implementations @@ -3269,6 +3288,7 @@ - (NSString *)panel: (id)sender userEnteredFilename: (NSString *)filename defsubr (&Sns_frame_list_z_order); defsubr (&Sns_frame_restack); defsubr (&Sns_set_mouse_absolute_pixel_position); + defsubr (&Sns_mouse_absolute_pixel_position); defsubr (&Sx_display_mm_width); defsubr (&Sx_display_mm_height); defsubr (&Sx_display_screens); diff --git a/src/nsterm.m b/src/nsterm.m index bf83550b3d..a3c7031331 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1570,6 +1570,7 @@ -(void)remove if (!FRAME_VISIBLE_P (f)) { EmacsView *view = (EmacsView *)FRAME_NS_VIEW (f); + NSWindow *window = [view window]; SET_FRAME_VISIBLE (f, 1); ns_raise_frame (f, ! FRAME_NO_FOCUS_ON_MAP (f)); @@ -1586,6 +1587,23 @@ -(void)remove [view handleFS]; unblock_input (); } + + /* Making a frame invisible seems to break the parent->child + relationship, so reinstate it. */ + if ([window parentWindow] == nil && FRAME_PARENT_FRAME (f) != NULL) + { + NSWindow *parent = [FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)) window]; + + block_input (); + [parent addChildWindow: window + ordered: NSWindowAbove]; + unblock_input (); + + /* If the parent frame moved while the child frame was + invisible, the child frame's position won't have been + updated. Make sure it's in the right place now. */ + x_set_offset(f, f->left_pos, f->top_pos, 0); + } } } commit 66683f46b877a8c2baa5fdedfb332618a1973db5 Author: Tino Calancha Date: Sun Jul 16 00:30:56 2017 +0900 ls-lisp: Fix file size format * lisp/ls-lisp.el (ls-lisp-filesize-d-fmt, ls-lisp-filesize-f-fmt) (ls-lisp-filesize-b-fmt): Add space in front (Bug#27693). * test/lisp/dired-tests.el (dired-test-bug27693): Add test. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 7ae2343441..b368efbbc9 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -245,11 +245,11 @@ to fail to line up, e.g. if month names are not all of the same length." "Format to display integer GIDs.") (defvar ls-lisp-gid-s-fmt " %s" "Format to display user group names.") -(defvar ls-lisp-filesize-d-fmt "%d" +(defvar ls-lisp-filesize-d-fmt " %d" "Format to display integer file sizes.") -(defvar ls-lisp-filesize-f-fmt "%.0f" +(defvar ls-lisp-filesize-f-fmt " %.0f" "Format to display float file sizes.") -(defvar ls-lisp-filesize-b-fmt "%.0f" +(defvar ls-lisp-filesize-b-fmt " %.0f" "Format to display file sizes in blocks (for the -s switch).") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 1b814baac5..208e1c2509 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -84,5 +84,17 @@ (advice-remove 'dired-query "advice-dired-query") (advice-remove 'completing-read "advice-completing-read")))) +(ert-deftest dired-test-bug27693 () + "Test for http://debbugs.gnu.org/27693 ." + (require 'ls-lisp) + (let ((size "") + ls-lisp-use-insert-directory-program) + (dired (list (expand-file-name "lisp" source-directory) "simple.el" "subr.el")) + (setq size (number-to-string + (file-attribute-size + (file-attributes (dired-get-filename))))) + (search-backward-regexp size nil t) + (should (looking-back "[[:space:]]" (1- (point)))))) + (provide 'dired-tests) ;; dired-tests.el ends here commit b30ee0c9225bad6e3fd0b511a6c5d9a64b8fd66a Author: Eli Zaretskii Date: Sat Jul 15 16:54:12 2017 +0300 Avoid link errors with older versions of GnuTLS * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead) (Fgnutls_macs, Fgnutls_digests): Conditionally compile code that calls GnuTLS functions which might be unavailable in older versions of GnuTLS. diff --git a/src/gnutls.c b/src/gnutls.c index 5e14a3af33..e6f01a9cfe 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1852,6 +1852,7 @@ The alist key is the cipher name. */) { Lisp_Object ciphers = Qnil; +#ifdef HAVE_GNUTLS3_CIPHER const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { @@ -1877,6 +1878,7 @@ The alist key is the cipher name. */) ciphers = Fcons (cp, ciphers); } +#endif return ciphers; } @@ -2176,6 +2178,7 @@ name. */) (void) { Lisp_Object mac_algorithms = Qnil; +#ifdef HAVE_GNUTLS3_HMAC const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { @@ -2197,6 +2200,7 @@ name. */) make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); } +#endif return mac_algorithms; } @@ -2210,6 +2214,7 @@ method name. */) (void) { Lisp_Object digest_algorithms = Qnil; +#ifdef HAVE_GNUTLS3_DIGEST const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { @@ -2226,6 +2231,7 @@ method name. */) digest_algorithms = Fcons (mp, digest_algorithms); } +#endif return digest_algorithms; } commit a5c4ffdb6e1fe37c5c060b4a4181e5ee79f71ec6 Author: Eli Zaretskii Date: Sat Jul 15 15:34:03 2017 +0300 Improve comments in faces.el * lisp/faces.el (face-font-family-alternatives): Improve commentary. diff --git a/lisp/faces.el b/lisp/faces.el index c3693d1663..97c32165b9 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -102,11 +102,16 @@ a font height that isn't optimal." ;; Monospace Serif is an Emacs invention, intended to work around ;; portability problems when using Courier. It should work well ;; when combined with Monospaced and with other standard fonts. + ;; One of its uses is for 'tex-verbatim' and 'Info-quoted' faces, + ;; so the result must be different from the default face's font, + ;; and must be monospaced. ("Monospace Serif" ;; This looks good on GNU/Linux. "Courier 10 Pitch" - ;; This looks good on MS-Windows and OS X. + ;; This looks good on MS-Windows and OS X. Note that this is + ;; actually a sans-serif font, but it's here for lack of a better + ;; alternative. "Consolas" ;; This looks good on macOS. "Courier" looks good too, but is ;; jagged on GNU/Linux and so is listed later as "courier". commit cc78d5339ce8b9c2c5bf38b89fa9ea3ba748fdd4 Author: Eli Zaretskii Date: Sat Jul 15 14:41:44 2017 +0300 Improve some GnuTL error messages * src/gnutls.c (gnutls_symmetric_aead, gnutls_symmetric): * src/fns.c (Fsecure_hash_algorithms): Fix error messages. diff --git a/src/fns.c b/src/fns.c index fb1296bc6f..d849618f2b 100644 --- a/src/fns.c +++ b/src/fns.c @@ -4931,7 +4931,7 @@ extract_data_from_object (Lisp_Object spec, /* Format: (iv-auto REQUIRED-LENGTH). */ if (! NATNUMP (start)) - error ("Without a length, iv-auto can't be used. See manual."); + error ("Without a length, `iv-auto' can't be used; see ELisp manual"); else { EMACS_INT start_hold = XFASTINT (start); @@ -4942,7 +4942,7 @@ extract_data_from_object (Lisp_Object spec, *end_byte = start_hold; } #else - error ("GnuTLS integration is not available, so iv-auto can't be used."); + error ("GnuTLS is not available, so `iv-auto' can't be used"); #endif } diff --git a/src/gnutls.c b/src/gnutls.c index 7dff0a4cdd..5e14a3af33 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -1950,8 +1950,12 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, memset (storage, 0, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); - error ("GnuTLS AEAD cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + if (encrypting) + error ("GnuTLS AEAD cipher %s encryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + else + error ("GnuTLS AEAD cipher %s decryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); } gnutls_aead_cipher_deinit (acipher); @@ -2096,8 +2100,12 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (ret < GNUTLS_E_SUCCESS) { gnutls_cipher_deinit (hcipher); - error ("GnuTLS cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + if (encrypting) + error ("GnuTLS cipher %s encryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); + else + error ("GnuTLS cipher %s decryption failed: %s", + gnutls_cipher_get_name (gca), emacs_gnutls_strerror (ret)); } gnutls_cipher_deinit (hcipher); commit 1f161104ce4e275b056b5987976f9f2adb421221 Author: Eli Zaretskii Date: Sat Jul 15 14:28:43 2017 +0300 Fix the Elisp manual wrt GnuTL cryptography * doc/lispref/elisp.texi (Top): Update the master menu. * doc/lispref/text.texi (GnuTLS Cryptography): Add a @menu, to avoid errors in makeinfo. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 4bedea3bdd..f30d9f95e2 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1196,6 +1196,7 @@ Text * Decompression:: Dealing with compressed data. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. +* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. * Parsing HTML/XML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes atomically. * Change Hooks:: Supplying functions to be run when text is changed. diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index fd6ddc98fe..7108520e79 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -4521,6 +4521,11 @@ Please consult @uref{https://www.gnutls.org/} for specific documentation which may help you understand the terminology and structure of the GnuTLS library. +@menu +* Format of GnuTLS Cryptography Inputs:: +* GnuTLS Cryptographic Functions:: +@end menu + @node Format of GnuTLS Cryptography Inputs @subsection Format of GnuTLS Cryptography Inputs @cindex format of gnutls cryptography inputs commit 178e0df2c283fa00f0aa8df0e321b846d3d8d47f Author: Eli Zaretskii Date: Sat Jul 15 14:03:44 2017 +0300 Fix compilation of gnutls.c with older GnuTLS * src/gnutrls.c (syms_of_gnutls): Condition some defsubr's on HAVE_GNUTLS3, to avoid compilation errors when GnuTLS v3.X is not available. Reported by Colin Baxter . diff --git a/src/gnutls.c b/src/gnutls.c index 0fc5d90c3a..7dff0a4cdd 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -2518,6 +2518,7 @@ syms_of_gnutls (void) defsubr (&Sgnutls_peer_status); defsubr (&Sgnutls_peer_status_warning_describe); +#ifdef HAVE_GNUTLS3 defsubr (&Sgnutls_ciphers); defsubr (&Sgnutls_macs); defsubr (&Sgnutls_digests); @@ -2525,6 +2526,7 @@ syms_of_gnutls (void) defsubr (&Sgnutls_hash_digest); defsubr (&Sgnutls_symmetric_encrypt); defsubr (&Sgnutls_symmetric_decrypt); +#endif DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, doc: /* Logging level used by the GnuTLS functions. commit 011dfceae38164348079c5dcf198407811554fef Author: rocky Date: Sat Jul 15 05:23:43 2017 -0400 Realgud for two more light themes diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index c15bd41bf8..6ec0316365 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el @@ -4,7 +4,7 @@ ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> ;; URL: https://github.com/fniessen/emacs-leuven-theme -;; Version: 20140929.1232 +;; Version: 20170715.0521 ;; Keywords: color theme ;; This file is part of GNU Emacs. @@ -600,6 +600,15 @@ Semantic, and Ansi-Color faces are included -- and much more...") `(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070")))) `(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched))) `(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched))) + `(realgud-overlay-arrow1 ((,class (:foreground "#005522")))) + `(realgud-overlay-arrow2 ((,class (:foreground "#c18401")))) + `(realgud-overlay-arrow3 ((,class (:foreground "#909183")))) + `(realgud-bp-disabled-face ((,class (:foreground "#909183")))) + `(realgud-bp-line-enabled-face ((,class (:underline "red")))) + `(realgud-bp-line-disabled-face ((,class (:underline "#909183")))) + `(realgud-file-name ((,class :foreground "#005522"))) + `(realgud-line-number ((,class :foreground "#A535AE"))) + `(realgud-backtrace-number ((,class :foreground "#A535AE" :weight bold))) `(recover-this-file ((,class (:weight bold :background "#FF3F3F")))) `(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4")))) `(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE")))) diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el index e8174803e2..8498fe2bc9 100644 --- a/etc/themes/tsdh-light-theme.el +++ b/etc/themes/tsdh-light-theme.el @@ -90,6 +90,15 @@ Used and created by Tassilo Horn.") '(outline-7 ((t (:inherit font-lock-builtin-face :weight bold)))) '(outline-8 ((t (:inherit font-lock-string-face :weight bold)))) '(rcirc-my-nick ((t (:foreground "LightSkyBlue" :weight bold)))) + '(realgud-overlay-arrow1 ((t (:foreground "dark green")))) + '(realgud-overlay-arrow2 ((t (:foreground "#c18401")))) + '(realgud-overlay-arrow3 ((t (:foreground "gray60")))) + '(realgud-bp-disabled-face ((t (:foreground "gray60")))) + '(realgud-bp-line-enabled-face ((t (:underline "red")))) + '(realgud-bp-line-disabled-face ((t (:underline "gray60")))) + '(realgud-file-name ((t :foreground "dark green"))) + '(realgud-line-number ((t :foreground "#0184bc"))) + '(realgud-backtrace-number ((t :foreground "#0184bc" :weight bold))) '(region ((t (:background "lightgoldenrod1")))) '(show-paren-match ((t (:background "Cyan1" :weight bold)))) '(show-paren-mismatch ((t (:background "deep pink" :weight bold)))) commit d23f38e31d0adf102526b5b4291a20581418b8eb Author: Eli Zaretskii Date: Sat Jul 15 11:33:22 2017 +0300 Rearrange MS-Windows code that dynamically loads GnuTLS functions * src/gnutls.c [WINDOWSNT]: Reorganize definitions and loading of functions using the same preprocessing directives as in the code. diff --git a/src/gnutls.c b/src/gnutls.c index deffbd4b05..0fc5d90c3a 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -172,8 +172,14 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); -# if (GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3) +# ifdef HAVE_GNUTLS3 DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); +DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); +DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); +DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +# ifdef HAVE_GNUTLS3_CIPHER DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); @@ -182,6 +188,13 @@ DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); DEF_DLL_FN (int, gnutls_cipher_init, (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *, const gnutls_datum_t *)); +DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); +DEF_DLL_FN (int, gnutls_cipher_encrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_cipher_decrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +# ifdef HAVE_GNUTLS3_AEAD DEF_DLL_FN (int, gnutls_aead_cipher_init, (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, const gnutls_datum_t *)); @@ -192,30 +205,25 @@ DEF_DLL_FN (int, gnutls_aead_cipher_encrypt, DEF_DLL_FN (int, gnutls_aead_cipher_decrypt, (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, size_t, size_t, const void *, size_t, void *, size_t *)); -DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); -DEF_DLL_FN (int, gnutls_cipher_encrypt2, - (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); -DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); -DEF_DLL_FN (int, gnutls_cipher_decrypt2, - (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); -DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); -DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); -DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); -DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); -DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +# endif /* HAVE_GNUTLS3_AEAD */ +# ifdef HAVE_GNUTLS3_HMAC DEF_DLL_FN (int, gnutls_hmac_init, (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); -DEF_DLL_FN (int, gnutls_hash_init, - (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *)); +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST + DEF_DLL_FN (int, gnutls_hash_init, + (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); -# endif +# endif /* HAVE_GNUTLS3_DIGEST */ +# endif /* HAVE_GNUTLS3 */ static bool @@ -301,38 +309,46 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_get_name); LOAD_DLL_FN (library, gnutls_mac_get); LOAD_DLL_FN (library, gnutls_mac_get_name); -# if GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3 +# ifdef HAVE_GNUTLS3 LOAD_DLL_FN (library, gnutls_rnd); + LOAD_DLL_FN (library, gnutls_mac_list); + LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); + LOAD_DLL_FN (library, gnutls_mac_get_key_size); + LOAD_DLL_FN (library, gnutls_digest_list); + LOAD_DLL_FN (library, gnutls_digest_get_name); +# ifdef HAVE_GNUTLS3_CIPHER LOAD_DLL_FN (library, gnutls_cipher_list); LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); LOAD_DLL_FN (library, gnutls_cipher_get_key_size); LOAD_DLL_FN (library, gnutls_cipher_get_block_size); LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); LOAD_DLL_FN (library, gnutls_cipher_init); - LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); - LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); - LOAD_DLL_FN (library, gnutls_aead_cipher_init); - LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); LOAD_DLL_FN (library, gnutls_cipher_set_iv); LOAD_DLL_FN (library, gnutls_cipher_encrypt2); - LOAD_DLL_FN (library, gnutls_cipher_decrypt2); LOAD_DLL_FN (library, gnutls_cipher_deinit); - LOAD_DLL_FN (library, gnutls_mac_list); - LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); - LOAD_DLL_FN (library, gnutls_mac_get_key_size); - LOAD_DLL_FN (library, gnutls_digest_list); - LOAD_DLL_FN (library, gnutls_digest_get_name); + LOAD_DLL_FN (library, gnutls_cipher_decrypt2); +# ifdef HAVE_GNUTLS3_AEAD + LOAD_DLL_FN (library, gnutls_aead_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); + LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); +# endif +# ifdef HAVE_GNUTLS3_HMAC LOAD_DLL_FN (library, gnutls_hmac_init); LOAD_DLL_FN (library, gnutls_hmac_get_len); LOAD_DLL_FN (library, gnutls_hmac); LOAD_DLL_FN (library, gnutls_hmac_deinit); LOAD_DLL_FN (library, gnutls_hmac_output); +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST LOAD_DLL_FN (library, gnutls_hash_init); LOAD_DLL_FN (library, gnutls_hash_get_len); LOAD_DLL_FN (library, gnutls_hash); LOAD_DLL_FN (library, gnutls_hash_deinit); LOAD_DLL_FN (library, gnutls_hash_output); -# endif +# endif +# endif /* HAVE_GNUTLS3 */ max_log_level = global_gnutls_log_level; @@ -410,36 +426,46 @@ init_gnutls_functions (void) # define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version # define gnutls_x509_crt_import fn_gnutls_x509_crt_import # define gnutls_x509_crt_init fn_gnutls_x509_crt_init +# ifdef HAVE_GNUTLS3 # define gnutls_rnd fn_gnutls_rnd +# define gnutls_mac_list fn_gnutls_mac_list +# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size +# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size +# define gnutls_digest_list fn_gnutls_digest_list +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# ifdef HAVE_GNUTLS3_CIPHER # define gnutls_cipher_list fn_gnutls_cipher_list # define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size # define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size # define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size # define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size # define gnutls_cipher_init fn_gnutls_cipher_init -# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt -# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt -# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init -# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit # define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv # define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 # define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 # define gnutls_cipher_deinit fn_gnutls_cipher_deinit -# define gnutls_mac_list fn_gnutls_mac_list -# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size -# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size -# define gnutls_digest_list fn_gnutls_digest_list -# define gnutls_digest_get_name fn_gnutls_digest_get_name +# ifdef HAVE_GNUTLS3_AEAD +# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt +# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt +# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init +# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit +# endif /* HAVE_GNUTLS3_AEAD */ +# ifdef HAVE_GNUTLS3_HMAC # define gnutls_hmac_init fn_gnutls_hmac_init # define gnutls_hmac_get_len fn_gnutls_hmac_get_len # define gnutls_hmac fn_gnutls_hmac # define gnutls_hmac_deinit fn_gnutls_hmac_deinit # define gnutls_hmac_output fn_gnutls_hmac_output +# endif /* HAVE_GNUTLS3_HMAC */ +# endif /* HAVE_GNUTLS3_CIPHER */ +# ifdef HAVE_GNUTLS3_DIGEST # define gnutls_hash_init fn_gnutls_hash_init # define gnutls_hash_get_len fn_gnutls_hash_get_len # define gnutls_hash fn_gnutls_hash # define gnutls_hash_deinit fn_gnutls_hash_deinit # define gnutls_hash_output fn_gnutls_hash_output +# endif +# endif /* HAVE_GNUTLS3 */ /* This wrapper is called from fns.c, which doesn't know about the LOAD_DLL_FN stuff above. */ commit 55d65682ab81ee6e7ca12f4902a6f8799782cd23 Author: Eli Zaretskii Date: Sat Jul 15 10:43:38 2017 +0300 Fix the MS-Windows build broken in gnutls.c * src/gnutls.c (Fgnutls_available_p) [WINDOWSNT]: Move the DLL loading code to after 'capabilities' has been calculated. Remove redundant comments. diff --git a/src/gnutls.c b/src/gnutls.c index 5717b3075c..deffbd4b05 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -449,7 +449,7 @@ w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len) return gnutls_rnd (level, data, len); } -#endif +#endif /* WINDOWSNT */ /* Report memory exhaustion if ERR is an out-of-memory indication. */ @@ -549,7 +549,7 @@ emacs_gnutls_nonblock_errno (gnutls_transport_ptr_t ptr) return err; } } -#endif +#endif /* !WINDOWSNT */ static int emacs_gnutls_handshake (struct Lisp_Process *proc) @@ -2359,7 +2359,7 @@ the number itself. */) return digest; } -#endif +#endif /* HAVE_GNUTLS3 */ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. @@ -2372,20 +2372,6 @@ GnuTLS symmetric ciphers: the list will contain `ciphers'. GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) (void) { -#ifdef WINDOWSNT - Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); - if (CONSP (found)) - return XCDR (found); /* TODO: use capabilities. */ - else - { - Lisp_Object status; - /* TODO: should the capabilities be dynamic here? */ - status = init_gnutls_functions () ? capabilities : Qnil; - Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); - return status; - } -#else - Lisp_Object capabilities = Qnil; # ifdef HAVE_GNUTLS3 @@ -2405,10 +2391,24 @@ GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) # ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); # endif -# endif -# endif +# endif /* HAVE_GNUTLS3_CIPHER */ +# endif /* HAVE_GNUTLS3 */ + +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); + else + { + Lisp_Object status; + status = init_gnutls_functions () ? capabilities : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); + return status; + } +#else /* !WINDOWSNT */ return capabilities; + #endif } commit 511fe21b88f7468a5232434b556f886fa985a5aa Author: Lars Ingebrigtsen Date: Sat Jul 15 03:21:07 2017 +0200 src/image.c (compute_image_size): Remove superfluous checks. * src/image.c (compute_image_size): Remove superfluous checks. diff --git a/src/image.c b/src/image.c index 69a529e8c3..76a19a68b0 100644 --- a/src/image.c +++ b/src/image.c @@ -8129,10 +8129,10 @@ compute_image_size (size_t width, size_t height, width = width * scale; height = height * scale; - if (desired_width != -1 && desired_height == -1) + if (desired_width != -1) /* Width known, calculate height. */ desired_height = scale_image_size (desired_width, width, height); - else if (desired_width == -1 && desired_height != -1) + else if (desired_height != -1) /* Height known, calculate width. */ desired_width = scale_image_size (desired_height, height, width); else commit ae56c9674b4668ded392c66d46aa22db902ddd71 Author: Lars Ingebrigtsen Date: Sat Jul 15 02:45:19 2017 +0200 Make combinations of :width/:max-height image specs work reliably * doc/lispref/display.texi (ImageMagick Images): Document :width/:max-height combinations (etc) (bug #25583). * src/image.c (compute_image_size): Handle :width/:max-height (etc) combinations consistently (by letting "max" win and preserve ratio). * test/manual/image-size-tests.el (image-size-tests): Add tests for :width/:max-height (etc) combinations. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 005d31af05..98940cbc99 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -5305,6 +5305,17 @@ and if @code{:height} is set it will have precedence over wish. @code{:max-width} and @code{:max-height} will always preserve the aspect ratio. +If both @code{:width} and @code{:max-height} has been set (but +@code{:height} has not been set), then @code{:max-height} will have +precedence. The same is the case for the opposite combination: The +``max'' keyword has precedence. That is, if you have a 200x100 image +and specify that @code{:width} should be 400 and @code{:max-height} +should be 150, you'll end up with an image that is 300x150: Preserving +the aspect ratio and not exceeding the ``max'' setting. This +combination of parameters is a useful way of saying ``display this +image as large as possible, but no larger than the available display +area''. + @item :scale @var{scale} This should be a number, where values higher than 1 means to increase the size, and lower means to decrease the size. For instance, a value diff --git a/etc/NEWS b/etc/NEWS index 0ab49587d7..edb71118ef 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -762,6 +762,14 @@ Ido mode is active. 'image-scaling-factor' variable (if Emacs supports scaling the images in question). ++++ +*** It's now possible to specify aspect-ratio preserving combinations +of :width/:max-height and :height/:max-width keywords. In either +case, the "max" keywords win. (Previously some combinations would, +depending on the aspect ratio of the image, just be ignored and in +other instances this would lead to the aspect ratio not being +preserved.) + +++ *** Images inserted with 'insert-image' and related functions get a keymap put into the text properties (or overlays) that span the diff --git a/src/image.c b/src/image.c index 1426e30944..69a529e8c3 100644 --- a/src/image.c +++ b/src/image.c @@ -8086,83 +8086,76 @@ compute_image_size (size_t width, size_t height, int *d_width, int *d_height) { Lisp_Object value; - int desired_width, desired_height; + int desired_width = -1, desired_height = -1, max_width = -1, max_height = -1; double scale = 1; value = image_spec_value (spec, QCscale, NULL); if (NUMBERP (value)) scale = XFLOATINT (value); + value = image_spec_value (spec, QCmax_width, NULL); + if (NATNUMP (value)) + max_width = min (XFASTINT (value), INT_MAX); + + value = image_spec_value (spec, QCmax_height, NULL); + if (NATNUMP (value)) + max_height = min (XFASTINT (value), INT_MAX); + /* If width and/or height is set in the display spec assume we want to scale to those values. If either h or w is unspecified, the unspecified should be calculated from the specified to preserve aspect ratio. */ value = image_spec_value (spec, QCwidth, NULL); - desired_width = NATNUMP (value) ? - min (XFASTINT (value) * scale, INT_MAX) : -1; - value = image_spec_value (spec, QCheight, NULL); - desired_height = NATNUMP (value) ? - min (XFASTINT (value) * scale, INT_MAX) : -1; - - width = width * scale; - height = height * scale; - - if (desired_width == -1) + if (NATNUMP (value)) { - value = image_spec_value (spec, QCmax_width, NULL); - if (NATNUMP (value)) - { - int max_width = min (XFASTINT (value), INT_MAX); - if (max_width < width) - { - /* The image is wider than :max-width. */ - desired_width = max_width; - if (desired_height == -1) - { - desired_height = scale_image_size (desired_width, - width, height); - value = image_spec_value (spec, QCmax_height, NULL); - if (NATNUMP (value)) - { - int max_height = min (XFASTINT (value), INT_MAX); - if (max_height < desired_height) - { - desired_height = max_height; - desired_width = scale_image_size (desired_height, - height, width); - } - } - } - } - } + desired_width = min (XFASTINT (value) * scale, INT_MAX); + /* :width overrides :max-width. */ + max_width = -1; } - if (desired_height == -1) + value = image_spec_value (spec, QCheight, NULL); + if (NATNUMP (value)) { - value = image_spec_value (spec, QCmax_height, NULL); - if (NATNUMP (value)) - { - int max_height = min (XFASTINT (value), INT_MAX); - if (max_height < height) - desired_height = max_height; - } + desired_height = min (XFASTINT (value) * scale, INT_MAX); + /* :height overrides :max-height. */ + max_height = -1; } + /* If we have both width/height set explicitly, we skip past all the + aspect ratio-preserving computations below. */ + if (desired_width != -1 && desired_height != -1) + goto out; + + width = width * scale; + height = height * scale; + if (desired_width != -1 && desired_height == -1) - /* w known, calculate h. */ + /* Width known, calculate height. */ desired_height = scale_image_size (desired_width, width, height); - - if (desired_width == -1 && desired_height != -1) - /* h known, calculate w. */ + else if (desired_width == -1 && desired_height != -1) + /* Height known, calculate width. */ desired_width = scale_image_size (desired_height, height, width); - - /* We have no width/height settings, so just apply the scale. */ - if (desired_width == -1 && desired_height == -1) + else { desired_width = width; desired_height = height; } + if (max_width != -1 && desired_width > max_width) + { + /* The image is wider than :max-width. */ + desired_width = max_width; + desired_height = scale_image_size (desired_width, width, height); + } + + if (max_height != -1 && desired_height > max_height) + { + /* The image is higher than :max-height. */ + desired_height = max_height; + desired_width = scale_image_size (desired_height, height, width); + } + + out: *d_width = desired_width; *d_height = desired_height; } diff --git a/test/manual/image-size-tests.el b/test/manual/image-size-tests.el index 577c765879..6721e348e1 100644 --- a/test/manual/image-size-tests.el +++ b/test/manual/image-size-tests.el @@ -25,8 +25,8 @@ (defmacro im-should (image width height &rest props) `(let ((im (im-image ,image ,@props))) (unless (im-compare im ,width ,height) - (error "%s didn't succeed; size is %s" - ',props (image-size im t))))) + (error "%s %s didn't succeed; size is %s" + ',image ',props (image-size im t))))) (defun im-image (type &rest props) (let ((image-scaling-factor 1)) @@ -67,6 +67,9 @@ ;; Both max-width/height. (im-should :w 100 50 :max-width 100 :max-height 75) (im-should :w 50 25 :max-width 100 :max-height 25) + ;; :width and :max-height (max-height wins). + (im-should :w 400 200 :width 400 :max-height 200) + (im-should :w 400 200 :width 500 :max-height 200) ;; Test the image that's taller than it is wide. (im-should :h 100 200) @@ -87,6 +90,9 @@ ;; Both max-width/height. (im-should :h 50 100 :max-width 75 :max-height 100) (im-should :h 25 50 :max-width 25 :max-height 100) + ;; :hieght and :max-width (max-width wins). + (im-should :h 200 400 :height 400 :max-width 200) + (im-should :h 200 400 :height 500 :max-width 200) ) ;;; image-size-tests.el ends here commit 89c5d59280edaf89b959597a39d848b54c36975a Author: Glenn Morris Date: Fri Jul 14 19:46:44 2017 -0400 Fix recent theme changes * etc/themes/manoj-dark-theme.el, etc/themes/tsdh-dark-theme.el: Fix typos in recent changes. diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el index bbfeb83d53..9b461cc5e6 100644 --- a/etc/themes/manoj-dark-theme.el +++ b/etc/themes/manoj-dark-theme.el @@ -602,18 +602,16 @@ jarring angry fruit salad look to reduce eye fatigue.") '(paren-no-match-face ((t (:bold t :background "white" :foreground "red")))) '(query-replace ((t (:foreground "brown4" :background "palevioletred2")))) '(region ((t (:background "blue3")))) - - `(realgud-overlay-arrow1 ((t (:foreground "medium sea green")))) - `(realgud-overlay-arrow2 ((t (:foreground "white")))) - `(realgud-overlay-arrow3 ((t (:foreground "indian red")))) - `(realgud-bp-enabled-face ((t (:inherit error)))) - `(realgud-bp-disabled-face ((t (:underline t)))) - `(realgud-bp-line-enabled-face ((t (:foreground "orange")))) - `(realgud-bp-line-disabled-face ((t (:underline t)))) - `(realgud-file-name ((t (:foreground "cyan")))) - `(realgud-line-number ((t (:foreground "yellow")))) - `(realgud-backtrace-number ((t (:foreground "yellow" :weight bold)))))) - + '(realgud-overlay-arrow1 ((t (:foreground "medium sea green")))) + '(realgud-overlay-arrow2 ((t (:foreground "white")))) + '(realgud-overlay-arrow3 ((t (:foreground "indian red")))) + '(realgud-bp-enabled-face ((t (:inherit error)))) + '(realgud-bp-disabled-face ((t (:underline t)))) + '(realgud-bp-line-enabled-face ((t (:foreground "orange")))) + '(realgud-bp-line-disabled-face ((t (:underline t)))) + '(realgud-file-name ((t (:foreground "cyan")))) + '(realgud-line-number ((t (:foreground "yellow")))) + '(realgud-backtrace-number ((t (:foreground "yellow" :weight bold)))) '(scroll-bar ((t (:background "grey75" :foreground "WhiteSmoke")))) '(secondary-selection ((t (:background "SkyBlue4")))) '(semantic-dirty-token-face ((t (:background "lightyellow")))) diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el index 4f48854d44..3890fe0010 100644 --- a/etc/themes/tsdh-dark-theme.el +++ b/etc/themes/tsdh-dark-theme.el @@ -118,16 +118,16 @@ '(outline-6 ((t (:foreground "light salmon" :weight bold)))) '(outline-7 ((t (:foreground "pale goldenrod" :weight bold)))) '(outline-8 ((t (:foreground "OliveDrab1" :weight bold)))) - `(realgud-overlay-arrow1 ((t (:foreground "medium spring green")))) - `(realgud-overlay-arrow2 ((t (:foreground "OliveDrab1")))) - `(realgud-overlay-arrow3 ((t (:foreground "light salmon")))) - `(realgud-bp-enabled-face ((t (:inherit error)))) - `(realgud-bp-disabled-face ((t (:foreground "gray35")))) - `(realgud-bp-line-enabled-face ((t (:foreground "light salmon")))) - `(realgud-bp-line-disabled-face ((t (:foreground "medium spring green")))) - `(realgud-file-name ((t (:foreground "dark khaki")))) - `(realgud-line-number ((t (:foreground "cyan3")))) - `(realgud-backtrace-number ((t (:foreground "cyan3" :weight bold)))))) + '(realgud-overlay-arrow1 ((t (:foreground "medium spring green")))) + '(realgud-overlay-arrow2 ((t (:foreground "OliveDrab1")))) + '(realgud-overlay-arrow3 ((t (:foreground "light salmon")))) + '(realgud-bp-enabled-face ((t (:inherit error)))) + '(realgud-bp-disabled-face ((t (:foreground "gray35")))) + '(realgud-bp-line-enabled-face ((t (:foreground "light salmon")))) + '(realgud-bp-line-disabled-face ((t (:foreground "medium spring green")))) + '(realgud-file-name ((t (:foreground "dark khaki")))) + '(realgud-line-number ((t (:foreground "cyan3")))) + '(realgud-backtrace-number ((t (:foreground "cyan3" :weight bold)))) '(rcirc-my-nick ((t (:foreground "SpringGreen1" :weight bold))) t) '(rcirc-other-nick ((t (:foreground "dodger blue"))) t) '(rcirc-track-keyword ((t (:foreground "DodgerBlue" :weight bold))) t) commit 05b8b866993b957f5fd575846cf8ea3035e60f7e Author: Paul Eggert Date: Fri Jul 14 16:18:37 2017 -0700 GnuTLS integer-overflow and style fixes This tweaks the recently-added GnuTLS improvements so that they avoid some integer-overflow problems and follow typical Emacs style a bit better. * configure.ac (HAVE_GNUTLS3_HMAC, HAVE_GNUTLS3_AEAD) (HAVE_GNUTLS3_CIPHER): Use AC_CACHE_CHECK so that the configure-time results are displayed. * src/fns.c (extract_data_from_object): Return char *, not char const *, since one gnutls caller wants a non-const pointer. Use CONSP rather than !NILP when testing for conses. Use CAR_SAFE instead of rolling our own code. Prefer signed types to unsigned when either will do. Report problems for lengths out of range, instead of silently mishandling them. * src/gnutls.c (emacs_gnutls_strerror): New function, to simplify callers. All callers of gnutls_sterror changed. (Fgnutls_boot): Check for integers out of range rather than silently truncating them. (gnutls_symmetric_aead): Check for integer overflow in size calculations. (gnutls_symmetric_aead, Fgnutls_macs, Fgnutls_digests): Prefer signed to unsigned integers where either will do. (gnutls_symmetric_aead, gnutls_symmetric): Work even if ptrdiff_t is wider than ‘long’. (gnutls_symmetric, Fgnutls_hash_mac, Fgnutls_hash_digest): Check for integer overflow in algorithm selection. diff --git a/configure.ac b/configure.ac index 525aa51598..056c8c35c5 100644 --- a/configure.ac +++ b/configure.ac @@ -2832,60 +2832,86 @@ if test "${with_gnutls}" = "yes" ; then EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0], [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], []) - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include -#include -]], -[[ -int main (int argc, char **argv) -{ - gnutls_hmac_hd_t handle; - gnutls_hmac_deinit(handle, NULL); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_HMAC, 1, [Define if using GnuTLS v3 with HMAC support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include -#include -]], -[[ -int main (int argc, char **argv) -{ - gnutls_aead_cipher_hd_t handle; - gnutls_aead_cipher_deinit(handle); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include -#include -]], -[[ -int main (int argc, char **argv) -{ - gnutls_cipher_hd_t handle; - gnutls_cipher_encrypt2 (handle, - NULL, 0, - NULL, 0); - gnutls_cipher_deinit(handle); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_CIPHER, 1, [Define if using GnuTLS v3 with cipher support.])]) - - AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ -#include -#include -]], -[[ -int main (int argc, char **argv) -{ - gnutls_hash_hd_t handle; - gnutls_hash_deinit(handle, NULL); -} -]])], - [AC_DEFINE(HAVE_GNUTLS3_DIGEST, 1, [Define if using GnuTLS v3 with digest support.])]) + AC_CACHE_CHECK([for GnuTLS v3 with HMAC], [emacs_cv_gnutls3_hmac], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + #include + ]], [[ + int + main (void) + { + gnutls_hmac_hd_t handle; + gnutls_hmac_deinit (handle, NULL); + } + ]])], + [emacs_cv_gnutls3_hmac=yes], + [emacs_cv_gnutls3_hmac=no])]) + if test "$emacs_cv_gnutls3_hmac" = yes; then + AC_DEFINE([HAVE_GNUTLS3_HMAC], [1], + [Define if using GnuTLS v3 with HMAC support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with AEAD], [emacs_cv_gnutls3_aead], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + #include + ]], [[ + int + main (void) + { + gnutls_aead_cipher_hd_t handle; + gnutls_aead_cipher_deinit (handle); + } + ]])], + [emacs_cv_gnutls3_aead=yes], + [emacs_cv_gnutls3_aead=no])]) + if test "$emacs_cv_gnutls3_aead" = yes; then + AC_DEFINE([HAVE_GNUTLS3_AEAD], [1], + [Define if using GnuTLS v3 with AEAD support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with cipher], [emacs_cv_gnutls3_cipher], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + #include + ]], [[ + int + main (void) + { + gnutls_cipher_hd_t handle; + gnutls_cipher_encrypt2 (handle, NULL, 0, NULL, 0); + gnutls_cipher_deinit (handle); + } + ]])], + [emacs_cv_gnutls3_cipher=yes], + [emacs_cv_gnutls3_cipher=no])]) + if test "$emacs_cv_gnutls3_cipher" = yes; then + AC_DEFINE([HAVE_GNUTLS3_CIPHER], [1], + [Define if using GnuTLS v3 with cipher support.]) + fi + + AC_CACHE_CHECK([for GnuTLS v3 with digest], [emacs_cv_gnutls3_digest], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + #include + #include + ]], [[ + int + main (void) + { + gnutls_hash_hd_t handle; + gnutls_hash_deinit (handle, NULL); + } + ]])], + [emacs_cv_gnutls3_digest=yes], + [emacs_cv_gnutls3_digest=no])]) + if test "$emacs_cv_gnutls3_digest" = yes; then + AC_DEFINE([HAVE_GNUTLS3_DIGEST], [1], + [Define if using GnuTLS v3 with digest support.]) + fi fi # Windows loads GnuTLS dynamically diff --git a/src/fns.c b/src/fns.c index b678a482bb..fb1296bc6f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -46,10 +46,6 @@ static void sort_vector_copy (Lisp_Object, ptrdiff_t, enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); -static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, - Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, - Lisp_Object binary); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */ @@ -4767,29 +4763,24 @@ DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, (BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as specified with `secure-hash' and in Info node `(elisp)Format of GnuTLS Cryptography Inputs'. */ -const char* +char * extract_data_from_object (Lisp_Object spec, ptrdiff_t *start_byte, ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, end_char = 0; - register EMACS_INT b, e; - register struct buffer *bp; - EMACS_INT temp; + Lisp_Object object = XCAR (spec); - Lisp_Object object = XCAR (spec); + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object start = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object end = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object coding_system = CAR_SAFE (spec); - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil; - - if (! NILP (spec)) spec = XCDR (spec); - Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil; + if (CONSP (spec)) spec = XCDR (spec); + Lisp_Object noerror = CAR_SAFE (spec); if (STRINGP (object)) { @@ -4817,7 +4808,7 @@ extract_data_from_object (Lisp_Object spec, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 1); - size = SCHARS (object); + ptrdiff_t size = SCHARS (object), start_char, end_char; validate_subarray (object, start, end, size, &start_char, &end_char); *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); @@ -4828,12 +4819,13 @@ extract_data_from_object (Lisp_Object spec, else if (BUFFERP (object)) { struct buffer *prev = current_buffer; + EMACS_INT b, e; record_unwind_current_buffer (); CHECK_BUFFER (object); - bp = XBUFFER (object); + struct buffer *bp = XBUFFER (object); set_buffer_internal (bp); if (NILP (start)) @@ -4853,7 +4845,11 @@ extract_data_from_object (Lisp_Object spec, } if (b > e) - temp = b, b = e, e = temp; + { + EMACS_INT temp = b; + b = e; + e = temp; + } if (!(BEGV <= b && e <= ZV)) args_out_of_range (start, end); @@ -4932,14 +4928,13 @@ extract_data_from_object (Lisp_Object spec, else if (EQ (object, Qiv_auto)) { #ifdef HAVE_GNUTLS3 - // Format: (iv-auto REQUIRED-LENGTH) + /* Format: (iv-auto REQUIRED-LENGTH). */ - if (! INTEGERP (start)) + if (! NATNUMP (start)) error ("Without a length, iv-auto can't be used. See manual."); else { - /* Make sure the value of "start" doesn't change. */ - size_t start_hold = XUINT (start); + EMACS_INT start_hold = XFASTINT (start); object = make_uninit_string (start_hold); gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); @@ -4971,7 +4966,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object spec = list5 (object, start, end, coding_system, noerror); - const char* input = extract_data_from_object (spec, &start_byte, &end_byte); + const char *input = extract_data_from_object (spec, &start_byte, &end_byte); if (input == NULL) error ("secure_hash: failed to extract data from object, aborting!"); diff --git a/src/gnutls.c b/src/gnutls.c index 761fe7df3a..5717b3075c 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -672,6 +672,13 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte) } } +static char const * +emacs_gnutls_strerror (int err) +{ + char const *str = gnutls_strerror (err); + return str ? str : "unknown"; +} + /* Report a GnuTLS error to the user. Return true if the error code was successfully handled. */ static bool @@ -680,7 +687,6 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) int max_log_level = 0; bool ret; - const char *str; /* TODO: use a Lisp_Object generated by gnutls_make_error? */ if (err >= 0) @@ -692,9 +698,7 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) /* TODO: use gnutls-error-fatalp and gnutls-error-string. */ - str = gnutls_strerror (err); - if (!str) - str = "unknown"; + char const *str = emacs_gnutls_strerror (err); if (gnutls_error_is_fatal (err)) { @@ -708,11 +712,11 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err) #endif GNUTLS_LOG2 (level, max_log_level, "fatal error:", str); - ret = 0; + ret = false; } else { - ret = 1; + ret = true; switch (err) { @@ -900,7 +904,7 @@ usage: (gnutls-error-string ERROR) */) if (! TYPE_RANGED_INTEGERP (int, err)) return build_string ("Not an error symbol or code"); - return build_string (gnutls_strerror (XINT (err))); + return build_string (emacs_gnutls_strerror (XINT (err))); } DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, @@ -1592,9 +1596,9 @@ one trustfile (usually a CA bundle). */) XPROCESS (proc)->gnutls_x509_cred = x509_cred; verify_flags = Fplist_get (proplist, QCverify_flags); - if (NUMBERP (verify_flags)) + if (TYPE_RANGED_INTEGERP (unsigned int, verify_flags)) { - gnutls_verify_flags = XINT (verify_flags); + gnutls_verify_flags = XFASTINT (verify_flags); GNUTLS_LOG (2, max_log_level, "setting verification flags"); } else if (NILP (verify_flags)) @@ -1818,39 +1822,32 @@ This function may also return `gnutls-e-again', or DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. The alist key is the cipher name. */) - (void) + (void) { Lisp_Object ciphers = Qnil; - const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list (); - for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + const gnutls_cipher_algorithm_t *gciphers = gnutls_cipher_list (); + for (ptrdiff_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) { - const gnutls_cipher_algorithm_t gca = gciphers[pos]; - - Lisp_Object cp = listn (CONSTYPE_HEAP, 15, - /* A symbol representing the cipher */ - intern (gnutls_cipher_get_name (gca)), - /* The internally meaningful cipher ID */ - QCcipher_id, - make_number (gca), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_cipher, - /* The tag size (nonzero means AEAD). */ - QCcipher_aead_capable, - (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt, - /* The tag size (nonzero means AEAD). */ - QCcipher_tagsize, - make_number (gnutls_cipher_get_tag_size (gca)), - /* The block size */ - QCcipher_blocksize, - make_number (gnutls_cipher_get_block_size (gca)), - /* The key size */ - QCcipher_keysize, - make_number (gnutls_cipher_get_key_size (gca)), - /* IV size */ - QCcipher_ivsize, - make_number (gnutls_cipher_get_iv_size (gca))); + gnutls_cipher_algorithm_t gca = gciphers[pos]; + Lisp_Object cipher_symbol = intern (gnutls_cipher_get_name (gca)); + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); + + Lisp_Object cp + = listn (CONSTYPE_HEAP, 15, cipher_symbol, + QCcipher_id, make_number (gca), + QCtype, Qgnutls_type_cipher, + QCcipher_aead_capable, cipher_tag_size == 0 ? Qnil : Qt, + QCcipher_tagsize, make_number (cipher_tag_size), + + QCcipher_blocksize, + make_number (gnutls_cipher_get_block_size (gca)), + + QCcipher_keysize, + make_number (gnutls_cipher_get_key_size (gca)), + + QCcipher_ivsize, + make_number (gnutls_cipher_get_iv_size (gca))); ciphers = Fcons (cp, ciphers); } @@ -1861,36 +1858,35 @@ The alist key is the cipher name. */) static Lisp_Object gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, Lisp_Object cipher, - const char* kdata, size_t ksize, - const char* vdata, size_t vsize, - const char* idata, size_t isize, + const char *kdata, ptrdiff_t ksize, + const char *vdata, ptrdiff_t vsize, + const char *idata, ptrdiff_t isize, Lisp_Object aead_auth) { #ifdef HAVE_GNUTLS3_AEAD - const char* desc = (encrypting ? "encrypt" : "decrypt"); - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); gnutls_aead_cipher_hd_t acipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize }; - ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); + gnutls_datum_t key_datum = { (unsigned char *) kdata, ksize }; + int ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } - - size_t storage_length = isize + gnutls_cipher_get_tag_size (gca); + error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); + + ptrdiff_t cipher_tag_size = gnutls_cipher_get_tag_size (gca); + ptrdiff_t tagged_size; + if (INT_ADD_WRAPV (isize, cipher_tag_size, &tagged_size) + || SIZE_MAX < tagged_size) + memory_full (SIZE_MAX); + size_t storage_length = tagged_size; USE_SAFE_ALLOCA; - unsigned char *storage = SAFE_ALLOCA (storage_length); + char *storage = SAFE_ALLOCA (storage_length); - const char* aead_auth_data = NULL; - size_t aead_auth_size = 0; + const char *aead_auth_data = NULL; + ptrdiff_t aead_auth_size = 0; if (!NILP (aead_auth)) { @@ -1900,8 +1896,8 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, CHECK_CONS (aead_auth); ptrdiff_t astart_byte, aend_byte; - const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); - + const char *adata + = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); if (adata == NULL) error ("GnuTLS AEAD cipher auth extraction failed"); @@ -1909,53 +1905,38 @@ gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, aead_auth_size = aend_byte - astart_byte; } - size_t expected_remainder = 0; - - if (!encrypting) - expected_remainder = gnutls_cipher_get_tag_size (gca); + ptrdiff_t expected_remainder = encrypting ? 0 : cipher_tag_size; + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); - if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a " - "multiple of the required %ld plus the expected tag remainder %ld", + if (isize < expected_remainder + || (isize - expected_remainder) % cipher_block_size != 0) + error (("GnuTLS AEAD cipher %s/%s input block length %"pD"d " + "is not %"pD"d greater than a multiple of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - (long) isize, (long) gnutls_cipher_get_block_size (gca), - (long) expected_remainder); - - if (encrypting) - ret = gnutls_aead_cipher_encrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); - else - ret = gnutls_aead_cipher_decrypt (acipher, - vdata, vsize, - aead_auth_data, aead_auth_size, - gnutls_cipher_get_tag_size (gca), - idata, isize, - storage, &storage_length); + isize, expected_remainder, cipher_block_size); + + ret = ((encrypting ? gnutls_aead_cipher_encrypt : gnutls_aead_cipher_decrypt) + (acipher, vdata, vsize, aead_auth_data, aead_auth_size, + cipher_tag_size, idata, isize, storage, &storage_length)); if (ret < GNUTLS_E_SUCCESS) { memset (storage, 0, storage_length); SAFE_FREE (); gnutls_aead_cipher_deinit (acipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS AEAD cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_aead_cipher_deinit (acipher); - Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length); + Lisp_Object output = make_unibyte_string (storage, storage_length); memset (storage, 0, storage_length); SAFE_FREE (); return list2 (output, actual_iv); #else - error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca); + printmax_t print_gca = gca; + error ("GnuTLS AEAD cipher %"pMd" is invalid or not found", print_gca); #endif } @@ -1980,9 +1961,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, CHECK_CONS (iv); - const char* desc = (encrypting ? "encrypt" : "decrypt"); - - int ret = GNUTLS_E_SUCCESS; + const char *desc = encrypting ? "encrypt" : "decrypt"; gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; @@ -1992,7 +1971,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (SYMBOLP (cipher)) info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); - else if (INTEGERP (cipher)) + else if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, cipher)) gca = XINT (cipher); else info = cipher; @@ -2000,41 +1979,44 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCcipher_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_cipher_algorithm_t, v)) gca = XINT (v); } - if (gca == GNUTLS_CIPHER_UNKNOWN) - error ("GnuTLS cipher was invalid or not found"); + ptrdiff_t key_size = gnutls_cipher_get_key_size (gca); + if (key_size == 0) + error ("GnuTLS cipher is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS cipher key extraction failed"); - if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) - error ("GnuTLS cipher %s/%s key length %" pD "d was not equal to " - "the required %ld", + if (kend_byte - kstart_byte != key_size) + error (("GnuTLS cipher %s/%s key length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + kend_byte - kstart_byte, key_size); ptrdiff_t vstart_byte, vend_byte; - const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); + char *vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); if (vdata == NULL) error ("GnuTLS cipher IV extraction failed"); - if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) - error ("GnuTLS cipher %s/%s IV length %" pD "d was not equal to " - "the required %ld", + ptrdiff_t iv_size = gnutls_cipher_get_iv_size (gca); + if (vend_byte - vstart_byte != iv_size) + error (("GnuTLS cipher %s/%s IV length %"pD"d is not equal to " + "the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + vend_byte - vstart_byte, iv_size); Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS cipher input extraction failed"); @@ -2053,44 +2035,34 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return aead_output; } - if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS cipher %s/%s input block length %" pD "d was not a multiple " - "of the required %ld", + ptrdiff_t cipher_block_size = gnutls_cipher_get_block_size (gca); + if ((iend_byte - istart_byte) % cipher_block_size != 0) + error (("GnuTLS cipher %s/%s input block length %"pD"d is not a multiple " + "of the required %"pD"d"), gnutls_cipher_get_name (gca), desc, - iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + iend_byte - istart_byte, cipher_block_size); gnutls_cipher_hd_t hcipher; - gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + gnutls_datum_t key_datum + = { (unsigned char *) kdata, kend_byte - kstart_byte }; - ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); + int ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS cipher %s/%s initialization failed: %s", - gnutls_cipher_get_name (gca), desc, str); - } + error ("GnuTLS cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); /* Note that this will not support streaming block mode. */ - gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte); + gnutls_cipher_set_iv (hcipher, vdata, vend_byte - vstart_byte); - /* - * GnuTLS docs: "For the supported ciphers the encrypted data length - * will equal the plaintext size." - */ - size_t storage_length = iend_byte - istart_byte; + /* GnuTLS docs: "For the supported ciphers the encrypted data length + will equal the plaintext size." */ + ptrdiff_t storage_length = iend_byte - istart_byte; Lisp_Object storage = make_uninit_string (storage_length); - if (encrypting) - ret = gnutls_cipher_encrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); - else - ret = gnutls_cipher_decrypt2 (hcipher, - idata, iend_byte - istart_byte, - SSDATA (storage), storage_length); + ret = ((encrypting ? gnutls_cipher_encrypt2 : gnutls_cipher_decrypt2) + (hcipher, idata, iend_byte - istart_byte, + SSDATA (storage), storage_length)); if (STRINGP (XCAR (key))) Fclear_string (XCAR (key)); @@ -2098,11 +2070,8 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, if (ret < GNUTLS_E_SUCCESS) { gnutls_cipher_deinit (hcipher); - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS cipher %s %sion failed: %s", - gnutls_cipher_get_name (gca), desc, str); + gnutls_cipher_get_name (gca), desc, emacs_gnutls_strerror (ret)); } gnutls_cipher_deinit (hcipher); @@ -2110,41 +2079,46 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, return list2 (storage, actual_iv); } -DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, + Sgnutls_symmetric_encrypt, 4, 5, 0, doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or -a plist with the `:cipher-id' numeric property, or the number itself. +a plist with the :cipher-id numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); } -DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0, +DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, + Sgnutls_symmetric_decrypt, 4, 5, 0, doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. -The IV and INPUT and the optional AEAD_AUTH can be -specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). +The IV and INPUT and the optional AEAD_AUTH can be specified as a +buffer or string or in other ways (see Info node `(elisp)Format of +GnuTLS Cryptography Inputs'). The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. The CIPHER may be a string or symbol matching a key in that alist, or @@ -2153,7 +2127,8 @@ a plist with the `:cipher-id' numeric property, or the number itself. AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with :cipher-aead-capable set to t. AEAD_AUTH can be supplied for these AEAD ciphers, but it may still be omitted (nil) as well. */) - (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) { return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); } @@ -2164,32 +2139,26 @@ DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-mac'. The alist key is the mac-algorithm method name. */) - (void) + (void) { Lisp_Object mac_algorithms = Qnil; - const gnutls_mac_algorithm_t* macs = gnutls_mac_list (); - for (size_t pos = 0; macs[pos] != 0; pos++) + const gnutls_mac_algorithm_t *macs = gnutls_mac_list (); + for (ptrdiff_t pos = 0; macs[pos] != 0; pos++) { const gnutls_mac_algorithm_t gma = macs[pos]; - const char* name = gnutls_mac_get_name (gma); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 11, - /* A symbol representing the mac-algorithm. */ - intern (name), - /* The internally meaningful mac-algorithm ID. */ - QCmac_algorithm_id, - make_number (gma), - /* The type (vs. other GnuTLS objects). */ - QCtype, - Qgnutls_type_mac_algorithm, - /* The output length. */ + const char *name = gnutls_mac_get_name (gma); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, intern (name), + QCmac_algorithm_id, make_number (gma), + QCtype, Qgnutls_type_mac_algorithm, + QCmac_algorithm_length, make_number (gnutls_hmac_get_len (gma)), - /* The key size. */ + QCmac_algorithm_keysize, make_number (gnutls_mac_get_key_size (gma)), - /* The nonce size. */ + QCmac_algorithm_noncesize, make_number (gnutls_mac_get_nonce_size (gma))); mac_algorithms = Fcons (mp, mac_algorithms); @@ -2204,25 +2173,20 @@ DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, Use the value of the alist (extract it with `alist-get' for instance) with `gnutls-hash-digest'. The alist key is the digest-algorithm method name. */) - (void) + (void) { Lisp_Object digest_algorithms = Qnil; - const gnutls_digest_algorithm_t* digests = gnutls_digest_list (); - for (size_t pos = 0; digests[pos] != 0; pos++) + const gnutls_digest_algorithm_t *digests = gnutls_digest_list (); + for (ptrdiff_t pos = 0; digests[pos] != 0; pos++) { const gnutls_digest_algorithm_t gda = digests[pos]; - const char* name = gnutls_digest_get_name (gda); - - Lisp_Object mp = listn (CONSTYPE_HEAP, 7, - /* A symbol representing the digest-algorithm. */ - intern (name), - /* The internally meaningful digest-algorithm ID. */ - QCdigest_algorithm_id, - make_number (gda), - QCtype, - Qgnutls_type_digest_algorithm, - /* The digest length. */ + const char *name = gnutls_digest_get_name (gda); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, intern (name), + QCdigest_algorithm_id, make_number (gda), + QCtype, Qgnutls_type_digest_algorithm, + QCdigest_algorithm_length, make_number (gnutls_hash_get_len (gda))); @@ -2235,11 +2199,11 @@ method name. */) DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0, doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string. -Returns nil on error. +Return nil on error. -The KEY can be specified as a buffer or string or in other ways -(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be -wiped after use if it's a string. +The KEY can be specified as a buffer or string or in other ways (see +Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY +will be wiped after use if it's a string. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2248,7 +2212,7 @@ The alist of MAC algorithms can be obtained with `gnutls-macs`. The HASH-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:mac-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) + (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); @@ -2260,8 +2224,6 @@ itself. */) CHECK_CONS (key); - int ret = GNUTLS_E_SUCCESS; - gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; Lisp_Object info = Qnil; @@ -2270,7 +2232,7 @@ itself. */) if (SYMBOLP (hash_method)) info = XCDR (Fassq (hash_method, Fgnutls_macs ())); - else if (INTEGERP (hash_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, hash_method)) gma = XINT (hash_method); else info = hash_method; @@ -2278,37 +2240,32 @@ itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_mac_algorithm_t, v)) gma = XINT (v); } - if (gma == GNUTLS_MAC_UNKNOWN) - error ("GnuTLS MAC-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hmac_get_len (gma); + if (digest_length == 0) + error ("GnuTLS MAC-method is invalid or not found"); ptrdiff_t kstart_byte, kend_byte; - const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); - gnutls_hmac_hd_t hmac; - ret = gnutls_hmac_init (&hmac, gma, - kdata + kstart_byte, kend_byte - kstart_byte); - + const char *kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); if (kdata == NULL) error ("GnuTLS MAC key extraction failed"); + gnutls_hmac_hd_t hmac; + int ret = gnutls_hmac_init (&hmac, gma, + kdata + kstart_byte, kend_byte - kstart_byte); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS MAC %s initialization failed: %s", - gnutls_mac_get_name (gma), str); - } + error ("GnuTLS MAC %s initialization failed: %s", + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS MAC input extraction failed"); - size_t digest_length = gnutls_hmac_get_len (gma); Lisp_Object digest = make_uninit_string (digest_length); ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte); @@ -2319,12 +2276,8 @@ itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hmac_deinit (hmac, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; error ("GnuTLS MAC %s application failed: %s", - gnutls_mac_get_name (gma), str); + gnutls_mac_get_name (gma), emacs_gnutls_strerror (ret)); } gnutls_hmac_output (hmac, SSDATA (digest)); @@ -2336,7 +2289,7 @@ itself. */) DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. -Returns nil on error. +Return nil on error. The INPUT can be specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). @@ -2345,15 +2298,13 @@ The alist of digest algorithms can be obtained with `gnutls-digests`. The DIGEST-METHOD may be a string or symbol matching a key in that alist, or a plist with the `:digest-algorithm-id' numeric property, or the number itself. */) - (Lisp_Object digest_method, Lisp_Object input) + (Lisp_Object digest_method, Lisp_Object input) { if (BUFFERP (input) || STRINGP (input)) input = list1 (input); CHECK_CONS (input); - int ret = GNUTLS_E_SUCCESS; - gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN; Lisp_Object info = Qnil; @@ -2362,7 +2313,7 @@ the number itself. */) if (SYMBOLP (digest_method)) info = XCDR (Fassq (digest_method, Fgnutls_digests ())); - else if (INTEGERP (digest_method)) + else if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, digest_method)) gda = XINT (digest_method); else info = digest_method; @@ -2370,29 +2321,26 @@ the number itself. */) if (!NILP (info) && CONSP (info)) { Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); - if (INTEGERP (v)) + if (TYPE_RANGED_INTEGERP (gnutls_digest_algorithm_t, v)) gda = XINT (v); } - if (gda == GNUTLS_DIG_UNKNOWN) - error ("GnuTLS digest-method was invalid or not found"); + ptrdiff_t digest_length = gnutls_hash_get_len (gda); + if (digest_length == 0) + error ("GnuTLS digest-method is invalid or not found"); gnutls_hash_hd_t hash; - ret = gnutls_hash_init (&hash, gda); + int ret = gnutls_hash_init (&hash, gda); if (ret < GNUTLS_E_SUCCESS) - { - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest initialization failed: %s", str); - } + error ("GnuTLS digest initialization failed: %s", + emacs_gnutls_strerror (ret)); - size_t digest_length = gnutls_hash_get_len (gda); Lisp_Object digest = make_uninit_string (digest_length); ptrdiff_t istart_byte, iend_byte; - const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + const char *idata + = extract_data_from_object (input, &istart_byte, &iend_byte); if (idata == NULL) error ("GnuTLS digest input extraction failed"); @@ -2401,11 +2349,8 @@ the number itself. */) if (ret < GNUTLS_E_SUCCESS) { gnutls_hash_deinit (hash, NULL); - - const char* str = gnutls_strerror (ret); - if (!str) - str = "unknown"; - error ("GnuTLS digest application failed: %s", str); + error ("GnuTLS digest application failed: %s", + emacs_gnutls_strerror (ret)); } gnutls_hash_output (hash, SSDATA (digest)); @@ -2420,57 +2365,51 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. ...if supported : then... -GnuTLS 3 or higher : the list will contain 'gnutls3. -GnuTLS MACs : the list will contain 'macs. -GnuTLS digests : the list will contain 'digests. -GnuTLS symmetric ciphers: the list will contain 'ciphers. -GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */) - (void) +GnuTLS 3 or higher : the list will contain `gnutls3'. +GnuTLS MACs : the list will contain `macs'. +GnuTLS digests : the list will contain `digests'. +GnuTLS symmetric ciphers: the list will contain `ciphers'. +GnuTLS AEAD ciphers : the list will contain `AEAD-ciphers'. */) + (void) { -#ifdef HAVE_GNUTLS - Lisp_Object capabilities = Qnil; +#ifdef WINDOWSNT + Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); + if (CONSP (found)) + return XCDR (found); /* TODO: use capabilities. */ + else + { + Lisp_Object status; + /* TODO: should the capabilities be dynamic here? */ + status = init_gnutls_functions () ? capabilities : Qnil; + Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); + return status; + } +#else -#ifdef HAVE_GNUTLS3 + Lisp_Object capabilities = Qnil; +# ifdef HAVE_GNUTLS3 capabilities = Fcons (intern("gnutls3"), capabilities); -#ifdef HAVE_GNUTLS3_DIGEST +# ifdef HAVE_GNUTLS3_DIGEST capabilities = Fcons (intern("digests"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_CIPHER +# ifdef HAVE_GNUTLS3_CIPHER capabilities = Fcons (intern("ciphers"), capabilities); -#ifdef HAVE_GNUTLS3_AEAD +# ifdef HAVE_GNUTLS3_AEAD capabilities = Fcons (intern("AEAD-ciphers"), capabilities); -#endif +# endif -#ifdef HAVE_GNUTLS3_HMAC +# ifdef HAVE_GNUTLS3_HMAC capabilities = Fcons (intern("macs"), capabilities); -#endif - -#endif - -#endif +# endif +# endif +# endif -# ifdef WINDOWSNT - Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); - if (CONSP (found)) - return XCDR (found); // TODO: use capabilities. - else - { - Lisp_Object status; - // TODO: should the capabilities be dynamic here? - status = init_gnutls_functions () ? capabilities : Qnil; - Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); - return status; - } -# else /* !WINDOWSNT */ return capabilities; -# endif /* !WINDOWSNT */ -#else /* !HAVE_GNUTLS */ - return Qnil; -#endif /* !HAVE_GNUTLS */ +#endif } void diff --git a/src/lisp.h b/src/lisp.h index a5134a9532..9464bf8559 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,9 +3386,7 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); -extern const char* extract_data_from_object (Lisp_Object spec, - ptrdiff_t *start_byte, - ptrdiff_t *end_byte); +extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, commit 8b64a80a56c0e15d3313a45022ae60b33dbb4bff Author: Noam Postavsky Date: Sat Jun 3 23:57:26 2017 -0400 * .gitlab-ci.yml: Don't install a C++ compiler. Suppress apt interaction. diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 9b25ead37f..5fcd54fd94 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -28,7 +28,7 @@ image: debian:unstable before_script: - apt update -qq - - apt install -y -qq build-essential autoconf automake libncurses-dev gnutls-dev + - DEBIAN_FRONTEND=noninteractive apt install --no-install-recommends -y -qq -o=Dpkg::Use-Pty=0 libc-dev gcc make autoconf automake libncurses-dev gnutls-dev stages: - test commit 389fb2aebf01fb786e5b18ab87953c90c15279ff Author: Eli Zaretskii Date: Fri Jul 14 22:00:55 2017 +0300 Fix the MS-Windows build due to added GnuTLS functions * src/gnutls.c [WINDOWSNT]: Add DEF_DLL_FN for new functions. (init_gnutls_functions) [WINDOWSNT]: Add LOAD_DLL_FN for new functions. Add #define redirections for new functions. (gnutls_symmetric_aead): Fix format specs to be more portable when printing ptrdiff_t arguments. * src/fns.c (gnutls_rnd) [WINDOWSNT]: Redirect to w32_gnutls_rnd wrapper. * src/gnutls.h [WINDOWSNT]: Add prototype for w32_gnutls_rnd. * test/lisp/net/gnutls-tests.el (gnutls-tests-tested-macs) (gnutls-tests-tested-digests, gnutls-tests-tested-ciphers): Call gnutls-available-p, otherwise GnuTLS functions might not be loaded from the DLL on MS-Windows. diff --git a/src/fns.c b/src/fns.c index 8b7fc0f89d..b678a482bb 100644 --- a/src/fns.c +++ b/src/fns.c @@ -37,6 +37,10 @@ along with GNU Emacs. If not, see . */ #include "puresize.h" #include "gnutls.h" +#ifdef WINDOWSNT +# define gnutls_rnd w32_gnutls_rnd +#endif + static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; diff --git a/src/gnutls.c b/src/gnutls.c index 7a4e92f0d3..761fe7df3a 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -172,6 +172,51 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name, DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t)); DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t)); +# if (GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3) +DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t)); +DEF_DLL_FN (gnutls_cipher_algorithm_t *, gnutls_cipher_list, (void)); +DEF_DLL_FN (int, gnutls_cipher_get_iv_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_cipher_get_key_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_get_block_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_get_tag_size, (gnutls_cipher_algorithm_t)); +DEF_DLL_FN (int, gnutls_cipher_init, + (gnutls_cipher_hd_t *, gnutls_cipher_algorithm_t, + const gnutls_datum_t *, const gnutls_datum_t *)); +DEF_DLL_FN (int, gnutls_aead_cipher_init, + (gnutls_aead_cipher_hd_t *, gnutls_cipher_algorithm_t, + const gnutls_datum_t *)); +DEF_DLL_FN (void, gnutls_aead_cipher_deinit, (gnutls_aead_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_aead_cipher_encrypt, + (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, + size_t, size_t, const void *, size_t, void *, size_t *)); +DEF_DLL_FN (int, gnutls_aead_cipher_decrypt, + (gnutls_aead_cipher_hd_t, const void *, size_t, const void *, + size_t, size_t, const void *, size_t, void *, size_t *)); +DEF_DLL_FN (void, gnutls_cipher_set_iv, (gnutls_cipher_hd_t, void *, size_t)); +DEF_DLL_FN (int, gnutls_cipher_encrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (void, gnutls_cipher_deinit, (gnutls_cipher_hd_t)); +DEF_DLL_FN (int, gnutls_cipher_decrypt2, + (gnutls_cipher_hd_t, const void *, size_t, void *, size_t)); +DEF_DLL_FN (const gnutls_mac_algorithm_t *, gnutls_mac_list, (void)); +DEF_DLL_FN (size_t, gnutls_mac_get_nonce_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (size_t, gnutls_mac_get_key_size, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (const gnutls_digest_algorithm_t *, gnutls_digest_list, (void)); +DEF_DLL_FN (const char *, gnutls_digest_get_name, (gnutls_digest_algorithm_t)); +DEF_DLL_FN (int, gnutls_hmac_init, + (gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t)); +DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t)); +DEF_DLL_FN (int, gnutls_hmac, (gnutls_hmac_hd_t, const void *, size_t)); +DEF_DLL_FN (void, gnutls_hmac_deinit, (gnutls_hmac_hd_t, void *)); +DEF_DLL_FN (int, gnutls_hash_init, + (gnutls_hash_hd_t *, gnutls_digest_algorithm_t)); +DEF_DLL_FN (void, gnutls_hmac_output, (gnutls_hmac_hd_t, void *)); +DEF_DLL_FN (int, gnutls_hash_get_len, (gnutls_digest_algorithm_t)); +DEF_DLL_FN (int, gnutls_hash, (gnutls_hash_hd_t, const void *, size_t)); +DEF_DLL_FN (void, gnutls_hash_deinit, (gnutls_hash_hd_t, void *)); +DEF_DLL_FN (void, gnutls_hash_output, (gnutls_hash_hd_t, void *)); +# endif + static bool init_gnutls_functions (void) @@ -256,6 +301,38 @@ init_gnutls_functions (void) LOAD_DLL_FN (library, gnutls_cipher_get_name); LOAD_DLL_FN (library, gnutls_mac_get); LOAD_DLL_FN (library, gnutls_mac_get_name); +# if GNUTLS_VERSION_MAJOR + (GNUTLS_VERSION_MINOR >= 4) > 3 + LOAD_DLL_FN (library, gnutls_rnd); + LOAD_DLL_FN (library, gnutls_cipher_list); + LOAD_DLL_FN (library, gnutls_cipher_get_iv_size); + LOAD_DLL_FN (library, gnutls_cipher_get_key_size); + LOAD_DLL_FN (library, gnutls_cipher_get_block_size); + LOAD_DLL_FN (library, gnutls_cipher_get_tag_size); + LOAD_DLL_FN (library, gnutls_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt); + LOAD_DLL_FN (library, gnutls_aead_cipher_init); + LOAD_DLL_FN (library, gnutls_aead_cipher_deinit); + LOAD_DLL_FN (library, gnutls_cipher_set_iv); + LOAD_DLL_FN (library, gnutls_cipher_encrypt2); + LOAD_DLL_FN (library, gnutls_cipher_decrypt2); + LOAD_DLL_FN (library, gnutls_cipher_deinit); + LOAD_DLL_FN (library, gnutls_mac_list); + LOAD_DLL_FN (library, gnutls_mac_get_nonce_size); + LOAD_DLL_FN (library, gnutls_mac_get_key_size); + LOAD_DLL_FN (library, gnutls_digest_list); + LOAD_DLL_FN (library, gnutls_digest_get_name); + LOAD_DLL_FN (library, gnutls_hmac_init); + LOAD_DLL_FN (library, gnutls_hmac_get_len); + LOAD_DLL_FN (library, gnutls_hmac); + LOAD_DLL_FN (library, gnutls_hmac_deinit); + LOAD_DLL_FN (library, gnutls_hmac_output); + LOAD_DLL_FN (library, gnutls_hash_init); + LOAD_DLL_FN (library, gnutls_hash_get_len); + LOAD_DLL_FN (library, gnutls_hash); + LOAD_DLL_FN (library, gnutls_hash_deinit); + LOAD_DLL_FN (library, gnutls_hash_output); +# endif max_log_level = global_gnutls_log_level; @@ -333,6 +410,44 @@ init_gnutls_functions (void) # define gnutls_x509_crt_get_version fn_gnutls_x509_crt_get_version # define gnutls_x509_crt_import fn_gnutls_x509_crt_import # define gnutls_x509_crt_init fn_gnutls_x509_crt_init +# define gnutls_rnd fn_gnutls_rnd +# define gnutls_cipher_list fn_gnutls_cipher_list +# define gnutls_cipher_get_iv_size fn_gnutls_cipher_get_iv_size +# define gnutls_cipher_get_key_size fn_gnutls_cipher_get_key_size +# define gnutls_cipher_get_block_size fn_gnutls_cipher_get_block_size +# define gnutls_cipher_get_tag_size fn_gnutls_cipher_get_tag_size +# define gnutls_cipher_init fn_gnutls_cipher_init +# define gnutls_aead_cipher_encrypt fn_gnutls_aead_cipher_encrypt +# define gnutls_aead_cipher_decrypt fn_gnutls_aead_cipher_decrypt +# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init +# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit +# define gnutls_cipher_set_iv fn_gnutls_cipher_set_iv +# define gnutls_cipher_encrypt2 fn_gnutls_cipher_encrypt2 +# define gnutls_cipher_decrypt2 fn_gnutls_cipher_decrypt2 +# define gnutls_cipher_deinit fn_gnutls_cipher_deinit +# define gnutls_mac_list fn_gnutls_mac_list +# define gnutls_mac_get_nonce_size fn_gnutls_mac_get_nonce_size +# define gnutls_mac_get_key_size fn_gnutls_mac_get_key_size +# define gnutls_digest_list fn_gnutls_digest_list +# define gnutls_digest_get_name fn_gnutls_digest_get_name +# define gnutls_hmac_init fn_gnutls_hmac_init +# define gnutls_hmac_get_len fn_gnutls_hmac_get_len +# define gnutls_hmac fn_gnutls_hmac +# define gnutls_hmac_deinit fn_gnutls_hmac_deinit +# define gnutls_hmac_output fn_gnutls_hmac_output +# define gnutls_hash_init fn_gnutls_hash_init +# define gnutls_hash_get_len fn_gnutls_hash_get_len +# define gnutls_hash fn_gnutls_hash +# define gnutls_hash_deinit fn_gnutls_hash_deinit +# define gnutls_hash_output fn_gnutls_hash_output + +/* This wrapper is called from fns.c, which doesn't know about the + LOAD_DLL_FN stuff above. */ +int +w32_gnutls_rnd (gnutls_rnd_level_t level, void *data, size_t len) +{ + return gnutls_rnd (level, data, len); +} #endif @@ -1899,7 +2014,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, error ("GnuTLS cipher key extraction failed"); if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) - error ("GnuTLS cipher %s/%s key length %ld was not equal to " + error ("GnuTLS cipher %s/%s key length %" pD "d was not equal to " "the required %ld", gnutls_cipher_get_name (gca), desc, kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); @@ -1911,7 +2026,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, error ("GnuTLS cipher IV extraction failed"); if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) - error ("GnuTLS cipher %s/%s IV length %ld was not equal to " + error ("GnuTLS cipher %s/%s IV length %" pD "d was not equal to " "the required %ld", gnutls_cipher_get_name (gca), desc, vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); @@ -1939,7 +2054,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher, } if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) - error ("GnuTLS cipher %s/%s input block length %ld was not a multiple " + error ("GnuTLS cipher %s/%s input block length %" pD "d was not a multiple " "of the required %ld", gnutls_cipher_get_name (gca), desc, iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); diff --git a/src/gnutls.h b/src/gnutls.h index 981d59410b..3ec86a8892 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -86,6 +86,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte); extern ptrdiff_t emacs_gnutls_record_check_pending (gnutls_session_t state); #ifdef WINDOWSNT extern void emacs_gnutls_transport_set_errno (gnutls_session_t state, int err); +extern int w32_gnutls_rnd (gnutls_rnd_level_t, void *, size_t); #endif extern Lisp_Object emacs_gnutls_deinit (Lisp_Object); extern Lisp_Object emacs_gnutls_global_init (void); diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el index 6f1ca744e5..9dbb6c05b9 100644 --- a/test/lisp/net/gnutls-tests.el +++ b/test/lisp/net/gnutls-tests.el @@ -45,20 +45,23 @@ (secure-hash-algorithms))) (defvar gnutls-tests-tested-macs - (remove-duplicates - (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) - (mapcar 'car (gnutls-macs))))) + (when (gnutls-available-p) + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-macs)))))) (defvar gnutls-tests-tested-digests - (remove-duplicates - (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) - (mapcar 'car (gnutls-digests))))) + (when (gnutls-available-p) + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-digests)))))) (defvar gnutls-tests-tested-ciphers - (remove-duplicates - ; these cause FPEs or SEGVs - (remove-if (lambda (e) (memq e '(ARCFOUR-128))) - (mapcar 'car (gnutls-ciphers))))) + (when (gnutls-available-p) + (remove-duplicates + ; these cause FPEs or SEGVs + (remove-if (lambda (e) (memq e '(ARCFOUR-128))) + (mapcar 'car (gnutls-ciphers)))))) (defvar gnutls-tests-mondo-strings (list commit 548941bbd8a0a02fe58ba34875468e208c08c891 Author: Glenn Morris Date: Fri Jul 14 10:26:04 2017 -0700 ; Standardize license notices in new files diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el index 7cef8c1ff1..6f1ca744e5 100644 --- a/test/lisp/net/gnutls-tests.el +++ b/test/lisp/net/gnutls-tests.el @@ -4,18 +4,20 @@ ;; Author: Ted Zlatanov -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Commentary: diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el index 5250ff43b7..196f710072 100644 --- a/test/lisp/ses-tests.el +++ b/test/lisp/ses-tests.el @@ -4,18 +4,20 @@ ;; Author: Vincent Belaïche -;; This program is free software; you can redistribute it and/or modify +;; 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. -;; This program is distributed in the hope that it will be useful, +;; 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 this program. If not, see . +;; along with GNU Emacs. If not, see . ;;; Code: commit 6e2d6d54e1236216462c13655ea1fe573d9672e7 Author: Stefan Monnier Date: Fri Jul 14 11:27:21 2017 -0400 * lisp/emacs-lisp/bytecomp.el: Fix bug#14860. * lisp/emacs-lisp/bytecomp.el (byte-compile--function-signature): New fun. Dig into advice wrappers to find the "real" signature. (byte-compile-callargs-warn, byte-compile-arglist-warn): Use it. (byte-compile-arglist-signature): Don't bother with "new-style" arglists, since bytecode functions are now handled in byte-compile--function-signature. * lisp/files.el (create-file-buffer, insert-directory): Remove workaround introduced for (bug#14860). * lisp/help-fns.el (help-fns--analyse-function): `nadvice` is preloaded. * lisp/help.el (help-function-arglist): Dig into advice wrappers to find the "real" signature. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e5b9b47b1d..fdd4276e4e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1263,12 +1263,6 @@ when printing the error message." (defun byte-compile-arglist-signature (arglist) (cond - ;; New style byte-code arglist. - ((integerp arglist) - (cons (logand arglist 127) ;Mandatory. - (if (zerop (logand arglist 128)) ;No &rest. - (lsh arglist -8)))) ;Nonrest. - ;; Old style byte-code, or interpreted function. ((listp arglist) (let ((args 0) opts @@ -1289,6 +1283,19 @@ when printing the error message." ;; Unknown arglist. (t '(0)))) +(defun byte-compile--function-signature (f) + ;; Similar to help-function-arglist, except that it returns the info + ;; in a different format. + (and (eq 'macro (car-safe f)) (setq f (cdr f))) + ;; Advice wrappers have "catch all" args, so fetch the actual underlying + ;; function to find the real arguments. + (while (advice--p f) (setq f (advice--cdr f))) + (if (eq (car-safe f) 'declared) + (byte-compile-arglist-signature (nth 1 f)) + (condition-case nil + (let ((sig (func-arity f))) + (if (numberp (cdr sig)) sig (list (car sig)))) + (error '(0))))) (defun byte-compile-arglist-signatures-congruent-p (old new) (not (or @@ -1330,19 +1337,7 @@ when printing the error message." (defun byte-compile-callargs-warn (form) (let* ((def (or (byte-compile-fdefinition (car form) nil) (byte-compile-fdefinition (car form) t))) - (sig (if (and def (not (eq def t))) - (progn - (and (eq (car-safe def) 'macro) - (eq (car-safe (cdr-safe def)) 'lambda) - (setq def (cdr def))) - (byte-compile-arglist-signature - (if (memq (car-safe def) '(declared lambda)) - (nth 1 def) - (if (byte-code-function-p def) - (aref def 0) - '(&rest def))))) - (if (subrp (symbol-function (car form))) - (subr-arity (symbol-function (car form)))))) + (sig (byte-compile--function-signature def)) (ncall (length (cdr form)))) ;; Check many or unevalled from subr-arity. (if (and (cdr-safe sig) @@ -1461,15 +1456,7 @@ extra args." (and initial (symbolp initial) (setq old (byte-compile-fdefinition initial nil))) (when (and old (not (eq old t))) - (and (eq 'macro (car-safe old)) - (eq 'lambda (car-safe (cdr-safe old))) - (setq old (cdr old))) - (let ((sig1 (byte-compile-arglist-signature - (pcase old - (`(lambda ,args . ,_) args) - (`(closure ,_ ,args . ,_) args) - ((pred byte-code-function-p) (aref old 0)) - (_ '(&rest def))))) + (let ((sig1 (byte-compile--function-signature old)) (sig2 (byte-compile-arglist-signature arglist))) (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) (byte-compile-set-symbol-position name) diff --git a/lisp/files.el b/lisp/files.el index 646387f8c8..2f3efa33c2 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1821,10 +1821,6 @@ otherwise a string <2> or <3> or ... is appended to get an unused name. Emacs treats buffers whose names begin with a space as internal buffers. To avoid confusion when visiting a file whose name begins with a space, this function prepends a \"|\" to the final result if necessary." - ;; We need the following 'declare' form to shut up the byte - ;; compiler, which displays a bogus warning for advised functions, - ;; see bug#14860. - (declare (advertised-calling-convention (filename) "18.59")) (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) @@ -6594,11 +6590,6 @@ When SWITCHES contains the long `--dired' option, this function treats it specially, for the sake of dired. However, the normally equivalent short `-D' option is just passed on to `insert-directory-program', as any other option." - ;; We need the following 'declare' form to shut up the byte - ;; compiler, which displays a bogus warning for advised functions, - ;; see bug#14860. - (declare (advertised-calling-convention - (file switches &optional wildcard full-directory-p) "19.34")) ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index f5d94d8419..cb0b2d71d3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -564,7 +564,6 @@ FILE is the file where FUNCTION was probably defined." "Return information about FUNCTION. Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)." (let* ((advised (and (symbolp function) - (featurep 'nadvice) (advice--p (advice--symbol-function function)))) ;; If the function is advised, use the symbol that has the ;; real definition, if that symbol is already set up. diff --git a/lisp/help.el b/lisp/help.el index 0fb1c2dab7..bc7ee2c9b1 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1384,6 +1384,9 @@ If PRESERVE-NAMES is non-nil, return a formal arglist that uses the same names as used in the original source code, when possible." ;; Handle symbols aliased to other symbols. (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) + ;; Advice wrappers have "catch all" args, so fetch the actual underlying + ;; function to find the real arguments. + (while (advice--p def) (setq def (advice--cdr def))) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond commit 583995c62dd424775dda33d5134ce04bee2ae685 Author: Ted Zlatanov Date: Fri Jul 14 11:04:19 2017 -0400 GnuTLS HMAC and symmetric cipher support * etc/NEWS: Add news for new feature. * doc/lispref/text.texi (GnuTLS Cryptography): Add documentation. * configure.ac: Add macros HAVE_GNUTLS3_DIGEST, HAVE_GNUTLS3_CIPHER, HAVE_GNUTLS3_AEAD, HAVE_GNUTLS3_HMAC. * src/fns.c (Fsecure_hash_algorithms): Add function to list supported `secure-hash' algorithms. (extract_data_from_object): Add data extraction function that can operate on buffers and strings. (secure_hash): Use it. (Fsecure_hash): Mention `secure-hash-algorithms'. * src/gnutls.h: Include gnutls/crypto.h. * src/gnutls.c (Fgnutls_ciphers, gnutls_symmetric_aead) (gnutls_symmetric, Fgnutls_symmetric_encrypt, Fgnutls_symmetric_decrypt) (Fgnutls_macs, Fgnutls_digests, Fgnutls_hash_mac, Fgnutls_hash_digest) (Fgnutls_available_p): Implement GnuTLS cryptographic integration. * test/lisp/net/gnutls-tests.el: Add tests. diff --git a/configure.ac b/configure.ac index 980b4c633b..525aa51598 100644 --- a/configure.ac +++ b/configure.ac @@ -2831,6 +2831,61 @@ if test "${with_gnutls}" = "yes" ; then AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.]) EMACS_CHECK_MODULES([LIBGNUTLS3], [gnutls >= 3.0.0], [AC_DEFINE(HAVE_GNUTLS3, 1, [Define if using GnuTLS v3.])], []) + + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include +#include +]], +[[ +int main (int argc, char **argv) +{ + gnutls_hmac_hd_t handle; + gnutls_hmac_deinit(handle, NULL); +} +]])], + [AC_DEFINE(HAVE_GNUTLS3_HMAC, 1, [Define if using GnuTLS v3 with HMAC support.])]) + + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include +#include +]], +[[ +int main (int argc, char **argv) +{ + gnutls_aead_cipher_hd_t handle; + gnutls_aead_cipher_deinit(handle); +} +]])], + [AC_DEFINE(HAVE_GNUTLS3_AEAD, 1, [Define if using GnuTLS v3 with AEAD support.])]) + + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include +#include +]], +[[ +int main (int argc, char **argv) +{ + gnutls_cipher_hd_t handle; + gnutls_cipher_encrypt2 (handle, + NULL, 0, + NULL, 0); + gnutls_cipher_deinit(handle); +} +]])], + [AC_DEFINE(HAVE_GNUTLS3_CIPHER, 1, [Define if using GnuTLS v3 with cipher support.])]) + + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include +#include +]], +[[ +int main (int argc, char **argv) +{ + gnutls_hash_hd_t handle; + gnutls_hash_deinit(handle, NULL); +} +]])], + [AC_DEFINE(HAVE_GNUTLS3_DIGEST, 1, [Define if using GnuTLS v3 with digest support.])]) fi # Windows loads GnuTLS dynamically diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index 9696c73c48..fd6ddc98fe 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -57,6 +57,7 @@ the character after point. * Decompression:: Dealing with compressed data. * Base 64:: Conversion to or from base 64 encoding. * Checksum/Hash:: Computing cryptographic hashes. +* GnuTLS Cryptography:: Cryptographic algorithms imported from GnuTLS. * Parsing HTML/XML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes atomically. * Change Hooks:: Supplying functions to be run when text is changed. @@ -4436,6 +4437,11 @@ similar theoretical weakness also exists in SHA-1. Therefore, for security-related applications you should use the other hash types, such as SHA-2. +@defun secure-hash-algorithms +This function returns a list of symbols representing algorithms that +@code{secure-hash} can use. +@end defun + @defun secure-hash algorithm object &optional start end binary This function returns a hash for @var{object}. The argument @var{algorithm} is a symbol stating which hash to compute: one of @@ -4494,6 +4500,195 @@ It should be somewhat more efficient on larger buffers than @c according to what we find useful. @end defun +@node GnuTLS Cryptography +@section GnuTLS Cryptography +@cindex MD5 checksum +@cindex SHA hash +@cindex hash, cryptographic +@cindex cryptographic hash +@cindex AEAD cipher +@cindex cipher, AEAD +@cindex symmetric cipher +@cindex cipher, symmetric + +If compiled with GnuTLS, Emacs offers built-in cryptographic support. +Following the GnuTLS API terminology, the available tools are digests, +MACs, symmetric ciphers, and AEAD ciphers. + +The terms used herein, such as IV (Initialization Vector), require +some familiarity with cryptography and will not be defined in detail. +Please consult @uref{https://www.gnutls.org/} for specific +documentation which may help you understand the terminology and +structure of the GnuTLS library. + +@node Format of GnuTLS Cryptography Inputs +@subsection Format of GnuTLS Cryptography Inputs +@cindex format of gnutls cryptography inputs +@cindex gnutls cryptography inputs format + +The inputs to GnuTLS cryptographic functions can be specified in +several ways, both as primitive Emacs Lisp types or as lists. + +The list form is currently similar to how @code{md5} and +@code{secure-hash} operate. + +@table @code +@item @var{buffer} +Simply passing a buffer as input means the whole buffer should be used. + +@item @var{string} +A string as input will be used directly. It may be modified by the +function (unlike most other Emacs Lisp functions) to reduce the chance +of exposing sensitive data after the function does its work. + +@item (@var{buffer-or-string} @var{start} @var{end} @var{coding-system} @var{noerror}) +This specifies a buffer or a string as described above, but an +optional range can be specified with @var{start} and @var{end}. + +In addition an optional @var{coding-system} can be specified if needed. + +The last optional item, @var{noerror}, overrides the normal error when +the text can't be encoded using the specified or chosen coding system. +When @var{noerror} is non-@code{nil}, this function silently uses +@code{raw-text} coding instead. + +@item (@code{iv-auto} @var{length}) +This will generate an IV (Initialization Vector) of the specified +length using the GnuTLS @code{GNUTLS_RND_NONCE} generator and pass it +to the function. This ensures that the IV is unpredictable and +unlikely to be reused in the same session. The actual value of the IV +is returned by the function as described below. + +@end table + +@node GnuTLS Cryptographic Functions +@subsection GnuTLS Cryptographic Functions +@cindex gnutls cryptographic functions + +@defun gnutls-digests +This function returns the alist of the GnuTLS digest algorithms. + +Each entry has a key which represents the algorithm, followed by a +plist with internal details about the algorithm. The plist will have +@code{:type gnutls-digest-algorithm} and also will have the key +@code{:digest-algorithm-length 64} to indicate the size, in bytes, of +the resulting digest. + +There is a name parallel between GnuTLS MAC and digest algorithms but +they are separate things internally and should not be mixed. +@end defun + +@defun gnutls-hash-digest digest-method input +The @var{digest-method} can be the whole plist from +@code{gnutls-digests}, or just the symbol key, or a string with the +name of that symbol. + +The @var{input} can be specified as a buffer or string or in other +ways (@pxref{Format of GnuTLS Cryptography Inputs}). + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{digest-method} or @var{input} are invalid. On success, it +returns a list of a binary string (the output) and the IV used. +@end defun + +@defun gnutls-macs +This function returns the alist of the GnuTLS MAC algorithms. + +Each entry has a key which represents the algorithm, followed by a +plist with internal details about the algorithm. The plist will have +@code{:type gnutls-mac-algorithm} and also will have the keys +@code{:mac-algorithm-length} @code{:mac-algorithm-keysize} +@code{:mac-algorithm-noncesize} to indicate the size, in bytes, of the +resulting hash, the key, and the nonce respectively. + +The nonce is currently unused and only some MACs support it. + +There is a name parallel between GnuTLS MAC and digest algorithms but +they are separate things internally and should not be mixed. +@end defun + +@defun gnutls-hash-mac hash-method key input +The @var{hash-method} can be the whole plist from +@code{gnutls-macs}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{input} can be specified as a buffer or string or in other +ways (@pxref{Format of GnuTLS Cryptography Inputs}). + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{hash-method} or @var{key} or @var{input} are invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + +@defun gnutls-ciphers +This function returns the alist of the GnuTLS ciphers. + +Each entry has a key which represents the cipher, followed by a plist +with internal details about the algorithm. The plist will have +@code{:type gnutls-symmetric-cipher} and also will have the keys +@code{:cipher-aead-capable} set to @code{nil} or @code{t} to indicate +AEAD capability; and @code{:cipher-tagsize} @code{:cipher-blocksize} +@code{:cipher-keysize} @code{:cipher-ivsize} to indicate the size, in +bytes, of the tag, block size of the resulting data, the key, and the +IV respectively. +@end defun + +@defun gnutls-symmetric-encrypt cipher key iv input &optional aead_auth +The @var{cipher} can be the whole plist from +@code{gnutls-ciphers}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{iv} and @var{input} and the optional @var{aead_auth} can be +specified as a buffer or string or in other ways (@pxref{Format of +GnuTLS Cryptography Inputs}). + +@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose +plist has @code{:cipher-aead-capable t}. Otherwise it's ignored. + +This function returns @code{nil} on error, and signals a Lisp error if +the @var{cipher} or @var{key}, @var{iv}, or @var{input} are invalid, +or if @var{aead_auth} was specified with an AEAD cipher and was +invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + +@defun gnutls-symmetric-decrypt cipher key iv input &optional aead_auth +The @var{cipher} can be the whole plist from +@code{gnutls-ciphers}, or just the symbol key, or a string with the +name of that symbol. + +The @var{key} can be specified as a buffer or string or in other ways +(@pxref{Format of GnuTLS Cryptography Inputs}). The @var{key} will be +wiped after use if it's a string. + +The @var{iv} and @var{input} and the optional @var{aead_auth} can be +specified as a buffer or string or in other ways (@pxref{Format of +GnuTLS Cryptography Inputs}). + +@var{aead_auth} is only checked with AEAD ciphers, that is, ciphers whose +plist has @code{:cipher-aead-capable t}. Otherwise it's ignored. + +This function returns @code{nil} on decryption error, and signals a +Lisp error if the @var{cipher} or @var{key}, @var{iv}, or @var{input} +are invalid, or if @var{aead_auth} was specified with an AEAD cipher +and was invalid. + +On success, it returns a list of a binary string (the output) and the +IV used. +@end defun + @node Parsing HTML/XML @section Parsing HTML and XML @cindex parsing html diff --git a/etc/NEWS b/etc/NEWS index dd6d5465d8..0ab49587d7 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1114,6 +1114,20 @@ break. ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. +** Checksum/Hash + ++++ +** New function 'secure-hash-algorithms' to list the algorithms that +'secure-hash' supports. +See the node "(elisp) Checksum/Hash" in the ELisp manual for details. + ++++ +** Emacs now exposes the GnuTLS cryptographic API with the functions +'gnutls-macs' and 'gnutls-hash-mac'; 'gnutls-digests' and +'gnutls-hash-digest'; 'gnutls-ciphers' and 'gnutls-symmetric-encrypt' +and 'gnutls-symmetric-decrypt'. +See the node "(elisp) GnuTLS Cryptography" in the ELisp manual for details. + +++ ** Emacs now supports records for user-defined types, via the new functions 'make-record', 'record', and 'recordp'. Records are now diff --git a/src/fns.c b/src/fns.c index f0e10e311f..8b7fc0f89d 100644 --- a/src/fns.c +++ b/src/fns.c @@ -35,12 +35,17 @@ along with GNU Emacs. If not, see . */ #include "intervals.h" #include "window.h" #include "puresize.h" +#include "gnutls.h" static void sort_vector_copy (Lisp_Object, ptrdiff_t, Lisp_Object *restrict, Lisp_Object *restrict); enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES }; static bool internal_equal (Lisp_Object, Lisp_Object, enum equal_kind, int, Lisp_Object); +static Lisp_Object +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary); DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */ @@ -4740,22 +4745,47 @@ make_digest_string (Lisp_Object digest, int digest_size) return digest; } -/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ +DEFUN ("secure-hash-algorithms", Fsecure_hash_algorithms, + Ssecure_hash_algorithms, 0, 0, 0, + doc: /* Return a list of all the supported `secure_hash' algorithms. */) + (void) +{ + return listn (CONSTYPE_HEAP, 6, + Qmd5, + Qsha1, + Qsha224, + Qsha256, + Qsha384, + Qsha512); +} -static Lisp_Object -secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, - Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, - Lisp_Object binary) +/* Extract data from a string or a buffer. SPEC is a list of +(BUFFER-OR-STRING-OR-SYMBOL START END CODING-SYSTEM NOERROR) which behave as +specified with `secure-hash' and in Info node +`(elisp)Format of GnuTLS Cryptography Inputs'. */ +const char* +extract_data_from_object (Lisp_Object spec, + ptrdiff_t *start_byte, + ptrdiff_t *end_byte) { - ptrdiff_t size, start_char = 0, start_byte, end_char = 0, end_byte; + ptrdiff_t size, start_char = 0, end_char = 0; register EMACS_INT b, e; register struct buffer *bp; EMACS_INT temp; - int digest_size; - void *(*hash_func) (const char *, size_t, void *); - Lisp_Object digest; - CHECK_SYMBOL (algorithm); + Lisp_Object object = XCAR (spec); + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object start = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object end = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object coding_system = (CONSP (spec)) ? XCAR (spec) : Qnil; + + if (! NILP (spec)) spec = XCDR (spec); + Lisp_Object noerror = (CONSP (spec)) ? XCAR (spec) : Qnil; if (STRINGP (object)) { @@ -4786,12 +4816,12 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, size = SCHARS (object); validate_subarray (object, start, end, size, &start_char, &end_char); - start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); - end_byte = (end_char == size - ? SBYTES (object) - : string_char_to_byte (object, end_char)); + *start_byte = !start_char ? 0 : string_char_to_byte (object, start_char); + *end_byte = (end_char == size + ? SBYTES (object) + : string_char_to_byte (object, end_char)); } - else + else if (BUFFERP (object)) { struct buffer *prev = current_buffer; @@ -4892,10 +4922,56 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, if (STRING_MULTIBYTE (object)) object = code_convert_string (object, coding_system, Qnil, 1, 0, 0); - start_byte = 0; - end_byte = SBYTES (object); + *start_byte = 0; + *end_byte = SBYTES (object); + } + else if (EQ (object, Qiv_auto)) + { +#ifdef HAVE_GNUTLS3 + // Format: (iv-auto REQUIRED-LENGTH) + + if (! INTEGERP (start)) + error ("Without a length, iv-auto can't be used. See manual."); + else + { + /* Make sure the value of "start" doesn't change. */ + size_t start_hold = XUINT (start); + object = make_uninit_string (start_hold); + gnutls_rnd (GNUTLS_RND_NONCE, SSDATA (object), start_hold); + + *start_byte = 0; + *end_byte = start_hold; + } +#else + error ("GnuTLS integration is not available, so iv-auto can't be used."); +#endif } + return SSDATA (object); +} + + +/* ALGORITHM is a symbol: md5, sha1, sha224 and so on. */ + +static Lisp_Object +secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, + Lisp_Object end, Lisp_Object coding_system, Lisp_Object noerror, + Lisp_Object binary) +{ + ptrdiff_t start_byte, end_byte; + int digest_size; + void *(*hash_func) (const char *, size_t, void *); + Lisp_Object digest; + + CHECK_SYMBOL (algorithm); + + Lisp_Object spec = list5 (object, start, end, coding_system, noerror); + + const char* input = extract_data_from_object (spec, &start_byte, &end_byte); + + if (input == NULL) + error ("secure_hash: failed to extract data from object, aborting!"); + if (EQ (algorithm, Qmd5)) { digest_size = MD5_DIGEST_SIZE; @@ -4933,7 +5009,7 @@ secure_hash (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, hexified value */ digest = make_uninit_string (digest_size * 2); - hash_func (SSDATA (object) + start_byte, + hash_func (input + start_byte, end_byte - start_byte, SSDATA (digest)); @@ -4984,6 +5060,8 @@ The two optional arguments START and END are positions specifying for which part of OBJECT to compute the hash. If nil or omitted, uses the whole OBJECT. +The full list of algorithms can be obtained with `secure-hash-algorithms'. + If BINARY is non-nil, returns a string in binary form. */) (Lisp_Object algorithm, Lisp_Object object, Lisp_Object start, Lisp_Object end, Lisp_Object binary) { @@ -5031,13 +5109,6 @@ disregarding any coding systems. If nil, use the current buffer. */ ) void syms_of_fns (void) { - DEFSYM (Qmd5, "md5"); - DEFSYM (Qsha1, "sha1"); - DEFSYM (Qsha224, "sha224"); - DEFSYM (Qsha256, "sha256"); - DEFSYM (Qsha384, "sha384"); - DEFSYM (Qsha512, "sha512"); - /* Hash table stuff. */ DEFSYM (Qhash_table_p, "hash-table-p"); DEFSYM (Qeq, "eq"); @@ -5074,6 +5145,18 @@ syms_of_fns (void) defsubr (&Smaphash); defsubr (&Sdefine_hash_table_test); + /* Crypto and hashing stuff. */ + DEFSYM (Qiv_auto, "iv-auto"); + + DEFSYM (Qmd5, "md5"); + DEFSYM (Qsha1, "sha1"); + DEFSYM (Qsha224, "sha224"); + DEFSYM (Qsha256, "sha256"); + DEFSYM (Qsha384, "sha384"); + DEFSYM (Qsha512, "sha512"); + + /* Miscellaneous stuff. */ + DEFSYM (Qstring_lessp, "string-lessp"); DEFSYM (Qprovide, "provide"); DEFSYM (Qrequire, "require"); @@ -5192,6 +5275,7 @@ this variable. */); defsubr (&Sbase64_encode_string); defsubr (&Sbase64_decode_string); defsubr (&Smd5); + defsubr (&Ssecure_hash_algorithms); defsubr (&Ssecure_hash); defsubr (&Sbuffer_hash); defsubr (&Slocale_info); diff --git a/src/gnutls.c b/src/gnutls.c index 2078ad88f2..7a4e92f0d3 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -24,6 +24,7 @@ along with GNU Emacs. If not, see . */ #include "process.h" #include "gnutls.h" #include "coding.h" +#include "buffer.h" #ifdef HAVE_GNUTLS @@ -1697,24 +1698,660 @@ This function may also return `gnutls-e-again', or #endif /* HAVE_GNUTLS */ +#ifdef HAVE_GNUTLS3 + +DEFUN ("gnutls-ciphers", Fgnutls_ciphers, Sgnutls_ciphers, 0, 0, 0, + doc: /* Return alist of GnuTLS symmetric cipher descriptions as plists. +The alist key is the cipher name. */) + (void) +{ + Lisp_Object ciphers = Qnil; + + const gnutls_cipher_algorithm_t* gciphers = gnutls_cipher_list (); + for (size_t pos = 0; gciphers[pos] != GNUTLS_CIPHER_NULL; pos++) + { + const gnutls_cipher_algorithm_t gca = gciphers[pos]; + + Lisp_Object cp = listn (CONSTYPE_HEAP, 15, + /* A symbol representing the cipher */ + intern (gnutls_cipher_get_name (gca)), + /* The internally meaningful cipher ID */ + QCcipher_id, + make_number (gca), + /* The type (vs. other GnuTLS objects). */ + QCtype, + Qgnutls_type_cipher, + /* The tag size (nonzero means AEAD). */ + QCcipher_aead_capable, + (gnutls_cipher_get_tag_size (gca) == 0) ? Qnil : Qt, + /* The tag size (nonzero means AEAD). */ + QCcipher_tagsize, + make_number (gnutls_cipher_get_tag_size (gca)), + /* The block size */ + QCcipher_blocksize, + make_number (gnutls_cipher_get_block_size (gca)), + /* The key size */ + QCcipher_keysize, + make_number (gnutls_cipher_get_key_size (gca)), + /* IV size */ + QCcipher_ivsize, + make_number (gnutls_cipher_get_iv_size (gca))); + + ciphers = Fcons (cp, ciphers); + } + + return ciphers; +} + +static Lisp_Object +gnutls_symmetric_aead (bool encrypting, gnutls_cipher_algorithm_t gca, + Lisp_Object cipher, + const char* kdata, size_t ksize, + const char* vdata, size_t vsize, + const char* idata, size_t isize, + Lisp_Object aead_auth) +{ +#ifdef HAVE_GNUTLS3_AEAD + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + int ret = GNUTLS_E_SUCCESS; + Lisp_Object actual_iv = make_unibyte_string (vdata, vsize); + + gnutls_aead_cipher_hd_t acipher; + gnutls_datum_t key_datum = { (unsigned char*) kdata, ksize }; + ret = gnutls_aead_cipher_init (&acipher, gca, &key_datum); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS AEAD cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + size_t storage_length = isize + gnutls_cipher_get_tag_size (gca); + USE_SAFE_ALLOCA; + unsigned char *storage = SAFE_ALLOCA (storage_length); + + const char* aead_auth_data = NULL; + size_t aead_auth_size = 0; + + if (!NILP (aead_auth)) + { + if (BUFFERP (aead_auth) || STRINGP (aead_auth)) + aead_auth = list1 (aead_auth); + + CHECK_CONS (aead_auth); + + ptrdiff_t astart_byte, aend_byte; + const char* adata = extract_data_from_object (aead_auth, &astart_byte, &aend_byte); + + if (adata == NULL) + error ("GnuTLS AEAD cipher auth extraction failed"); + + aead_auth_data = adata; + aead_auth_size = aend_byte - astart_byte; + } + + size_t expected_remainder = 0; + + if (!encrypting) + expected_remainder = gnutls_cipher_get_tag_size (gca); + + if ((isize - expected_remainder) % gnutls_cipher_get_block_size (gca) != 0) + error ("GnuTLS AEAD cipher %s/%s input block length %ld was not a " + "multiple of the required %ld plus the expected tag remainder %ld", + gnutls_cipher_get_name (gca), desc, + (long) isize, (long) gnutls_cipher_get_block_size (gca), + (long) expected_remainder); + + if (encrypting) + ret = gnutls_aead_cipher_encrypt (acipher, + vdata, vsize, + aead_auth_data, aead_auth_size, + gnutls_cipher_get_tag_size (gca), + idata, isize, + storage, &storage_length); + else + ret = gnutls_aead_cipher_decrypt (acipher, + vdata, vsize, + aead_auth_data, aead_auth_size, + gnutls_cipher_get_tag_size (gca), + idata, isize, + storage, &storage_length); + + if (ret < GNUTLS_E_SUCCESS) + { + memset (storage, 0, storage_length); + SAFE_FREE (); + gnutls_aead_cipher_deinit (acipher); + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS AEAD cipher %s %sion failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + gnutls_aead_cipher_deinit (acipher); + + Lisp_Object output = make_unibyte_string ((const char *)storage, storage_length); + memset (storage, 0, storage_length); + SAFE_FREE (); + return list2 (output, actual_iv); +#else + error ("GnuTLS AEAD cipher %ld was invalid or not found", (long) gca); +#endif +} + +static Lisp_Object +gnutls_symmetric (bool encrypting, Lisp_Object cipher, + Lisp_Object key, Lisp_Object iv, + Lisp_Object input, Lisp_Object aead_auth) +{ + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (iv) || STRINGP (iv)) + iv = list1 (iv); + + CHECK_CONS (iv); + + + const char* desc = (encrypting ? "encrypt" : "decrypt"); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_cipher_algorithm_t gca = GNUTLS_CIPHER_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (cipher)) + cipher = intern (SSDATA (cipher)); + + if (SYMBOLP (cipher)) + info = XCDR (Fassq (cipher, Fgnutls_ciphers ())); + else if (INTEGERP (cipher)) + gca = XINT (cipher); + else + info = cipher; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCcipher_id); + if (INTEGERP (v)) + gca = XINT (v); + } + + if (gca == GNUTLS_CIPHER_UNKNOWN) + error ("GnuTLS cipher was invalid or not found"); + + ptrdiff_t kstart_byte, kend_byte; + const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + + if (kdata == NULL) + error ("GnuTLS cipher key extraction failed"); + + if ((kend_byte - kstart_byte) != gnutls_cipher_get_key_size (gca)) + error ("GnuTLS cipher %s/%s key length %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + kend_byte - kstart_byte, (long) gnutls_cipher_get_key_size (gca)); + + ptrdiff_t vstart_byte, vend_byte; + const char* vdata = extract_data_from_object (iv, &vstart_byte, &vend_byte); + + if (vdata == NULL) + error ("GnuTLS cipher IV extraction failed"); + + if ((vend_byte - vstart_byte) != gnutls_cipher_get_iv_size (gca)) + error ("GnuTLS cipher %s/%s IV length %ld was not equal to " + "the required %ld", + gnutls_cipher_get_name (gca), desc, + vend_byte - vstart_byte, (long) gnutls_cipher_get_iv_size (gca)); + + Lisp_Object actual_iv = make_unibyte_string (vdata, vend_byte - vstart_byte); + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + + if (idata == NULL) + error ("GnuTLS cipher input extraction failed"); + + /* Is this an AEAD cipher? */ + if (gnutls_cipher_get_tag_size (gca) > 0) + { + Lisp_Object aead_output = + gnutls_symmetric_aead (encrypting, gca, cipher, + kdata, kend_byte - kstart_byte, + vdata, vend_byte - vstart_byte, + idata, iend_byte - istart_byte, + aead_auth); + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + return aead_output; + } + + if ((iend_byte - istart_byte) % gnutls_cipher_get_block_size (gca) != 0) + error ("GnuTLS cipher %s/%s input block length %ld was not a multiple " + "of the required %ld", + gnutls_cipher_get_name (gca), desc, + iend_byte - istart_byte, (long) gnutls_cipher_get_block_size (gca)); + + gnutls_cipher_hd_t hcipher; + gnutls_datum_t key_datum = { (unsigned char*) kdata, kend_byte - kstart_byte }; + + ret = gnutls_cipher_init (&hcipher, gca, &key_datum, NULL); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS cipher %s/%s initialization failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + /* Note that this will not support streaming block mode. */ + gnutls_cipher_set_iv (hcipher, (void*) vdata, vend_byte - vstart_byte); + + /* + * GnuTLS docs: "For the supported ciphers the encrypted data length + * will equal the plaintext size." + */ + size_t storage_length = iend_byte - istart_byte; + Lisp_Object storage = make_uninit_string (storage_length); + + if (encrypting) + ret = gnutls_cipher_encrypt2 (hcipher, + idata, iend_byte - istart_byte, + SSDATA (storage), storage_length); + else + ret = gnutls_cipher_decrypt2 (hcipher, + idata, iend_byte - istart_byte, + SSDATA (storage), storage_length); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_cipher_deinit (hcipher); + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS cipher %s %sion failed: %s", + gnutls_cipher_get_name (gca), desc, str); + } + + gnutls_cipher_deinit (hcipher); + + return list2 (storage, actual_iv); +} + +DEFUN ("gnutls-symmetric-encrypt", Fgnutls_symmetric_encrypt, Sgnutls_symmetric_encrypt, 4, 5, 0, + doc: /* Encrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The IV and INPUT and the optional AEAD_AUTH can be +specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. +The CIPHER may be a string or symbol matching a key in that alist, or +a plist with the `:cipher-id' numeric property, or the number itself. + +AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with +:cipher-aead-capable set to t. AEAD_AUTH can be supplied for +these AEAD ciphers, but it may still be omitted (nil) as well. */) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) +{ + return gnutls_symmetric (true, cipher, key, iv, input, aead_auth); +} + +DEFUN ("gnutls-symmetric-decrypt", Fgnutls_symmetric_decrypt, Sgnutls_symmetric_decrypt, 4, 5, 0, + doc: /* Decrypt INPUT with symmetric CIPHER, KEY+AEAD_AUTH, and IV to a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The IV and INPUT and the optional AEAD_AUTH can be +specified as a buffer or string or in other ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of symmetric ciphers can be obtained with `gnutls-ciphers`. +The CIPHER may be a string or symbol matching a key in that alist, or +a plist with the `:cipher-id' numeric property, or the number itself. + +AEAD ciphers: these ciphers will have a `gnutls-ciphers' entry with +:cipher-aead-capable set to t. AEAD_AUTH can be supplied for +these AEAD ciphers, but it may still be omitted (nil) as well. */) + (Lisp_Object cipher, Lisp_Object key, Lisp_Object iv, Lisp_Object input, Lisp_Object aead_auth) +{ + return gnutls_symmetric (false, cipher, key, iv, input, aead_auth); +} + +DEFUN ("gnutls-macs", Fgnutls_macs, Sgnutls_macs, 0, 0, 0, + doc: /* Return alist of GnuTLS mac-algorithm method descriptions as plists. + +Use the value of the alist (extract it with `alist-get' for instance) +with `gnutls-hash-mac'. The alist key is the mac-algorithm method +name. */) + (void) +{ + Lisp_Object mac_algorithms = Qnil; + const gnutls_mac_algorithm_t* macs = gnutls_mac_list (); + for (size_t pos = 0; macs[pos] != 0; pos++) + { + const gnutls_mac_algorithm_t gma = macs[pos]; + + const char* name = gnutls_mac_get_name (gma); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 11, + /* A symbol representing the mac-algorithm. */ + intern (name), + /* The internally meaningful mac-algorithm ID. */ + QCmac_algorithm_id, + make_number (gma), + /* The type (vs. other GnuTLS objects). */ + QCtype, + Qgnutls_type_mac_algorithm, + /* The output length. */ + QCmac_algorithm_length, + make_number (gnutls_hmac_get_len (gma)), + /* The key size. */ + QCmac_algorithm_keysize, + make_number (gnutls_mac_get_key_size (gma)), + /* The nonce size. */ + QCmac_algorithm_noncesize, + make_number (gnutls_mac_get_nonce_size (gma))); + mac_algorithms = Fcons (mp, mac_algorithms); + } + + return mac_algorithms; +} + +DEFUN ("gnutls-digests", Fgnutls_digests, Sgnutls_digests, 0, 0, 0, + doc: /* Return alist of GnuTLS digest-algorithm method descriptions as plists. + +Use the value of the alist (extract it with `alist-get' for instance) +with `gnutls-hash-digest'. The alist key is the digest-algorithm +method name. */) + (void) +{ + Lisp_Object digest_algorithms = Qnil; + const gnutls_digest_algorithm_t* digests = gnutls_digest_list (); + for (size_t pos = 0; digests[pos] != 0; pos++) + { + const gnutls_digest_algorithm_t gda = digests[pos]; + + const char* name = gnutls_digest_get_name (gda); + + Lisp_Object mp = listn (CONSTYPE_HEAP, 7, + /* A symbol representing the digest-algorithm. */ + intern (name), + /* The internally meaningful digest-algorithm ID. */ + QCdigest_algorithm_id, + make_number (gda), + QCtype, + Qgnutls_type_digest_algorithm, + /* The digest length. */ + QCdigest_algorithm_length, + make_number (gnutls_hash_get_len (gda))); + + digest_algorithms = Fcons (mp, digest_algorithms); + } + + return digest_algorithms; +} + +DEFUN ("gnutls-hash-mac", Fgnutls_hash_mac, Sgnutls_hash_mac, 3, 3, 0, + doc: /* Hash INPUT with HASH-METHOD and KEY into a unibyte string. + +Returns nil on error. + +The KEY can be specified as a buffer or string or in other ways +(see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). The KEY will be +wiped after use if it's a string. + +The INPUT can be specified as a buffer or string or in other +ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of MAC algorithms can be obtained with `gnutls-macs`. The +HASH-METHOD may be a string or symbol matching a key in that alist, or +a plist with the `:mac-algorithm-id' numeric property, or the number +itself. */) + (Lisp_Object hash_method, Lisp_Object key, Lisp_Object input) +{ + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + if (BUFFERP (key) || STRINGP (key)) + key = list1 (key); + + CHECK_CONS (key); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_mac_algorithm_t gma = GNUTLS_MAC_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (hash_method)) + hash_method = intern (SSDATA (hash_method)); + + if (SYMBOLP (hash_method)) + info = XCDR (Fassq (hash_method, Fgnutls_macs ())); + else if (INTEGERP (hash_method)) + gma = XINT (hash_method); + else + info = hash_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCmac_algorithm_id); + if (INTEGERP (v)) + gma = XINT (v); + } + + if (gma == GNUTLS_MAC_UNKNOWN) + error ("GnuTLS MAC-method was invalid or not found"); + + ptrdiff_t kstart_byte, kend_byte; + const char* kdata = extract_data_from_object (key, &kstart_byte, &kend_byte); + gnutls_hmac_hd_t hmac; + ret = gnutls_hmac_init (&hmac, gma, + kdata + kstart_byte, kend_byte - kstart_byte); + + if (kdata == NULL) + error ("GnuTLS MAC key extraction failed"); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS MAC %s initialization failed: %s", + gnutls_mac_get_name (gma), str); + } + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + if (idata == NULL) + error ("GnuTLS MAC input extraction failed"); + + size_t digest_length = gnutls_hmac_get_len (gma); + Lisp_Object digest = make_uninit_string (digest_length); + + ret = gnutls_hmac (hmac, idata + istart_byte, iend_byte - istart_byte); + + if (STRINGP (XCAR (key))) + Fclear_string (XCAR (key)); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_hmac_deinit (hmac, NULL); + + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS MAC %s application failed: %s", + gnutls_mac_get_name (gma), str); + } + + gnutls_hmac_output (hmac, SSDATA (digest)); + gnutls_hmac_deinit (hmac, NULL); + + return digest; +} + +DEFUN ("gnutls-hash-digest", Fgnutls_hash_digest, Sgnutls_hash_digest, 2, 2, 0, + doc: /* Digest INPUT with DIGEST-METHOD into a unibyte string. + +Returns nil on error. + +The INPUT can be specified as a buffer or string or in other +ways (see Info node `(elisp)Format of GnuTLS Cryptography Inputs'). + +The alist of digest algorithms can be obtained with `gnutls-digests`. +The DIGEST-METHOD may be a string or symbol matching a key in that +alist, or a plist with the `:digest-algorithm-id' numeric property, or +the number itself. */) + (Lisp_Object digest_method, Lisp_Object input) +{ + if (BUFFERP (input) || STRINGP (input)) + input = list1 (input); + + CHECK_CONS (input); + + int ret = GNUTLS_E_SUCCESS; + + gnutls_digest_algorithm_t gda = GNUTLS_DIG_UNKNOWN; + + Lisp_Object info = Qnil; + if (STRINGP (digest_method)) + digest_method = intern (SSDATA (digest_method)); + + if (SYMBOLP (digest_method)) + info = XCDR (Fassq (digest_method, Fgnutls_digests ())); + else if (INTEGERP (digest_method)) + gda = XINT (digest_method); + else + info = digest_method; + + if (!NILP (info) && CONSP (info)) + { + Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id); + if (INTEGERP (v)) + gda = XINT (v); + } + + if (gda == GNUTLS_DIG_UNKNOWN) + error ("GnuTLS digest-method was invalid or not found"); + + gnutls_hash_hd_t hash; + ret = gnutls_hash_init (&hash, gda); + + if (ret < GNUTLS_E_SUCCESS) + { + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS digest initialization failed: %s", str); + } + + size_t digest_length = gnutls_hash_get_len (gda); + Lisp_Object digest = make_uninit_string (digest_length); + + ptrdiff_t istart_byte, iend_byte; + const char* idata = extract_data_from_object (input, &istart_byte, &iend_byte); + if (idata == NULL) + error ("GnuTLS digest input extraction failed"); + + ret = gnutls_hash (hash, idata + istart_byte, iend_byte - istart_byte); + + if (ret < GNUTLS_E_SUCCESS) + { + gnutls_hash_deinit (hash, NULL); + + const char* str = gnutls_strerror (ret); + if (!str) + str = "unknown"; + error ("GnuTLS digest application failed: %s", str); + } + + gnutls_hash_output (hash, SSDATA (digest)); + gnutls_hash_deinit (hash, NULL); + + return digest; +} + +#endif + DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0, - doc: /* Return t if GnuTLS is available in this instance of Emacs. */) + doc: /* Return list of capabilities if GnuTLS is available in this instance of Emacs. + +...if supported : then... +GnuTLS 3 or higher : the list will contain 'gnutls3. +GnuTLS MACs : the list will contain 'macs. +GnuTLS digests : the list will contain 'digests. +GnuTLS symmetric ciphers: the list will contain 'ciphers. +GnuTLS AEAD ciphers : the list will contain 'AEAD-ciphers. */) (void) { #ifdef HAVE_GNUTLS + Lisp_Object capabilities = Qnil; + +#ifdef HAVE_GNUTLS3 + + capabilities = Fcons (intern("gnutls3"), capabilities); + +#ifdef HAVE_GNUTLS3_DIGEST + capabilities = Fcons (intern("digests"), capabilities); +#endif + +#ifdef HAVE_GNUTLS3_CIPHER + capabilities = Fcons (intern("ciphers"), capabilities); + +#ifdef HAVE_GNUTLS3_AEAD + capabilities = Fcons (intern("AEAD-ciphers"), capabilities); +#endif + +#ifdef HAVE_GNUTLS3_HMAC + capabilities = Fcons (intern("macs"), capabilities); +#endif + +#endif + +#endif + # ifdef WINDOWSNT Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache); if (CONSP (found)) - return XCDR (found); + return XCDR (found); // TODO: use capabilities. else { Lisp_Object status; - status = init_gnutls_functions () ? Qt : Qnil; + // TODO: should the capabilities be dynamic here? + status = init_gnutls_functions () ? capabilities : Qnil; Vlibrary_cache = Fcons (Fcons (Qgnutls, status), Vlibrary_cache); return status; } # else /* !WINDOWSNT */ - return Qt; + return capabilities; # endif /* !WINDOWSNT */ #else /* !HAVE_GNUTLS */ return Qnil; @@ -1753,6 +2390,27 @@ syms_of_gnutls (void) DEFSYM (QCverify_flags, ":verify-flags"); DEFSYM (QCverify_error, ":verify-error"); + DEFSYM (QCcipher_id, ":cipher-id"); + DEFSYM (QCcipher_aead_capable, ":cipher-aead-capable"); + DEFSYM (QCcipher_blocksize, ":cipher-blocksize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_tagsize, ":cipher-tagsize"); + DEFSYM (QCcipher_keysize, ":cipher-keysize"); + DEFSYM (QCcipher_ivsize, ":cipher-ivsize"); + + DEFSYM (QCmac_algorithm_id, ":mac-algorithm-id"); + DEFSYM (QCmac_algorithm_noncesize, ":mac-algorithm-noncesize"); + DEFSYM (QCmac_algorithm_keysize, ":mac-algorithm-keysize"); + DEFSYM (QCmac_algorithm_length, ":mac-algorithm-length"); + + DEFSYM (QCdigest_algorithm_id, ":digest-algorithm-id"); + DEFSYM (QCdigest_algorithm_length, ":digest-algorithm-length"); + + DEFSYM (QCtype, ":type"); + DEFSYM (Qgnutls_type_cipher, "gnutls-symmetric-cipher"); + DEFSYM (Qgnutls_type_mac_algorithm, "gnutls-mac-algorithm"); + DEFSYM (Qgnutls_type_digest_algorithm, "gnutls-digest-algorithm"); + DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted"); Fput (Qgnutls_e_interrupted, Qgnutls_code, make_number (GNUTLS_E_INTERRUPTED)); @@ -1780,6 +2438,14 @@ syms_of_gnutls (void) defsubr (&Sgnutls_peer_status); defsubr (&Sgnutls_peer_status_warning_describe); + defsubr (&Sgnutls_ciphers); + defsubr (&Sgnutls_macs); + defsubr (&Sgnutls_digests); + defsubr (&Sgnutls_hash_mac); + defsubr (&Sgnutls_hash_digest); + defsubr (&Sgnutls_symmetric_encrypt); + defsubr (&Sgnutls_symmetric_decrypt); + DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level, doc: /* Logging level used by the GnuTLS functions. Set this larger than 0 to get debug output in the *Messages* buffer. diff --git a/src/gnutls.h b/src/gnutls.h index 3c84023cd4..981d59410b 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -23,6 +23,10 @@ along with GNU Emacs. If not, see . */ #include #include +#ifdef HAVE_GNUTLS3 +#include +#endif + #include "lisp.h" /* This limits the attempts to handshake per process (connection). It diff --git a/src/lisp.h b/src/lisp.h index 1e8ef7a449..a5134a9532 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3386,6 +3386,9 @@ enum { NEXT_ALMOST_PRIME_LIMIT = 11 }; extern EMACS_INT next_almost_prime (EMACS_INT) ATTRIBUTE_CONST; extern Lisp_Object larger_vector (Lisp_Object, ptrdiff_t, ptrdiff_t); extern void sweep_weak_hash_tables (void); +extern const char* extract_data_from_object (Lisp_Object spec, + ptrdiff_t *start_byte, + ptrdiff_t *end_byte); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, diff --git a/test/lisp/net/gnutls-tests.el b/test/lisp/net/gnutls-tests.el new file mode 100644 index 0000000000..7cef8c1ff1 --- /dev/null +++ b/test/lisp/net/gnutls-tests.el @@ -0,0 +1,290 @@ +;;; gnutls-tests.el --- Test suite for gnutls.el + +;; Copyright (C) 2017 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; Run this with `GNUTLS_TEST_VERBOSE=1' to get verbose debugging. + +;;; Code: + +(require 'ert) +(require 'cl) +(require 'gnutls) +(require 'hex-util) + +(defvar gnutls-tests-message-prefix "") + +(defsubst gnutls-tests-message (format-string &rest args) + (when (getenv "GNUTLS_TEST_VERBOSE") + (apply #'message (concat "gnutls-tests: " gnutls-tests-message-prefix format-string) args))) + +;; Minor convenience to see strings more easily (without binary data). +(defsubst gnutls-tests-hexstring-equal (a b) + (and (stringp a) (stringp b) (string-equal (encode-hex-string a) (encode-hex-string b)))) + +(defvar gnutls-tests-internal-macs-upcased + (mapcar (lambda (sym) (cons sym (intern (upcase (symbol-name sym))))) + (secure-hash-algorithms))) + +(defvar gnutls-tests-tested-macs + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-macs))))) + +(defvar gnutls-tests-tested-digests + (remove-duplicates + (append (mapcar 'cdr gnutls-tests-internal-macs-upcased) + (mapcar 'car (gnutls-digests))))) + +(defvar gnutls-tests-tested-ciphers + (remove-duplicates + ; these cause FPEs or SEGVs + (remove-if (lambda (e) (memq e '(ARCFOUR-128))) + (mapcar 'car (gnutls-ciphers))))) + +(defvar gnutls-tests-mondo-strings + (list + "" + "some data" + "lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data lots and lots of data " + "data and more data to go over the block limit!" + "data and more data to go over the block limit" + (format "some random data %d%d" (random) (random)))) + +(ert-deftest test-gnutls-000-availability () + "Test the GnuTLS hashes and ciphers availability." + (skip-unless (memq 'gnutls3 (gnutls-available-p))) + (setq gnutls-tests-message-prefix "availability: ") + (should (> (length gnutls-tests-internal-macs-upcased) 5)) + (let ((macs (gnutls-macs)) + (digests (gnutls-digests)) + (ciphers (gnutls-ciphers))) + (dolist (mac gnutls-tests-tested-macs) + (let ((plist (cdr (assq mac macs)))) + (gnutls-tests-message "MAC %s %S" mac plist) + (dolist (prop '(:mac-algorithm-id :mac-algorithm-length :mac-algorithm-keysize :mac-algorithm-noncesize)) + (should (plist-get plist prop))) + (should (eq 'gnutls-mac-algorithm (plist-get plist :type))))) + (dolist (digest gnutls-tests-tested-digests) + (let ((plist (cdr (assq digest digests)))) + (gnutls-tests-message "digest %s %S" digest plist) + (dolist (prop '(:digest-algorithm-id :digest-algorithm-length)) + (should (plist-get plist prop))) + (should (eq 'gnutls-digest-algorithm (plist-get plist :type))))) + (dolist (cipher gnutls-tests-tested-ciphers) + (let ((plist (cdr (assq cipher ciphers)))) + (gnutls-tests-message "cipher %s %S" cipher plist) + (dolist (prop '(:cipher-id :cipher-blocksize :cipher-keysize :cipher-ivsize)) + (should (plist-get plist prop))) + (should (eq 'gnutls-symmetric-cipher (plist-get plist :type))))))) + +(ert-deftest test-gnutls-000-data-extractions () + "Test the GnuTLS data extractions against the built-in `secure-hash'." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "data extraction: ") + (dolist (input gnutls-tests-mondo-strings) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (insert "not ASCII: не e английски") + (dolist (step '(0 1 2 3 4 5)) + (let ((spec (list (current-buffer) ; a buffer spec + (point-min) + (max (point-min) (- step (point-max))))) + (spec2 (list (buffer-string) ; a string spec + (point-min) + (max (point-min) (- step (point-max)))))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest 'MD5 spec) + (apply 'secure-hash 'md5 (append spec '(t))))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest 'MD5 spec2) + (apply 'secure-hash 'md5 (append spec2 '(t)))))))))) + +(ert-deftest test-gnutls-001-hashes-internal-digests () + "Test the GnuTLS hash digests against the built-in `secure-hash'." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "digest internal verification: ") + (let ((macs (gnutls-macs))) + (dolist (mcell gnutls-tests-internal-macs-upcased) + (let ((plist (cdr (assq (cdr mcell) macs)))) + (gnutls-tests-message "Checking digest MAC %S %S" mcell plist) + (dolist (input gnutls-tests-mondo-strings) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest (cdr mcell) (current-buffer)) + (secure-hash (car mcell) (current-buffer) nil nil t)))) + (should (gnutls-tests-hexstring-equal + (gnutls-hash-digest (cdr mcell) input) + (secure-hash (car mcell) input nil nil t)))))))) + +(ert-deftest test-gnutls-002-hashes-digests () + "Test some GnuTLS hash digests against pre-defined outputs." + (skip-unless (memq 'digests (gnutls-available-p))) + (setq gnutls-tests-message-prefix "digest external verification: ") + (let ((macs (gnutls-macs))) + (dolist (test '(("57edf4a22be3c955ac49da2e2107b67a" "12345678901234567890123456789012345678901234567890123456789012345678901234567890" MD5) + ("d174ab98d277d9f5a5611c2c9f419d9f" "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" MD5) + ("c3fcd3d76192e4007dfb496cca67e13b" "abcdefghijklmnopqrstuvwxyz" MD5) + ("f96b697d7cb7938d525a2f31aaf161d0" "message digest" MD5) + ("900150983cd24fb0d6963f7d28e17f72" "abc" MD5) + ("0cc175b9c0f1b6a831c399e269772661" "a" MD5) + ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" SHA1) + ("a9993e364706816aba3e25717850c26c9cd0d89d" "abc" "SHA1"))) ; check string ID for digest + (destructuring-bind (hash input mac) test + (let ((plist (cdr (assq mac macs))) + result resultb) + (gnutls-tests-message "%s %S" mac plist) + (setq result (encode-hex-string (gnutls-hash-digest mac input))) + (gnutls-tests-message "%S => result %S" test result) + (should (string-equal result hash)) + ;; Test buffer extraction + (with-temp-buffer + (insert input) + (setq resultb (encode-hex-string (gnutls-hash-digest mac (current-buffer)))) + (gnutls-tests-message "%S => result from buffer %S" test resultb) + (should (string-equal resultb hash)))))))) + +(ert-deftest test-gnutls-003-hashes-hmacs () + "Test some predefined GnuTLS HMAC outputs for SHA256." + (skip-unless (memq 'macs (gnutls-available-p))) + (setq gnutls-tests-message-prefix "HMAC verification: ") + (let ((macs (gnutls-macs))) + (dolist (test '(("f5c5021e60d9686fef3bb0414275fe4163bece61d9a95fec7a273746a437b986" "hello\n" "test" SHA256) + ("46b75292b81002fd873e89c532a1b8545d6efc9822ee938feba6de2723161a67" "more and more data goes into a file to exceed the buffer size" "test" SHA256) + ("81568ba71fa2c5f33cc84bf362466988f98eba3735479100b4e8908acad87ac4" "more and more data goes into a file to exceed the buffer size" "very long key goes here to exceed the key size" SHA256) + ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" "SHA256") ; check string ID for HMAC + ("4bc830005783a73b8112f4bd5f4aa5f92e05b51e9b55c0cd6f9a7bee48371def" "more and more data goes into a file to exceed the buffer size" "" SHA256))) + (destructuring-bind (hash input key mac) test + (let ((plist (cdr (assq mac macs))) + result) + (gnutls-tests-message "%s %S" mac plist) + (setq result (encode-hex-string (gnutls-hash-mac mac (copy-sequence key) input))) + (gnutls-tests-message "%S => result %S" test result) + (should (string-equal result hash))))))) + + +(defun gnutls-tests-pad-or-trim (s exact) + "Pad or trim string S to EXACT numeric size." + (if (and (consp s) (eq 'iv-auto (nth 0 s))) + s + (let ((e (number-to-string exact))) + (format (concat "%" e "." e "s") s)))) + +(defun gnutls-tests-pad-to-multiple (s blocksize) + "Pad string S to BLOCKSIZE numeric size." + (let* ((e (if (string= s "") + blocksize + (* blocksize (ceiling (length s) blocksize)))) + (out (concat s (make-string (- e (length s)) ? )))) + ;; (gnutls-tests-message "padding %S to length %d for blocksize %d: => %S" s e blocksize out) + out)) + +;; ;;; Testing from the command line: +;; ;;; echo e36a9d13c15a6df23a59a6337d6132b8f7cd5283cb4784b81141b52343a18e5f5e5ee8f5553c23167409dd222478bc30 | perl -lne 'print pack "H*", $_' | openssl enc -aes-128-ctr -d -nosalt -K 6d796b657932 -iv 696e697432 | od -x +(ert-deftest test-gnutls-004-symmetric-ciphers () + "Test the GnuTLS symmetric ciphers" + (skip-unless (memq 'ciphers (gnutls-available-p))) + (setq gnutls-tests-message-prefix "symmetric cipher verification: ") + ;; we expect at least 10 ciphers + (should (> (length (gnutls-ciphers)) 10)) + (let ((keys '("mykey" "mykey2")) + (inputs gnutls-tests-mondo-strings) + (ivs '("" "-abc123-" "init" "ini2")) + (ciphers (remove-if + (lambda (c) (plist-get (cdr (assq c (gnutls-ciphers))) + :cipher-aead-capable)) + gnutls-tests-tested-ciphers))) + + (dolist (cipher ciphers) + (dolist (iv ivs) + (dolist (input inputs) + (dolist (key keys) + (gnutls-tests-message "%S, starting key %S IV %S input %S" (assq cipher (gnutls-ciphers)) key iv input) + (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) + (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) + (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) + (iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) + (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input)) + (data (nth 0 output)) + (actual-iv (nth 1 output)) + (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data)) + (reverse (nth 0 reverse-output))) + (gnutls-tests-message "%s %S" cipher cplist) + (gnutls-tests-message "key %S IV %S input %S => hexdata %S and reverse %S" key iv input (encode-hex-string data) reverse) + (should-not (gnutls-tests-hexstring-equal input data)) + (should-not (gnutls-tests-hexstring-equal data reverse)) + (should (gnutls-tests-hexstring-equal input reverse))))))))) + +(ert-deftest test-gnutls-005-aead-ciphers () + "Test the GnuTLS AEAD ciphers" + (skip-unless (memq 'AEAD-ciphers (gnutls-available-p))) + (setq gnutls-tests-message-prefix "AEAD verification: ") + (let ((keys '("mykey" "mykey2")) + (inputs gnutls-tests-mondo-strings) + (ivs '("" "-abc123-" "init" "ini2")) + (auths '(nil + "" + "auth data" + "auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data auth and auth of data " + "AUTH data and more data to go over the block limit!" + "AUTH data and more data to go over the block limit")) + (ciphers (remove-if + (lambda (c) (or (null (plist-get (cdr (assq c (gnutls-ciphers))) + :cipher-aead-capable)))) + gnutls-tests-tested-ciphers)) + actual-ivlist) + + (dolist (cipher ciphers) + (dolist (input inputs) + (dolist (auth auths) + (dolist (key keys) + (let* ((cplist (cdr (assq cipher (gnutls-ciphers)))) + (key (gnutls-tests-pad-or-trim key (plist-get cplist :cipher-keysize))) + (input (gnutls-tests-pad-to-multiple input (plist-get cplist :cipher-blocksize))) + (ivsize (plist-get cplist :cipher-ivsize))) + (should (>= ivsize 12)) ; as per the RFC + (dolist (iv (append ivs (list (list 'iv-auto ivsize)))) + + (gnutls-tests-message "%S, starting key %S IV %S input %S auth %S" (assq cipher (gnutls-ciphers)) key iv input auth) + (let* ((iv (gnutls-tests-pad-or-trim iv (plist-get cplist :cipher-ivsize))) + (output (gnutls-symmetric-encrypt cplist (copy-sequence key) iv input (copy-sequence auth))) + (data (nth 0 output)) + (actual-iv (nth 1 output)) + (reverse-output (gnutls-symmetric-decrypt cplist (copy-sequence key) actual-iv data auth)) + (reverse (nth 0 reverse-output))) + ;; GNUTLS_RND_NONCE should be good enough to ensure this. + (should-not (member (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist)) + (cond + ((stringp iv) + (should (equal iv actual-iv))) + ((consp iv) + (push (secure-hash 'sha384 actual-iv 0 ivsize) actual-ivlist) + (gnutls-tests-message "IV list length: %d" (length actual-ivlist)))) + + (gnutls-tests-message "%s %S" cipher cplist) + (gnutls-tests-message "key %S IV %S input %S auth %S => hexdata %S and reverse %S" key iv input auth (encode-hex-string data) reverse) + (should-not (gnutls-tests-hexstring-equal input data)) + (should-not (gnutls-tests-hexstring-equal data reverse)) + (should (gnutls-tests-hexstring-equal input reverse))))))))))) + +(provide 'gnutls-tests) +;;; gnutls-tests.el ends here commit 0f3cc0b8245dfd7a9f6fcc95ec148be03fde8931 Author: Stefan Monnier Date: Fri Jul 14 10:29:10 2017 -0400 * lisp/emacs-lisp/cl-lib.el (cl--random-time): Remove as well It's also defined in cl-extra.el. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 3c9c622301..c183852fd3 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -288,11 +288,6 @@ If true return the decimal value of digit CHAR in RADIX." (let ((n (aref cl-digit-char-table char))) (and n (< n (or radix 10)) n))) -(defun cl--random-time () - (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) - (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) - v)) - (defconst cl-most-positive-float nil "The largest value that a Lisp float can hold. If your system supports infinities, this is the largest finite value. commit 1e09f8d379ef3e37132189b2760c3d14920d0f96 Author: Paul Eggert Date: Fri Jul 14 06:19:39 2017 -0700 Do not convert ij and IJ to compatibility chars * lisp/leim/quail/latin-alt.el: Omit lines for ij and IJ in Dutch. Problem reported by James Cloos (Bug#518#10). diff --git a/etc/NEWS b/etc/NEWS index 2034bcbf72..dd6d5465d8 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -360,6 +360,9 @@ variable of this kind to swap modifiers in Emacs. --- ** The 'dutch' input method no longer attempts to support Turkish too. +Also, it no longer converts 'IJ' and 'ij' to the compatibility +characters U+0132 LATIN CAPITAL LIGATURE IJ and U+0133 LATIN SMALL +LIGATURE IJ. +++ ** File name quoting by adding the prefix "/:" is now possible for the diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el index 0a048742f4..cc721343c5 100644 --- a/lisp/leim/quail/latin-alt.el +++ b/lisp/leim/quail/latin-alt.el @@ -1174,9 +1174,6 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' (quail-define-rules ("fl." ?ƒ) ;; LATIN SMALL LETTER F WITH HOOK (florin currency symbol) ("eur." ?€) ;; EURO SIGN - ;; “The 25th letter of the Dutch alphabet.” - ("ij" ?ij) ;; LATIN SMALL LIGATURE IJ - ("IJ" ?IJ) ;; LATIN CAPITAL LIGATURE IJ ;; “Trema on the second letter of vowel pair.” Yudit uses `:', not `"'. ("\"a" ?ä) ;; LATIN SMALL LETTER A WITH DIAERESIS ("\"e" ?ë) ;; LATIN SMALL LETTER E WITH DIAERESIS commit 3bdf5b21493828bb0e8c0c6b4559a89aade0357f Author: Toon Claes Date: Fri Jul 14 05:53:14 2017 -0700 Remove Turkish ligatures from Dutch input method * lisp/leim/quail/latin-alt.el: Remove Turkish ligatures (Bug#518). diff --git a/etc/NEWS b/etc/NEWS index 71a2da1b63..2034bcbf72 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -358,6 +358,9 @@ variable of this kind to swap modifiers in Emacs. --- ** New input methods: 'cyrillic-tuvan', 'polish-prefix'. +--- +** The 'dutch' input method no longer attempts to support Turkish too. + +++ ** File name quoting by adding the prefix "/:" is now possible for the local part of a remote file name. Thus, if you have a directory named diff --git a/lisp/leim/quail/latin-alt.el b/lisp/leim/quail/latin-alt.el index 6c0dab28b4..0a048742f4 100644 --- a/lisp/leim/quail/latin-alt.el +++ b/lisp/leim/quail/latin-alt.el @@ -1152,7 +1152,7 @@ Doubling the postfix separates the letter and postfix: e.g. a^^ -> a^ (quail-define-package "dutch" "Dutch" "NL" t "Dutch character mixfix input method. -Caters for French and Turkish as well as Dutch. +Caters for French and Dutch. | | examples ------------+---------+---------- @@ -1163,8 +1163,6 @@ Caters for French and Turkish as well as Dutch. acute | \\=' | a\\=' -> á grave | \\=` | a\\=` -> à circumflex | ^ | a^ -> â - Turkish | various | i/ -> ı s, -> ş g^ -> ğ I/ -> İ - | | S, -> Ş G^ -> Ğ ------------+---------+---------- | prefix | ------------+---------+---------- @@ -1226,15 +1224,6 @@ Doubling the postfix separates the letter and postfix: e.g. a\\='\\=' -> a\\=' ("I^" ?Î) ;; LATIN CAPITAL LETTER I WITH CIRCUMFLEX ("O^" ?Ô) ;; LATIN CAPITAL LETTER O WITH CIRCUMFLEX ("U^" ?Û) ;; LATIN CAPITAL LETTER U WITH CIRCUMFLEX - ;; “Follow the example of the Dutch POSIX locale, using ISO-8859-9 to - ;; cater to the many Turks in Dutch society.” Perhaps German methods - ;; should do so too. Follow turkish-alt-postfix here. - ("i/" ?ı) ;; LATIN SMALL LETTER I WITH NO DOT - ("s," ?ş) ;; LATIN SMALL LETTER S WITH CEDILLA - ("g^" ?ğ) ;; LATIN SMALL LETTER G WITH BREVE - ("I/" ?İ) ;; LATIN CAPITAL LETTER I WITH DOT ABOVE - ("S," ?Ş) ;; LATIN CAPITAL LETTER S WITH CEDILLA - ("G^" ?Ğ) ;; LATIN CAPITAL LETTER G WITH BREVE ) ;; Originally from Yudit, discussed with Albertas Agejevas commit 9dee1c884eb50ba282eb9dd2495c5269add25963 Author: Paul Eggert Date: Fri Jul 14 04:54:05 2017 -0700 Improve stack-overflow heuristic on GNU/Linux Problem reported by Steve Kemp (Bug#27585). * src/eval.c (near_C_stack_top): Remove. All uses replaced by current_thread->stack_top. (record_in_backtrace): Set current_thread->stack_top. This is for when the Lisp interpreter calls itself. * src/lread.c (read1): Set current_thread->stack_top. This is for recursive s-expression reads. * src/print.c (print_object): Set current_thread->stack_top. This is for recursive s-expression printing. * src/thread.c (mark_one_thread): Get stack top first. * src/thread.h (struct thread_state.stack_top): Now void *, not char *. diff --git a/src/eval.c b/src/eval.c index 8f293c9d30..e5900382de 100644 --- a/src/eval.c +++ b/src/eval.c @@ -213,13 +213,6 @@ backtrace_next (union specbinding *pdl) return pdl; } -/* Return a pointer to somewhere near the top of the C stack. */ -void * -near_C_stack_top (void) -{ - return backtrace_args (backtrace_top ()); -} - void init_eval_once (void) { @@ -2090,7 +2083,7 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) specpdl_ptr->bt.kind = SPECPDL_BACKTRACE; specpdl_ptr->bt.debug_on_exit = false; specpdl_ptr->bt.function = function; - specpdl_ptr->bt.args = args; + current_thread->stack_top = specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; grow_specpdl (); diff --git a/src/lisp.h b/src/lisp.h index f5cb6c7570..1e8ef7a449 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3874,7 +3874,6 @@ extern Lisp_Object vformat_string (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); extern void un_autoload (Lisp_Object); extern Lisp_Object call_debugger (Lisp_Object arg); -extern void *near_C_stack_top (void); extern void init_eval_once (void); extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...); extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object); diff --git a/src/lread.c b/src/lread.c index fe5de38267..901e40b348 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2676,6 +2676,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) bool uninterned_symbol = false; bool multibyte; char stackbuf[MAX_ALLOCA]; + current_thread->stack_top = stackbuf; *pch = 0; diff --git a/src/print.c b/src/print.c index b6ea3ff62a..12edf01589 100644 --- a/src/print.c +++ b/src/print.c @@ -1748,7 +1748,7 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag) char buf[max (sizeof "from..to..in " + 2 * INT_STRLEN_BOUND (EMACS_INT), max (sizeof " . #" + INT_STRLEN_BOUND (printmax_t), 40))]; - + current_thread->stack_top = buf; maybe_quit (); /* Detect circularities and truncate them. */ diff --git a/src/sysdep.c b/src/sysdep.c index b52236769e..db99f53299 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -1772,7 +1772,7 @@ stack_overflow (siginfo_t *siginfo) /* The known top and bottom of the stack. The actual stack may extend a bit beyond these boundaries. */ char *bot = stack_bottom; - char *top = near_C_stack_top (); + char *top = current_thread->stack_top; /* Log base 2 of the stack heuristic ratio. This ratio is the size of the known stack divided by the size of the guard area past the diff --git a/src/thread.c b/src/thread.c index e3787971a5..1f7ced386d 100644 --- a/src/thread.c +++ b/src/thread.c @@ -595,14 +595,15 @@ thread_select (select_func *func, int max_fds, fd_set *rfds, static void mark_one_thread (struct thread_state *thread) { - struct handler *handler; - Lisp_Object tem; + /* Get the stack top now, in case mark_specpdl changes it. */ + void *stack_top = thread->stack_top; mark_specpdl (thread->m_specpdl, thread->m_specpdl_ptr); - mark_stack (thread->m_stack_bottom, thread->stack_top); + mark_stack (thread->m_stack_bottom, stack_top); - for (handler = thread->m_handlerlist; handler; handler = handler->next) + for (struct handler *handler = thread->m_handlerlist; + handler; handler = handler->next) { mark_object (handler->tag_or_ch); mark_object (handler->val); @@ -610,6 +611,7 @@ mark_one_thread (struct thread_state *thread) if (thread->m_current_buffer) { + Lisp_Object tem; XSETBUFFER (tem, thread->m_current_buffer); mark_object (tem); } diff --git a/src/thread.h b/src/thread.h index 9e94de5c17..52b16f1ba8 100644 --- a/src/thread.h +++ b/src/thread.h @@ -62,8 +62,14 @@ struct thread_state char *m_stack_bottom; #define stack_bottom (current_thread->m_stack_bottom) - /* An address near the top of the stack. */ - char *stack_top; + /* The address of an object near the C stack top, used to determine + which words need to be scanned by the garbage collector. This is + also used to detect heuristically whether segmentation violation + address indicates stack overflow, as opposed to some internal + error in Emacs. If the C function F calls G which calls H which + calls ... F, then at least one of the functions in the chain + should set this to the address of a local variable. */ + void *stack_top; struct catchtag *m_catchlist; #define catchlist (current_thread->m_catchlist) commit 6443a95ad74d54b8be5ba85af9b893f3f1d5fa02 Author: Paul Eggert Date: Fri Jul 14 02:47:30 2017 -0700 Remove duplicate cl--random-state definition * lisp/emacs-lisp/cl-lib.el (cl--random-state): Remove. This variable is now defined in cl-extra.el (Bug#27617). diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 936c852526..3c9c622301 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -293,9 +293,6 @@ If true return the decimal value of digit CHAR in RADIX." (while (>= (cl-decf i) 0) (setq v (+ (* v 3) (aref time i)))) v)) -(defvar cl--random-state - (vector 'cl--random-state-tag -1 30 (cl--random-time))) - (defconst cl-most-positive-float nil "The largest value that a Lisp float can hold. If your system supports infinities, this is the largest finite value. commit 05c7c8278eba6faf8c4fcf89f4bb7912f36fdc12 Author: Michael Albinus Date: Fri Jul 14 10:55:31 2017 +0200 Adjust timer in tramp-test36-asynchronous-requests * test/lisp/net/tramp-tests.el (tramp-test36-asynchronous-requests): Adjust timer if it takes too much time. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 263e135906..07d319bce0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3726,12 +3726,18 @@ process sentinels. They shall not disturb each other." 0 timer-repeat (lambda () (when buffers - (let ((default-directory tmp-name) + (let ((time (float-time)) + (default-directory tmp-name) (file (buffer-name (nth (random (length buffers)) buffers)))) (tramp--test-message "Start timer %s %s" file (current-time-string)) (funcall timer-operation file) + ;; Adjust timer if it takes too much time. + (when (> (- (float-time) time) timer-repeat) + (setq timer-repeat (* 1.5 timer-repeat)) + (setf (timer--repeat-delay timer) timer-repeat) + (tramp--test-message "Increase timer %s" timer-repeat)) (tramp--test-message "Stop timer %s %s" file (current-time-string))))))) commit 4d3657af329cb001fa4a1d74b214c349e66185da Author: Eli Zaretskii Date: Fri Jul 14 11:39:25 2017 +0300 Always display rmail progress report under user control * lisp/mail/rmail.el (rmail-show-message-1): Delete the second copy of '(message "Showing message %d..." msg)'. (Bug#27535) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index df07140d87..b240588289 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -2828,8 +2828,6 @@ The current mail message becomes the message displayed." (re-search-forward "mime-version: 1.0" nil t)) (let ((rmail-buffer mbox-buf) (rmail-view-buffer view-buf)) - (setq showing-message t) - (message "Showing message %d..." msg) (set (make-local-variable 'rmail-mime-decoded) t) (funcall rmail-show-mime-function)) (setq body-start (search-forward "\n\n" nil t)) commit 60d24e1681c5a4bf43c943825dd2b5df42d8419c Author: Eli Zaretskii Date: Fri Jul 14 11:33:46 2017 +0300 Avoid byte-compilation warnings for advised functions * lisp/files.el (insert-directory, create-file-buffer): Add an advertised-calling-convention form to shut up byte-compilation warnings. (Bug#14860) diff --git a/lisp/files.el b/lisp/files.el index 2f3efa33c2..646387f8c8 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1821,6 +1821,10 @@ otherwise a string <2> or <3> or ... is appended to get an unused name. Emacs treats buffers whose names begin with a space as internal buffers. To avoid confusion when visiting a file whose name begins with a space, this function prepends a \"|\" to the final result if necessary." + ;; We need the following 'declare' form to shut up the byte + ;; compiler, which displays a bogus warning for advised functions, + ;; see bug#14860. + (declare (advertised-calling-convention (filename) "18.59")) (let ((lastname (file-name-nondirectory filename))) (if (string= lastname "") (setq lastname filename)) @@ -6590,6 +6594,11 @@ When SWITCHES contains the long `--dired' option, this function treats it specially, for the sake of dired. However, the normally equivalent short `-D' option is just passed on to `insert-directory-program', as any other option." + ;; We need the following 'declare' form to shut up the byte + ;; compiler, which displays a bogus warning for advised functions, + ;; see bug#14860. + (declare (advertised-calling-convention + (file switches &optional wildcard full-directory-p) "19.34")) ;; We need the directory in order to find the right handler. (let ((handler (find-file-name-handler (expand-file-name file) 'insert-directory))) commit 037d8bdfeb905f0f1f49c5c7ab2deba13c9c6617 Author: Eli Zaretskii Date: Fri Jul 14 11:00:25 2017 +0300 Add assertion related to display-line-numbers * src/xdisp.c (maybe_produce_line_number): Add assertion for the condition regarding IT->glyph_row->used[TEXT_AREA] expected by the code. (Bug#27668) diff --git a/src/xdisp.c b/src/xdisp.c index 85b9eae36d..2aceb89c00 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21009,6 +21009,8 @@ maybe_produce_line_number (struct it *it) struct glyph *p = it->glyph_row ? it->glyph_row->glyphs[TEXT_AREA] : NULL; short *u = it->glyph_row ? &it->glyph_row->used[TEXT_AREA] : NULL; + eassert (it->glyph_row == NULL || it->glyph_row->used[TEXT_AREA] == 0); + for ( ; g < e; g++) { it->current_x += g->pixel_width; commit 6fa3176ccae2bd8dcf082b80063c4e2148f5e8fd Author: Eli Zaretskii Date: Fri Jul 14 10:53:36 2017 +0300 Prevent display corruption when display-line-numbers is set * src/xdisp.c (try_window_reusing_current_matrix): If giving up due to display-line-numbers, clear the window's desired glyph matrix before returning, as the following call to try_window will call display_line, which expects rows of the desired matrix cleared. (Bug#27668) diff --git a/src/xdisp.c b/src/xdisp.c index 6b0532d95f..85b9eae36d 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -17655,6 +17655,9 @@ try_window_reusing_current_matrix (struct window *w) if (w->vscroll || MATRIX_ROW_PARTIALLY_VISIBLE_P (w, start_row)) return false; + /* Clear the desired matrix for the display below. */ + clear_glyph_matrix (w->desired_matrix); + /* Give up if line numbers are being displayed, because reusing the current matrix might use the wrong width for line-number display. */ @@ -17667,9 +17670,6 @@ try_window_reusing_current_matrix (struct window *w) start = start_row->minpos; start_vpos = MATRIX_ROW_VPOS (start_row, w->current_matrix); - /* Clear the desired matrix for the display below. */ - clear_glyph_matrix (w->desired_matrix); - if (CHARPOS (new_start) <= CHARPOS (start)) { /* Don't use this method if the display starts with an ellipsis commit 5c9b6e901ca97895c6224f32f1a9ca4a7d565b65 Author: Eli Zaretskii Date: Fri Jul 14 09:24:44 2017 +0300 Revert "Use fixed-pitch font for display-line-numbers" This reverts commit d014a5e15c1110af77e7a96f06ccd0f0cafb099f. * lisp/faces.el (line-number): Don't use a fixed-pitch font, by popular demand. For relevant discussions, see http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00433.html http://lists.gnu.org/archive/html/emacs-devel/2017-07/msg00445.html diff --git a/lisp/faces.el b/lisp/faces.el index e073ed266c..c3693d1663 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2465,12 +2465,9 @@ If you set `term-file-prefix' to nil, this function does nothing." :version "21.1" :group 'basic-faces) -;; Definition originally stolen from linum.el. -;; The monospace part is so we don't accidentally display numbers -;; using a variable-pitch font just because the default face uses -;; such a font. +;; Definition stolen from linum.el. (defface line-number - '((t :inherit (shadow default) :family "Monospace Serif")) + '((t :inherit (shadow default))) "Face for displaying line numbers. This face is used when `display-line-numbers' is non-nil. commit 3128d5d10e702ccb0732d947370e539a54046fc9 Author: Paul Eggert Date: Thu Jul 13 19:24:06 2017 -0700 Merge from gnulib This incorporates: 2017-07-13 Improve cross-compilation guesses for native Windows 2017-07-11 More systematic m4 quoting and indentation 2017-07-10 Make sure $host and $host_os are defined when used 2017-07-03 stdioext: Port to OpenVMS 2017-06-24 xalloc-oversized: port to icc * doc/misc/texinfo.tex, lib/fpending.c, lib/stdio-impl.h: * lib/xalloc-oversized.h, m4/dirfd.m4, m4/gettimeofday.m4: * m4/lstat.m4, m4/mktime.m4, m4/pselect.m4, m4/putenv.m4: * m4/stdint.m4, m4/strtoimax.m4, m4/utimes.m4: Copy from Gnulib. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index b40a6e2a2b..3844333fae 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2017-06-04.19} +\def\texinfoversion{2017-07-04.16} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -11009,7 +11009,6 @@ \DeclareUnicodeCharacter{2113}{\ensuremath\ell}% \DeclareUnicodeCharacter{2118}{\ensuremath\wp}% \DeclareUnicodeCharacter{211C}{\ensuremath\Re}% - \DeclareUnicodeCharacter{2127}{\ensuremath\mho}% \DeclareUnicodeCharacter{2135}{\ensuremath\aleph}% \DeclareUnicodeCharacter{2190}{\ensuremath\leftarrow}% \DeclareUnicodeCharacter{2191}{\ensuremath\uparrow}% @@ -11025,7 +11024,6 @@ \DeclareUnicodeCharacter{21AA}{\ensuremath\hookrightarrow}% \DeclareUnicodeCharacter{21BC}{\ensuremath\leftharpoonup}% \DeclareUnicodeCharacter{21BD}{\ensuremath\leftharpoondown}% - \DeclareUnicodeCharacter{21BE}{\ensuremath\upharpoonright}% \DeclareUnicodeCharacter{21C0}{\ensuremath\rightharpoonup}% \DeclareUnicodeCharacter{21C1}{\ensuremath\rightharpoondown}% \DeclareUnicodeCharacter{21CC}{\ensuremath\rightleftharpoons}% @@ -11034,8 +11032,6 @@ \DeclareUnicodeCharacter{21D3}{\ensuremath\Downarrow}% \DeclareUnicodeCharacter{21D4}{\ensuremath\Leftrightarrow}% \DeclareUnicodeCharacter{21D5}{\ensuremath\Updownarrow}% - \DeclareUnicodeCharacter{21DD}{\ensuremath\leadsto}% - \DeclareUnicodeCharacter{2201}{\ensuremath\complement}% \DeclareUnicodeCharacter{2202}{\ensuremath\partial}% \DeclareUnicodeCharacter{2205}{\ensuremath\emptyset}% \DeclareUnicodeCharacter{2207}{\ensuremath\nabla}% @@ -11069,8 +11065,6 @@ \DeclareUnicodeCharacter{2283}{\ensuremath\supset}% \DeclareUnicodeCharacter{2286}{\ensuremath\subseteq}% \DeclareUnicodeCharacter{228E}{\ensuremath\uplus}% - \DeclareUnicodeCharacter{228F}{\ensuremath\sqsubset}% - \DeclareUnicodeCharacter{2290}{\ensuremath\sqsupset}% \DeclareUnicodeCharacter{2291}{\ensuremath\sqsubseteq}% \DeclareUnicodeCharacter{2292}{\ensuremath\sqsupseteq}% \DeclareUnicodeCharacter{2293}{\ensuremath\sqcap}% @@ -11085,8 +11079,6 @@ \DeclareUnicodeCharacter{22A4}{\ensuremath\ptextop}% \DeclareUnicodeCharacter{22A5}{\ensuremath\bot}% \DeclareUnicodeCharacter{22A8}{\ensuremath\models}% - \DeclareUnicodeCharacter{22B4}{\ensuremath\unlhd}% - \DeclareUnicodeCharacter{22B5}{\ensuremath\unrhd}% \DeclareUnicodeCharacter{22C0}{\ensuremath\bigwedge}% \DeclareUnicodeCharacter{22C1}{\ensuremath\bigvee}% \DeclareUnicodeCharacter{22C2}{\ensuremath\bigcap}% @@ -11102,12 +11094,11 @@ \DeclareUnicodeCharacter{2322}{\ensuremath\frown}% \DeclareUnicodeCharacter{2323}{\ensuremath\smile}% % - \DeclareUnicodeCharacter{25A1}{\ensuremath\Box}% \DeclareUnicodeCharacter{25B3}{\ensuremath\triangle}% \DeclareUnicodeCharacter{25B7}{\ensuremath\triangleright}% \DeclareUnicodeCharacter{25BD}{\ensuremath\bigtriangledown}% \DeclareUnicodeCharacter{25C1}{\ensuremath\triangleleft}% - \DeclareUnicodeCharacter{25C7}{\ensuremath\Diamond}% + \DeclareUnicodeCharacter{25C7}{\ensuremath\diamond}% \DeclareUnicodeCharacter{2660}{\ensuremath\spadesuit}% \DeclareUnicodeCharacter{2661}{\ensuremath\heartsuit}% \DeclareUnicodeCharacter{2662}{\ensuremath\diamondsuit}% @@ -11129,7 +11120,6 @@ \DeclareUnicodeCharacter{2A02}{\ensuremath\bigotimes}% \DeclareUnicodeCharacter{2A04}{\ensuremath\biguplus}% \DeclareUnicodeCharacter{2A06}{\ensuremath\bigsqcup}% - \DeclareUnicodeCharacter{2A1D}{\ensuremath\Join}% \DeclareUnicodeCharacter{2A3F}{\ensuremath\amalg}% \DeclareUnicodeCharacter{2AAF}{\ensuremath\preceq}% \DeclareUnicodeCharacter{2AB0}{\ensuremath\succeq}% diff --git a/lib/fpending.c b/lib/fpending.c index c9b7786685..02602a1c27 100644 --- a/lib/fpending.c +++ b/lib/fpending.c @@ -41,7 +41,7 @@ __fpending (FILE *fp) return fp->_ptr - fp->_buffer; #elif defined __minix /* Minix */ return fp_->_ptr - fp_->_buf; -#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, mingw, MSVC, NonStop Kernel */ +#elif defined _IOERR /* AIX, HP-UX, IRIX, OSF/1, Solaris, OpenServer, mingw, MSVC, NonStop Kernel, OpenVMS */ return (fp_->_ptr ? fp_->_ptr - fp_->_base : 0); #elif defined __UCLIBC__ /* uClibc */ return (fp->__modeflags & __FLAG_WRITING ? fp->__bufpos - fp->__bufstart : 0); @@ -51,8 +51,6 @@ __fpending (FILE *fp) return fp->__bufp - fp->__buffer; #elif defined EPLAN9 /* Plan9 */ return fp->wp - fp->buf; -#elif defined __VMS /* VMS */ - return (*fp)->_ptr - (*fp)->_base; #else # error "Please port gnulib fpending.c to your platform!" return 1; diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h index 75a945eb72..d5b5943fd7 100644 --- a/lib/stdio-impl.h +++ b/lib/stdio-impl.h @@ -99,6 +99,8 @@ int _file; \ unsigned int _flag; \ } *) fp) +# elif defined __VMS /* OpenVMS */ +# define fp_ ((struct _iobuf *) fp) # else # define fp_ fp # endif diff --git a/lib/xalloc-oversized.h b/lib/xalloc-oversized.h index ff0efc6ba4..2e09bab0be 100644 --- a/lib/xalloc-oversized.h +++ b/lib/xalloc-oversized.h @@ -44,7 +44,7 @@ typedef size_t __xalloc_count_type; #if 7 <= __GNUC__ # define xalloc_oversized(n, s) \ __builtin_mul_overflow_p (n, s, (__xalloc_count_type) 1) -#elif 5 <= __GNUC__ && !__STRICT_ANSI__ +#elif 5 <= __GNUC__ && !defined __ICC && !__STRICT_ANSI__ # define xalloc_oversized(n, s) \ (__builtin_constant_p (n) && __builtin_constant_p (s) \ ? __xalloc_oversized (n, s) \ diff --git a/m4/dirfd.m4 b/m4/dirfd.m4 index b4ec3d1910..d472c38549 100644 --- a/m4/dirfd.m4 +++ b/m4/dirfd.m4 @@ -1,4 +1,4 @@ -# serial 24 -*- Autoconf -*- +# serial 26 -*- Autoconf -*- dnl Find out how to get the file descriptor associated with an open DIR*. @@ -12,6 +12,7 @@ dnl From Jim Meyering AC_DEFUN([gl_FUNC_DIRFD], [ AC_REQUIRE([gl_DIRENT_H_DEFAULTS]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles dnl Persuade glibc to declare dirfd(). AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) @@ -25,15 +26,15 @@ AC_DEFUN([gl_FUNC_DIRFD], fi AC_CACHE_CHECK([whether dirfd is a macro], - gl_cv_func_dirfd_macro, + [gl_cv_func_dirfd_macro], [AC_EGREP_CPP([dirent_header_defines_dirfd], [ #include #include #ifdef dirfd dirent_header_defines_dirfd #endif], - gl_cv_func_dirfd_macro=yes, - gl_cv_func_dirfd_macro=no)]) + [gl_cv_func_dirfd_macro=yes], + [gl_cv_func_dirfd_macro=no])]) # Use the replacement if we have no function or macro with that name, # or if OS/2 kLIBC whose dirfd() does not work. diff --git a/m4/gettimeofday.m4 b/m4/gettimeofday.m4 index 8ee206eea2..efa114dfaf 100644 --- a/m4/gettimeofday.m4 +++ b/m4/gettimeofday.m4 @@ -1,4 +1,4 @@ -# serial 23 +# serial 24 # Copyright (C) 2001-2003, 2005, 2007, 2009-2017 Free Software Foundation, Inc. # This file is free software; the Free Software Foundation @@ -105,6 +105,8 @@ AC_DEFUN([gl_FUNC_GETTIMEOFDAY_CLOBBER], case "$host_os" in # Guess all is fine on glibc systems. *-gnu*) gl_cv_func_gettimeofday_clobber="guessing no" ;; + # Guess no on native Windows. + mingw*) gl_cv_func_gettimeofday_clobber="guessing no" ;; # If we don't know, assume the worst. *) gl_cv_func_gettimeofday_clobber="guessing yes" ;; esac diff --git a/m4/lstat.m4 b/m4/lstat.m4 index 953c117d80..0b6e5d70cb 100644 --- a/m4/lstat.m4 +++ b/m4/lstat.m4 @@ -1,4 +1,4 @@ -# serial 27 +# serial 29 # Copyright (C) 1997-2001, 2003-2017 Free Software Foundation, Inc. # @@ -33,6 +33,7 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK], [ dnl We don't use AC_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK any more, because it dnl is no longer maintained in Autoconf and because it invokes AC_LIBOBJ. + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_CACHE_CHECK([whether lstat correctly handles trailing slash], [gl_cv_func_lstat_dereferences_slashed_symlink], [rm -f conftest.sym conftest.file @@ -54,6 +55,9 @@ AC_DEFUN([gl_FUNC_LSTAT_FOLLOWS_SLASHED_SYMLINK], *-gnu*) # Guess yes on glibc systems. gl_cv_func_lstat_dereferences_slashed_symlink="guessing yes" ;; + mingw*) + # Guess no on native Windows. + gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;; *) # If we don't know, assume the worst. gl_cv_func_lstat_dereferences_slashed_symlink="guessing no" ;; diff --git a/m4/mktime.m4 b/m4/mktime.m4 index 31da65e8b2..85666844e2 100644 --- a/m4/mktime.m4 +++ b/m4/mktime.m4 @@ -1,4 +1,4 @@ -# serial 28 +# serial 29 dnl Copyright (C) 2002-2003, 2005-2007, 2009-2017 Free Software Foundation, dnl Inc. dnl This file is free software; the Free Software Foundation @@ -25,6 +25,7 @@ dnl Test whether mktime works. Set gl_cv_func_working_mktime. AC_DEFUN([gl_FUNC_MKTIME_WORKS], [ AC_REQUIRE([gl_TIME_T_IS_SIGNED]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles dnl We don't use AC_FUNC_MKTIME any more, because it is no longer maintained dnl in Autoconf and because it invokes AC_LIBOBJ. @@ -239,7 +240,12 @@ main () }]])], [gl_cv_func_working_mktime=yes], [gl_cv_func_working_mktime=no], - [gl_cv_func_working_mktime="guessing no"]) + [case "$host_os" in + # Guess no on native Windows. + mingw*) gl_cv_func_working_mktime="guessing no" ;; + *) gl_cv_func_working_mktime="guessing no" ;; + esac + ]) ]) ]) diff --git a/m4/pselect.m4 b/m4/pselect.m4 index 3f1c43f650..eb1ad115cc 100644 --- a/m4/pselect.m4 +++ b/m4/pselect.m4 @@ -1,4 +1,4 @@ -# pselect.m4 serial 2 +# pselect.m4 serial 4 dnl Copyright (C) 2011-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -8,11 +8,12 @@ AC_DEFUN([gl_FUNC_PSELECT], [ AC_REQUIRE([gl_HEADER_SYS_SELECT]) AC_REQUIRE([AC_C_RESTRICT]) + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_CHECK_FUNCS_ONCE([pselect]) if test $ac_cv_func_pselect = yes; then AC_CACHE_CHECK([whether signature of pselect conforms to POSIX], - gl_cv_sig_pselect, + [gl_cv_sig_pselect], [AC_LINK_IFELSE( [AC_LANG_PROGRAM( [[#include diff --git a/m4/putenv.m4 b/m4/putenv.m4 index a8e3ab33dc..08ae41697a 100644 --- a/m4/putenv.m4 +++ b/m4/putenv.m4 @@ -1,4 +1,4 @@ -# putenv.m4 serial 20 +# putenv.m4 serial 21 dnl Copyright (C) 2002-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -36,6 +36,8 @@ AC_DEFUN([gl_FUNC_PUTENV], [case "$host_os" in # Guess yes on glibc systems. *-gnu*) gl_cv_func_svid_putenv="guessing yes" ;; + # Guess no on native Windows. + mingw*) gl_cv_func_svid_putenv="guessing no" ;; # If we don't know, assume the worst. *) gl_cv_func_svid_putenv="guessing no" ;; esac diff --git a/m4/stdint.m4 b/m4/stdint.m4 index 4ac854d519..4bf3e47451 100644 --- a/m4/stdint.m4 +++ b/m4/stdint.m4 @@ -1,4 +1,4 @@ -# stdint.m4 serial 50 +# stdint.m4 serial 51 dnl Copyright (C) 2001-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -10,6 +10,7 @@ dnl Test whether is supported or must be substituted. AC_DEFUN_ONCE([gl_STDINT_H], [ AC_PREREQ([2.59])dnl + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_REQUIRE([gl_LIMITS_H]) AC_REQUIRE([gt_TYPE_WINT_T]) @@ -288,8 +289,12 @@ static const char *macro_values[] = ]])], [gl_cv_header_working_stdint_h=yes], [], - [dnl When cross-compiling, assume it works. - gl_cv_header_working_stdint_h=yes + [case "$host_os" in + # Guess yes on native Windows. + mingw*) gl_cv_header_working_stdint_h="guessing yes" ;; + # In general, assume it works. + *) gl_cv_header_working_stdint_h="guessing yes" ;; + esac ]) ]) ]) @@ -299,15 +304,16 @@ static const char *macro_values[] = HAVE_SYS_BITYPES_H=0 HAVE_SYS_INTTYPES_H=0 STDINT_H=stdint.h - if test "$gl_cv_header_working_stdint_h" = yes; then - HAVE_C99_STDINT_H=1 - dnl Now see whether the system works without - dnl __STDC_CONSTANT_MACROS/__STDC_LIMIT_MACROS defined. - AC_CACHE_CHECK([whether stdint.h predates C++11], - [gl_cv_header_stdint_predates_cxx11_h], - [gl_cv_header_stdint_predates_cxx11_h=yes - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM([[ + case "$gl_cv_header_working_stdint_h" in + *yes) + HAVE_C99_STDINT_H=1 + dnl Now see whether the system works without + dnl __STDC_CONSTANT_MACROS/__STDC_LIMIT_MACROS defined. + AC_CACHE_CHECK([whether stdint.h predates C++11], + [gl_cv_header_stdint_predates_cxx11_h], + [gl_cv_header_stdint_predates_cxx11_h=yes + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM([[ #define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ #include ] @@ -315,45 +321,47 @@ gl_STDINT_INCLUDES [ intmax_t im = INTMAX_MAX; int32_t i32 = INT32_C (0x7fffffff); - ]])], - [gl_cv_header_stdint_predates_cxx11_h=no])]) + ]])], + [gl_cv_header_stdint_predates_cxx11_h=no])]) - if test "$gl_cv_header_stdint_predates_cxx11_h" = yes; then - AC_DEFINE([__STDC_CONSTANT_MACROS], [1], - [Define to 1 if the system predates C++11.]) - AC_DEFINE([__STDC_LIMIT_MACROS], [1], - [Define to 1 if the system predates C++11.]) - fi - AC_CACHE_CHECK([whether stdint.h has UINTMAX_WIDTH etc.], - [gl_cv_header_stdint_width], - [gl_cv_header_stdint_width=no - AC_COMPILE_IFELSE( - [AC_LANG_PROGRAM([[ - /* Work if build is not clean. */ - #define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 - #ifndef __STDC_WANT_IEC_60559_BFP_EXT__ - #define __STDC_WANT_IEC_60559_BFP_EXT__ 1 - #endif - #include - ]gl_STDINT_INCLUDES[ - int iw = UINTMAX_WIDTH; - ]])], - [gl_cv_header_stdint_width=yes])]) - if test "$gl_cv_header_stdint_width" = yes; then - STDINT_H= - fi - else - dnl Check for , and for - dnl (used in Linux libc4 >= 4.6.7 and libc5). - AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h]) - if test $ac_cv_header_sys_inttypes_h = yes; then - HAVE_SYS_INTTYPES_H=1 - fi - if test $ac_cv_header_sys_bitypes_h = yes; then - HAVE_SYS_BITYPES_H=1 - fi - gl_STDINT_TYPE_PROPERTIES - fi + if test "$gl_cv_header_stdint_predates_cxx11_h" = yes; then + AC_DEFINE([__STDC_CONSTANT_MACROS], [1], + [Define to 1 if the system predates C++11.]) + AC_DEFINE([__STDC_LIMIT_MACROS], [1], + [Define to 1 if the system predates C++11.]) + fi + AC_CACHE_CHECK([whether stdint.h has UINTMAX_WIDTH etc.], + [gl_cv_header_stdint_width], + [gl_cv_header_stdint_width=no + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ + /* Work if build is not clean. */ + #define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 + #ifndef __STDC_WANT_IEC_60559_BFP_EXT__ + #define __STDC_WANT_IEC_60559_BFP_EXT__ 1 + #endif + #include + ]gl_STDINT_INCLUDES[ + int iw = UINTMAX_WIDTH; + ]])], + [gl_cv_header_stdint_width=yes])]) + if test "$gl_cv_header_stdint_width" = yes; then + STDINT_H= + fi + ;; + *) + dnl Check for , and for + dnl (used in Linux libc4 >= 4.6.7 and libc5). + AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h]) + if test $ac_cv_header_sys_inttypes_h = yes; then + HAVE_SYS_INTTYPES_H=1 + fi + if test $ac_cv_header_sys_bitypes_h = yes; then + HAVE_SYS_BITYPES_H=1 + fi + gl_STDINT_TYPE_PROPERTIES + ;; + esac dnl The substitute stdint.h needs the substitute limit.h's _GL_INTEGER_WIDTH. LIMITS_H=limits.h diff --git a/m4/strtoimax.m4 b/m4/strtoimax.m4 index f0586f1a80..61809c8b5d 100644 --- a/m4/strtoimax.m4 +++ b/m4/strtoimax.m4 @@ -1,4 +1,4 @@ -# strtoimax.m4 serial 14 +# strtoimax.m4 serial 15 dnl Copyright (C) 2002-2004, 2006, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -61,10 +61,12 @@ int main () [gl_cv_func_strtoimax=yes], [gl_cv_func_strtoimax=no], [case "$host_os" in - # Guess no on AIX 5. - aix5*) gl_cv_func_strtoimax="guessing no" ;; - # Guess yes otherwise. - *) gl_cv_func_strtoimax="guessing yes" ;; + # Guess no on AIX 5. + aix5*) gl_cv_func_strtoimax="guessing no" ;; + # Guess yes on native Windows. + mingw*) gl_cv_func_strtoimax="guessing yes" ;; + # Guess yes otherwise. + *) gl_cv_func_strtoimax="guessing yes" ;; esac ]) ]) diff --git a/m4/utimes.m4 b/m4/utimes.m4 index 518824f218..847b2eba78 100644 --- a/m4/utimes.m4 +++ b/m4/utimes.m4 @@ -1,5 +1,5 @@ # Detect some bugs in glibc's implementation of utimes. -# serial 4 +# serial 5 dnl Copyright (C) 2003-2005, 2009-2017 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation @@ -20,10 +20,10 @@ dnl with or without modifications, as long as this notice is preserved. AC_DEFUN([gl_FUNC_UTIMES], [ + AC_REQUIRE([AC_CANONICAL_HOST]) dnl for cross-compiles AC_CACHE_CHECK([whether the utimes function works], [gl_cv_func_working_utimes], - [ - AC_RUN_IFELSE([AC_LANG_SOURCE([[ + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include #include #include @@ -142,9 +142,17 @@ main () ]])], [gl_cv_func_working_utimes=yes], [gl_cv_func_working_utimes=no], - [gl_cv_func_working_utimes=no])]) + [case "$host_os" in + # Guess no on native Windows. + mingw*) gl_cv_func_working_utimes="guessing no" ;; + *) gl_cv_func_working_utimes="guessing no" ;; + esac + ]) + ]) - if test $gl_cv_func_working_utimes = yes; then - AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly.]) - fi + case "$gl_cv_func_working_utimes" in + *yes) + AC_DEFINE([HAVE_WORKING_UTIMES], [1], [Define if utimes works properly.]) + ;; + esac ]) commit ab87dbad1d26fba4e33b62b4b5a840be77ae9aa5 Merge: b048351a0f 7eef16a923 Author: Vincent Belaïche Date: Thu Jul 13 23:25:34 2017 +0200 Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs commit 7eef16a923fa54ec0a88e00e75176a844dbd2944 Author: Alan Mackenzie Date: Thu Jul 13 19:56:00 2017 +0000 C++ Mode. Fix anomaly occurring when a ">" is deleted then reinserted. This fontification anomaly happened because after deleting the ">", c-forward-<>-arglist parses the preceding identifier as a putative type but stores it in c-found-types before it becomes clear it is not an unambiguous type. c-forward-<>-arglist fails, leaving the spurious type id in c-found-types. Fix this by "binding" c-found-types "to itself" in c-forward-<>-arglist, and restoring the original value when that function call fails. * lisp/progmodes/cc-engine.el (c-copy-found-types): New function. (c-forward-<>-arglist): Record the original value of c-found-types at the beginning of the function, and restore it at the end on failure. * lisp/progmodes/cc-mode.el (c-unfind-coalesced-tokens): Rewrite more accurately. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index e880bd3932..22f5b906e4 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6091,6 +6091,13 @@ comment at the start of cc-engine.el for more info." ;; Clears `c-found-types'. (setq c-found-types (make-vector 53 0))) +(defun c-copy-found-types () + (let ((copy (make-vector 53 0))) + (mapatoms (lambda (sym) + (intern (symbol-name sym) copy)) + c-found-types) + copy)) + (defun c-add-type (from to) ;; Add the given region as a type in `c-found-types'. If the region ;; doesn't match an existing type but there is a type which is equal @@ -7059,6 +7066,7 @@ comment at the start of cc-engine.el for more info." ;; This function might do hidden buffer changes. (let ((start (point)) + (old-found-types (c-copy-found-types)) ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. @@ -7074,6 +7082,7 @@ comment at the start of cc-engine.el for more info." (nconc c-record-found-types c-record-type-identifiers))) t) + (setq c-found-types old-found-types) (goto-char start) nil))) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 23044b1f4f..bf0439ffe8 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -437,27 +437,36 @@ preferably use the `c-mode-menu' language constant directly." t)))) (defun c-unfind-coalesced-tokens (beg end) - ;; unless the non-empty region (beg end) is entirely WS and there's at - ;; least one character of WS just before or after this region, remove - ;; the tokens which touch the region from `c-found-types' should they - ;; be present. - (or (c-partial-ws-p beg end) - (save-excursion - (progn - (goto-char beg) - (or (eq beg (point-min)) - (c-skip-ws-backward (1- beg)) - (/= (point) beg) - (= (c-backward-token-2) 1) - (c-unfind-type (buffer-substring-no-properties - (point) beg))) - (goto-char end) - (or (eq end (point-max)) - (c-skip-ws-forward (1+ end)) - (/= (point) end) - (progn (forward-char) (c-end-of-current-token) nil) - (c-unfind-type (buffer-substring-no-properties - end (point)))))))) + ;; If removing the region (beg end) would coalesce an identifier ending at + ;; beg with an identifier (fragment) beginning at end, or an identifier + ;; fragment ending at beg with an identifier beginning at end, remove the + ;; pertinent identifier(s) from `c-found-types'. + (save-excursion + (when (< beg end) + (goto-char beg) + (when + (and (not (bobp)) + (progn (c-backward-syntactic-ws) (eq (point) beg)) + (/= (skip-chars-backward c-symbol-chars (1- (point))) 0) + (progn (goto-char beg) (c-forward-syntactic-ws) (<= (point) end)) + (> (point) beg) + (goto-char end) + (looking-at c-symbol-char-key)) + (goto-char beg) + (c-simple-skip-symbol-backward) + (c-unfind-type (buffer-substring-no-properties (point) beg))) + + (goto-char end) + (when + (and (not (eobp)) + (progn (c-forward-syntactic-ws) (eq (point) end)) + (looking-at c-symbol-char-key) + (progn (c-backward-syntactic-ws) (>= (point) beg)) + (< (point) end) + (/= (skip-chars-backward c-symbol-chars (1- (point))) 0)) + (goto-char (1+ end)) + (c-end-of-current-token) + (c-unfind-type (buffer-substring-no-properties end (point))))))) ;; c-maybe-stale-found-type records a place near the region being ;; changed where an element of `found-types' might become stale. It commit b048351a0f01124b770d6584c3797fde67e30793 Author: Vincent Belaïche Date: Thu Jul 13 20:58:22 2017 +0200 Add tests for SES, and fix one more cell renaming bug. * lisp/ses.el (ses-relocate-all): In case of insertion, do not relocate value for named cells as they keep the same symbol. (ses-rename-cell): Set new cell name symbol to cell value --- do not rely on recalculating. Push cells with updated data --- cell name, cell reference list, or cell formula --- to deferred write list. * test/lisp/ses-tests.el: New file, with 7 tests for SES. diff --git a/lisp/ses.el b/lisp/ses.el index 741d588e4b..5c560efb70 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -1715,7 +1715,7 @@ to each symbol." (set (make-local-variable sym) nil) (put sym 'ses-cell (cons row col)))))) ))) ;; Relocate the cell values. - (let (oldval myrow mycol xrow xcol) + (let (oldval myrow mycol xrow xcol sym) (cond ((and (<= rowincr 0) (<= colincr 0)) ;; Deletion of rows and/or columns. @@ -1725,16 +1725,16 @@ to each symbol." (dotimes (col (- ses--numcols mincol)) (setq mycol (+ col mincol) xrow (- myrow rowincr) - xcol (- mycol colincr)) - (let ((sym (ses-cell-symbol myrow mycol))) - ;; We don't need to relocate value for renamed cells, as they keep the same - ;; symbol. - (unless (eq (get sym 'ses-cell) :ses-named) - (ses-set-cell myrow mycol 'value - (if (and (< xrow ses--numrows) (< xcol ses--numcols)) - (ses-cell-value xrow xcol) - ;; Cell is off the end of the array. - (symbol-value (ses-create-cell-symbol xrow xcol)))))))) + xcol (- mycol colincr) + sym (ses-cell-symbol myrow mycol)) + ;; We don't need to relocate value for renamed cells, as they keep the same + ;; symbol. + (unless (eq (get sym 'ses-cell) :ses-named) + (ses-set-cell myrow mycol 'value + (if (and (< xrow ses--numrows) (< xcol ses--numcols)) + (ses-cell-value xrow xcol) + ;; Cell is off the end of the array. + (symbol-value (ses-create-cell-symbol xrow xcol))))))) (when ses--in-killing-named-cell-list (message "Unbinding killed named cell symbols...") (setq ses-start-time (float-time)) @@ -1754,13 +1754,17 @@ to each symbol." (dotimes (col (- ses--numcols mincol)) (setq mycol (- distx col) xrow (- myrow rowincr) - xcol (- mycol colincr)) - (if (or (< xrow minrow) (< xcol mincol)) - ;; Newly-inserted value. - (setq oldval nil) - ;; Transfer old value. - (setq oldval (ses-cell-value xrow xcol))) - (ses-set-cell myrow mycol 'value oldval))) + xcol (- mycol colincr) + sym (ses-cell-symbol myrow mycol)) + ;; We don't need to relocate value for renamed cells, as they keep the same + ;; symbol. + (unless (eq (get sym 'ses-cell) :ses-named) + (if (or (< xrow minrow) (< xcol mincol)) + ;; Newly-inserted value. + (setq oldval nil) + ;; Transfer old value. + (setq oldval (ses-cell-value xrow xcol))) + (ses-set-cell myrow mycol 'value oldval)))) t)) ; Make testcover happy by returning non-nil here. (t (error "ROWINCR and COLINCR must have the same sign")))) @@ -3496,9 +3500,10 @@ highlighted range in the spreadsheet." (rowcol (ses-sym-rowcol sym)) (row (car rowcol)) (col (cdr rowcol)) - new-rowcol old-name) + new-rowcol old-name old-value) (setq cell (or cell (ses-get-cell row col)) old-name (ses-cell-symbol cell) + old-value (symbol-value old-name) new-rowcol (ses-decode-cell-symbol (symbol-name new-name))) ;; when ses-rename-cell is called interactively, then 'sym' is the ;; 'cursor-intangible' property of text at cursor position, while @@ -3518,10 +3523,12 @@ highlighted range in the spreadsheet." (put new-name 'ses-cell :ses-named) (puthash new-name rowcol ses--named-cell-hashmap)) (push `(ses-rename-cell ,old-name ,cell) buffer-undo-list) + (cl-pushnew rowcol ses--deferred-write :test #'equal) ;; Replace name by new name in formula of cells refering to renamed cell. (dolist (ref (ses-cell-references cell)) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) + (cl-pushnew x ses--deferred-write :test #'equal) (setf (ses-cell-formula xcell) (ses-replace-name-in-formula (ses-cell-formula xcell) @@ -3532,11 +3539,14 @@ highlighted range in the spreadsheet." (dolist (ref (ses-formula-references (ses-cell-formula cell))) (let* ((x (ses-sym-rowcol ref)) (xcell (ses-get-cell (car x) (cdr x)))) + (cl-pushnew x ses--deferred-write :test #'equal) (setf (ses-cell-references xcell) (cons new-name (delq old-name (ses-cell-references xcell)))))) (set (make-local-variable new-name) (symbol-value sym)) (setf (ses-cell--symbol cell) new-name) + ;; set new name to value + (set new-name old-value) ;; Unbind old name (if (eq (get old-name 'ses-cell) :ses-named) (ses--unbind-cell-name old-name) diff --git a/test/lisp/ses-tests.el b/test/lisp/ses-tests.el new file mode 100644 index 0000000000..5250ff43b7 --- /dev/null +++ b/test/lisp/ses-tests.el @@ -0,0 +1,151 @@ +;;; ses-tests.el --- Tests for ses.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. + +;; Author: Vincent Belaïche + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Code: + +(require 'ert) +(require 'ses) + + +;; PLAIN FORMULA TESTS +;; ====================================================================== + +(ert-deftest ses-tests-lowlevel-plain-formula () + "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value +equal to 2. This is done with low level functions calls, not like +interactively." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'ses-cell-set-formula c) + (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) + (should (eq A2 2))))) + +(ert-deftest ses-tests-plain-formula () + "Check that setting A1 to 1 and A2 to (1+ A1), makes A2 value +equal to 2. This is done using interactive calls." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook) + (should (eq A2 2))))) + +;; PLAIN CELL RENAMING TESTS +;; ====================================================================== + +(ert-deftest ses-tests-lowlevel-renamed-cell () + "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 to (1+ foo), makes A2 value equal to 2. +This is done using low level functions, `ses-rename-cell' is not +called but instead we use text replacement in the buffer priorly +passed in text mode." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'ses-cell-set-formula c) + (apply 'ses-calculate-cell (list (car c) (cadr c) nil))) + (ses-write-cells) + (text-mode) + (goto-char (point-min)) + (while (re-search-forward "\\" nil t) + (replace-match "foo" t t)) + (ses-mode) + (should-not (local-variable-p 'A1)) + (should (eq foo 1)) + (should (equal (ses-cell-formula 1 0) '(ses-safe-formula (1+ foo)))) + (should (eq A2 2))))) + +(ert-deftest ses-tests-renamed-cell () + "Check that renaming A1 to `foo' and setting `foo' to 1 and A2 +to (1+ foo), makes A2 value equal to 2." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (ses-rename-cell 'foo (ses-get-cell 0 0)) + (dolist (c '((0 0 1) (1 0 (1+ foo)))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook) + (should-not (local-variable-p 'A1)) + (should (eq foo 1)) + (should (equal (ses-cell-formula 1 0) '(1+ foo))) + (should (eq A2 2))))) + +(ert-deftest ses-tests-renamed-cell-after-setting () + "Check that setting A1 to 1 and A2 to (1+ A1), and then +renaming A1 to `foo' makes `foo' value equal to 2." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook); deferred recalc + (ses-rename-cell 'foo (ses-get-cell 0 0)) + (should-not (local-variable-p 'A1)) + (should (eq foo 1)) + (should (equal (ses-cell-formula 1 0) '(1+ foo))) + (should (eq A2 2))))) + +;; ROW INSERTION TESTS +;; ====================================================================== + +(ert-deftest ses-tests-plain-row-insertion () + "Check that setting A1 to 1 and A2 to (1+ A1), and then jumping +to A2 and inserting a row, makes A2 value empty, and A3 equal to +2." + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook) + (ses-jump 'A2) + (ses-insert-row 1) + (ses-command-hook) + (should-not A2) + (should (eq A3 2))))) + +; (defvar ses-tests-trigger nil) + +(ert-deftest ses-tests-renamed-cells-row-insertion () + "Check that setting A1 to 1 and A2 to (1+ A1), and then renaming A1 to `foo' and A2 to `bar' jumping +to `bar' and inserting a row, makes A2 value empty, and `bar' equal to +2." + (setq ses-tests-trigger nil) + (let ((ses-initial-size '(2 . 1))) + (with-temp-buffer + (ses-mode) + (dolist (c '((0 0 1) (1 0 (1+ A1)))) + (apply 'funcall-interactively 'ses-edit-cell c)) + (ses-command-hook) + (ses-rename-cell 'foo (ses-get-cell 0 0)) + (ses-command-hook) + (ses-rename-cell 'bar (ses-get-cell 1 0)) + (ses-command-hook) + (should (eq bar 2)) + (ses-jump 'bar) + (ses-insert-row 1) + (ses-command-hook) + (should-not A2) + (should (eq bar 2))))) + + +(provide 'ses-tests) commit 1f08279e1b20bd1e07132b6ee0a25a154811615a Author: Michael Albinus Date: Thu Jul 13 16:40:07 2017 +0200 ; Improve tramp-tests traces diff --git a/test/Makefile.in b/test/Makefile.in index 11373db8ca..4e1a120d5c 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -136,7 +136,8 @@ endif $(AM_V_ELC)$(emacs) -f batch-byte-compile $< ## Save logs, and show logs for failed tests. -WRITE_LOG = > $@ 2>&1 || { STAT=$$?; cat $@; exit $$STAT; } +WRITE_LOG = $(if $(and ${NIX_STORE}, $(findstring tramp, $@)), |& tee $@, > $@ 2>&1) \ + || { STAT=$$?; cat $@; exit $$STAT; } ifeq ($(TEST_LOAD_EL), yes) testloadfile = $*.el @@ -147,8 +148,7 @@ endif %.log: %.elc $(AM_V_at)${MKDIR_P} $(dir $@) $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ - --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \ - $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG}) + --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} ifeq (@HAVE_MODULES@, yes) maybe_exclude_module_tests := diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 8001d9433a..263e135906 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3787,9 +3787,15 @@ process sentinels. They shall not disturb each other." (should-not (file-attributes file)) (should (file-attributes file))) ;; Send string to process. + (tramp--test-message + "Trace 1 action %d %s %s" count buf (current-time-string)) (process-send-string proc (format "%s\n" (buffer-name buf))) + (tramp--test-message + "Trace 2 action %d %s %s" count buf (current-time-string)) (accept-process-output proc 0.1 nil 0) ;; Regular operation. + (tramp--test-message + "Trace 3 action %d %s %s" count buf (current-time-string)) (if (= count 2) (should-not (file-attributes file)) (should (file-attributes file))) commit dde7f2d48b53996bdf767a8cf91aafc2e10add23 Author: Alan Mackenzie Date: Wed Jul 12 20:15:56 2017 +0000 Fix some bugs in c-defun-name. This fixes bug #25623. * lisp/progmodes/cc-cmds.el (c-defun-name): Fix some bugs to do with structs, etc. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 121ba24f09..dec59c5809 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1843,19 +1843,25 @@ with a brace block." (unless (eq where 'at-header) (c-backward-to-nth-BOF-{ 1 where) (c-beginning-of-decl-1)) + (when (looking-at c-typedef-key) + (goto-char (match-end 0)) + (c-forward-syntactic-ws)) ;; Pick out the defun name, according to the type of defun. (cond ;; struct, union, enum, or similar: - ((and (looking-at c-type-prefix-key) - (progn (c-forward-token-2 2) ; over "struct foo " - (or (eq (char-after) ?\{) - (looking-at c-symbol-key)))) ; "struct foo bar ..." - (save-match-data (c-forward-token-2)) - (when (eq (char-after) ?\{) - (c-backward-token-2) - (looking-at c-symbol-key)) - (match-string-no-properties 0)) + ((looking-at c-type-prefix-key) + (let ((key-pos (point))) + (c-forward-token-2 1) ; over "struct ". + (cond + ((looking-at c-symbol-key) ; "struct foo { ..." + (buffer-substring-no-properties key-pos (match-end 0))) + ((eq (char-after) ?{) ; "struct { ... } foo" + (when (c-go-list-forward) + (c-forward-syntactic-ws) + (when (looking-at c-symbol-key) ; a bit bogus - there might + ; be several identifiers. + (match-string-no-properties 0))))))) ((looking-at "DEFUN\\s-*(") ;"DEFUN\\_>") think of XEmacs! ;; DEFUN ("file-name-directory", Ffile_name_directory, Sfile_name_directory, ...) ==> Ffile_name_directory @@ -1900,7 +1906,8 @@ with a brace block." (c-backward-syntactic-ws)) (setq name-end (point)) (c-back-over-compound-identifier) - (buffer-substring-no-properties (point) name-end))))))))) + (and (looking-at c-symbol-start) + (buffer-substring-no-properties (point) name-end)))))))))) (defun c-declaration-limits (near) ;; Return a cons of the beginning and end positions of the current commit 7dd72d76effad5198c0d43a2b68aafbfe34b5ee7 Author: Vasilij Schneidermann Date: Wed Jul 12 17:42:12 2017 +0000 Make prog-mode-map the parent of c-mode-base-map. Fixes bug #26658. * lisp/progmodes/cc-mode.el (top level): Make prog-mode-map the parent of c-mode-base-map if possible. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 1150ebd33b..23044b1f4f 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -265,6 +265,8 @@ control). See \"cc-mode.el\" for more info." nil (setq c-mode-base-map (make-sparse-keymap)) + (when (boundp 'prog-mode-map) + (c-set-keymap-parent c-mode-base-map prog-mode-map)) ;; Separate M-BS from C-M-h. The former should remain ;; backward-kill-word. commit 125a8a62db96c5e3c3e93c34fdb1429098b0d3f6 Author: Alan Mackenzie Date: Wed Jul 12 17:03:35 2017 +0000 CC Mode: create and use c-set-keymap-parent. * lisp/progmodes/cc-defs.el (c-set-keymap-parent): New macro. * lisp/progmodes/cc-mode.el (top-level): Remove cc-bytecomp-defun for set-keymap-parents. (c-make-inherited-keymap): Use c-set-keymap-parent in place of inline code. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index eb7bde0f76..ab910ab7de 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -417,6 +417,17 @@ to it is returned. This function does not modify the point or the mark." ;; Emacs. `(setq mark-active ,activate))) +(defmacro c-set-keymap-parent (map parent) + (cond + ;; XEmacs + ((cc-bytecomp-fboundp 'set-keymap-parents) + `(set-keymap-parents ,map ,parent)) + ;; Emacs + ((cc-bytecomp-fboundp 'set-keymap-parent) + `(set-keymap-parent ,map ,parent)) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs")))) + (defmacro c-delete-and-extract-region (start end) "Delete the text between START and END and return it." (if (cc-bytecomp-fboundp 'delete-and-extract-region) @@ -1266,6 +1277,7 @@ with value CHAR in the region [FROM to)." (def-edebug-spec cc-eval-when-compile (&rest def-form)) (def-edebug-spec c-point t) (def-edebug-spec c-set-region-active t) +(def-edebug-spec c-set-keymap-parent t) (def-edebug-spec c-safe t) (def-edebug-spec c-save-buffer-state let*) (def-edebug-spec c-tentative-buffer-changes t) diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 9b89681c3b..1150ebd33b 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -225,18 +225,7 @@ control). See \"cc-mode.el\" for more info." (defun c-make-inherited-keymap () (let ((map (make-sparse-keymap))) - ;; Necessary to use `cc-bytecomp-fboundp' below since this - ;; function is called from top-level forms that are evaluated - ;; while cc-bytecomp is active when one does M-x eval-buffer. - (cond - ;; Emacs - ((cc-bytecomp-fboundp 'set-keymap-parent) - (set-keymap-parent map c-mode-base-map)) - ;; XEmacs - ((fboundp 'set-keymap-parents) - (set-keymap-parents map c-mode-base-map)) - ;; incompatible - (t (error "CC Mode is incompatible with this version of Emacs"))) + (c-set-keymap-parent map c-mode-base-map) map)) (defun c-define-abbrev-table (name defs &optional doc) commit 01a98e918de8b6e3cc8664dd99f02715dc41854b Author: Martin Rudalics Date: Wed Jul 12 17:35:31 2017 +0200 Minor tweaks of new line number display variables * src/xdisp.c (Vdisplay_line_numbers): Tweak doc-string. (Vdisplay_line_number_width): Rename to Vdisplay_line_numbers_width. (maybe_produce_line_number): Comply with above rename. * lisp/cus-start.el (standard): * lisp/frame.el (top-level): * etc/NEWS: Comply with renaming of `display-line-number-width' to `display-line-numbers-width'. diff --git a/etc/NEWS b/etc/NEWS index 68ebdb3c15..71a2da1b63 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -442,7 +442,7 @@ new face 'line-number-current-line' can be customized to display the current line's number differently from all the other line numbers; by default these two faces are identical. -You can also customize the new variable 'display-line-number-width' to +You can also customize the new variable 'display-line-numbers-width' to specify a fixed minimal with of the area allocated to line-number display. The default is nil, meaning that Emacs will dynamically calculate the area width, enlarging or shrinking it as needed. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index e0290395ad..ed913e3268 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -594,7 +594,7 @@ since it could result in memory overflow and make Emacs crash." (const :tag "Visually relative line numbers" :value visual)) "26.1") - (display-line-number-width display + (display-line-numbers-width display (choice (const :tag "Dynamically computed" :value nil) diff --git a/lisp/frame.el b/lisp/frame.el index 0e9f38589f..7d571791e2 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -2473,7 +2473,7 @@ See also `toggle-frame-maximized'." wrap-prefix truncate-lines display-line-numbers - display-line-number-width + display-line-numbers-width display-line-numbers-current-absolute display-line-numbers-widen bidi-paragraph-direction diff --git a/src/xdisp.c b/src/xdisp.c index 91e9d8abce..6b0532d95f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -20904,8 +20904,8 @@ maybe_produce_line_number (struct it *it) /* Compute the required width if needed. */ if (!it->lnum_width) { - if (NATNUMP (Vdisplay_line_number_width)) - it->lnum_width = XFASTINT (Vdisplay_line_number_width); + if (NATNUMP (Vdisplay_line_numbers_width)) + it->lnum_width = XFASTINT (Vdisplay_line_numbers_width); /* Max line number to be displayed cannot be more than the one corresponding to the last row of the desired matrix. */ @@ -32686,35 +32686,38 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, doc: /* Non-nil means display line numbers. -If the value is t, display absolute line numbers starting at the -beginning of the current narrowing, or at buffer beginning. -If the value is `relative', display line numbers relative to the -line showing point. -The value `visual' countse lative screen lines rather than -physical line: by default, line numbers are displayed before each -non-continuation line that displays buffer text, i.e. after each -newline that came from buffer text. However, if the value is `visual', -every screen line will have a number. +If the value is t, display the absolute number of each line of a buffer +shown in a window. Absolute line numbers count from the beginning of +the current narrowing, or from buffer beginning. If the value is +`relative', display for each line not containing the window's point its +relative number instead, i.e. the number of the line relative to the +line showing the window's point. + +In either case, line numbers are displayed at the beginning of each +non-continuation line that displays buffer text, i.e. after each newline +character that comes from the buffer. The value `visual' is like +`relative' but counts screen lines instead of buffer lines. In practice +this means that continuation lines count as well when calculating the +relative number of a line. Lisp programs can disable display of a line number of a particular -screen line by putting the `display-line-numbers-disable' text -property or overlay property on the first visible character of -that line. */); +buffer line by putting the `display-line-numbers-disable' text property +or overlay property on the first visible character of that line. */); Vdisplay_line_numbers = Qnil; DEFSYM (Qdisplay_line_numbers, "display-line-numbers"); Fmake_variable_buffer_local (Qdisplay_line_numbers); DEFSYM (Qrelative, "relative"); DEFSYM (Qvisual, "visual"); - DEFVAR_LISP ("display-line-number-width", Vdisplay_line_number_width, + DEFVAR_LISP ("display-line-numbers-width", Vdisplay_line_numbers_width, doc: /* Minimum width of space reserved for line number display. A positive number means reserve that many columns for line numbers, even if the actual number needs less space. The default value of nil means compute the space dynamically. Any other value is treated as nil. */); - Vdisplay_line_number_width = Qnil; - DEFSYM (Qdisplay_line_number_width, "display-line-number-width"); - Fmake_variable_buffer_local (Qdisplay_line_number_width); + Vdisplay_line_numbers_width = Qnil; + DEFSYM (Qdisplay_line_numbers_width, "display-line-number-width"); + Fmake_variable_buffer_local (Qdisplay_line_numbers_width); DEFVAR_LISP ("display-line-numbers-current-absolute", Vdisplay_line_numbers_current_absolute, commit 4ddff36f6a19492894296e1a2d89c362bf879906 Author: Eli Zaretskii Date: Wed Jul 12 17:49:21 2017 +0300 Avoid assertion violations in close_infile_unwind * src/lread.c (close_infile_unwind): A temporary band-aid solution for bug#27642: allow 'infile' be NULL. diff --git a/src/lread.c b/src/lread.c index 4d1a27d1c1..fe5de38267 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1066,7 +1066,7 @@ static void close_infile_unwind (void *arg) { FILE *stream = arg; - eassert (infile->stream == stream); + eassert (infile == NULL || infile->stream == stream); infile = NULL; fclose (stream); } commit 46a681e4e1463d355c458df08d0f6403335aba05 Author: Michael Albinus Date: Wed Jul 12 14:53:53 2017 +0200 ; Enable traces for tramp-tests.el on hydra diff --git a/test/Makefile.in b/test/Makefile.in index 414eca9056..11373db8ca 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -147,7 +147,8 @@ endif %.log: %.elc $(AM_V_at)${MKDIR_P} $(dir $@) $(AM_V_GEN)HOME=/nonexistent $(emacs) -l ert -l $(testloadfile) \ - --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} + --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" \ + $(if $(and ${NIX_STORE}, $(findstring tramp, $(testloadfile))), , ${WRITE_LOG}) ifeq (@HAVE_MODULES@, yes) maybe_exclude_module_tests := diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 6c02daa654..8001d9433a 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -3729,13 +3729,17 @@ process sentinels. They shall not disturb each other." (let ((default-directory tmp-name) (file (buffer-name (nth (random (length buffers)) buffers)))) - (funcall timer-operation file)))))) + (tramp--test-message + "Start timer %s %s" file (current-time-string)) + (funcall timer-operation file) + (tramp--test-message + "Stop timer %s %s" file (current-time-string))))))) ;; Create temporary buffers. The number of buffers ;; corresponds to the number of processes; it could be ;; increased in order to make pressure on Tramp. (dotimes (_i number-proc) - (add-to-list 'buffers (generate-new-buffer "foo"))) + (setq buffers (cons (generate-new-buffer "foo") buffers))) ;; Open asynchronous processes. Set process filter and sentinel. (dolist (buf buffers) @@ -3776,6 +3780,8 @@ process sentinels. They shall not disturb each other." (proc (get-buffer-process buf)) (file (process-get proc 'foo)) (count (process-get proc 'bar))) + (tramp--test-message + "Start action %d %s %s" count buf (current-time-string)) ;; Regular operation. (if (= count 0) (should-not (file-attributes file)) @@ -3787,6 +3793,8 @@ process sentinels. They shall not disturb each other." (if (= count 2) (should-not (file-attributes file)) (should (file-attributes file))) + (tramp--test-message + "Stop action %d %s %s" count buf (current-time-string)) (process-put proc 'bar (1+ count)) (unless (process-live-p proc) (setq buffers (delq buf buffers)))))) @@ -3794,6 +3802,8 @@ process sentinels. They shall not disturb each other." ;; Checks. All process output shall exists in the ;; respective buffers. All created files shall be ;; deleted. + (tramp--test-message + "Check %s" (current-time-string)) (dolist (buf buffers) (with-current-buffer buf (should (string-equal (format "%s\n" buf) (buffer-string))))) commit d014a5e15c1110af77e7a96f06ccd0f0cafb099f Author: Eli Zaretskii Date: Tue Jul 11 18:16:36 2017 +0300 Use fixed-pitch font for display-line-numbers * lisp/faces.el (line-number): Use a fixed-pitch font by default, even if the default face uses a variable-pitch font. Reported by James Cloos . diff --git a/lisp/faces.el b/lisp/faces.el index c3693d1663..e073ed266c 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -2465,9 +2465,12 @@ If you set `term-file-prefix' to nil, this function does nothing." :version "21.1" :group 'basic-faces) -;; Definition stolen from linum.el. +;; Definition originally stolen from linum.el. +;; The monospace part is so we don't accidentally display numbers +;; using a variable-pitch font just because the default face uses +;; such a font. (defface line-number - '((t :inherit (shadow default))) + '((t :inherit (shadow default) :family "Monospace Serif")) "Face for displaying line numbers. This face is used when `display-line-numbers' is non-nil. commit 10b876b25b5c65014c5d7f996ae3368ea8fd11b2 Author: Eli Zaretskii Date: Tue Jul 11 18:11:33 2017 +0300 ; * src/xdisp.c (syms_of_xdisp) : Copyedits. diff --git a/src/xdisp.c b/src/xdisp.c index eb7a9e5f09..91e9d8abce 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32690,11 +32690,11 @@ If the value is t, display absolute line numbers starting at the beginning of the current narrowing, or at buffer beginning. If the value is `relative', display line numbers relative to the line showing point. -The value `visual' counts screen lines rather than physical line: -by default, line numbers are displayed before each non-continuation -line that displays buffer text, i.e. after each newline that came -from buffer text. However, if the value is `visual', every screen -line will have a number. +The value `visual' countse lative screen lines rather than +physical line: by default, line numbers are displayed before each +non-continuation line that displays buffer text, i.e. after each +newline that came from buffer text. However, if the value is `visual', +every screen line will have a number. Lisp programs can disable display of a line number of a particular screen line by putting the `display-line-numbers-disable' text commit 373cef5fe19d72c3549495e566e3ac0996215f14 Author: Eli Zaretskii Date: Tue Jul 11 18:08:46 2017 +0300 Improve documentation of display-line-numbers * src/xdisp.c (syms_of_xdisp) : Improve the doc string. Suggested by Alex . diff --git a/src/xdisp.c b/src/xdisp.c index abca6a8137..eb7a9e5f09 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -32686,7 +32686,12 @@ To add a prefix to continuation lines, use `wrap-prefix'. */); DEFVAR_LISP ("display-line-numbers", Vdisplay_line_numbers, doc: /* Non-nil means display line numbers. -By default, line numbers are displayed before each non-continuation +If the value is t, display absolute line numbers starting at the +beginning of the current narrowing, or at buffer beginning. +If the value is `relative', display line numbers relative to the +line showing point. +The value `visual' counts screen lines rather than physical line: +by default, line numbers are displayed before each non-continuation line that displays buffer text, i.e. after each newline that came from buffer text. However, if the value is `visual', every screen line will have a number. commit 0bece6c6815cc59e181817a2765a4ea752f34f56 Author: Nicolas Petton Date: Fri Jul 7 21:21:55 2017 +0200 Add an optional testfn parameter to assoc * src/fns.c (assoc): New optional testfn parameter used for comparison when provided. * test/src/fns-tests.el (test-assoc-testfn): Add tests for the new 'testfn' parameter. * src/buffer.c: * src/coding.c: * src/dbusbind.c: * src/font.c: * src/fontset.c: * src/gfilenotify.c: * src/image.c: * src/keymap.c: * src/process.c: * src/w32fns.c: * src/w32font.c: * src/w32notify.c: * src/w32term.c: * src/xdisp.c: * src/xfont.c: Add a third argument to Fassoc calls. * etc/NEWS: * doc/lispref/lists.texi: Document the new 'testfn' parameter. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 8eab2818f9..966d8f18b1 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1511,12 +1511,12 @@ respects. A property list behaves like an association list in which each key can occur only once. @xref{Property Lists}, for a comparison of property lists and association lists. -@defun assoc key alist +@defun assoc key alist &optional testfn This function returns the first association for @var{key} in @var{alist}, comparing @var{key} against the alist elements using -@code{equal} (@pxref{Equality Predicates}). It returns @code{nil} if no -association in @var{alist} has a @sc{car} @code{equal} to @var{key}. -For example: +@var{testfn} if non-nil, or @code{equal} if nil (@pxref{Equality +Predicates}). It returns @code{nil} if no association in @var{alist} +has a @sc{car} equal to @var{key}. For example: @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) @@ -1561,11 +1561,11 @@ this as reverse @code{assoc}, finding the key for a given value. @defun assq key alist This function is like @code{assoc} in that it returns the first association for @var{key} in @var{alist}, but it makes the comparison -using @code{eq} instead of @code{equal}. @code{assq} returns @code{nil} -if no association in @var{alist} has a @sc{car} @code{eq} to @var{key}. -This function is used more often than @code{assoc}, since @code{eq} is -faster than @code{equal} and most alists use symbols as keys. -@xref{Equality Predicates}. +using @code{eq}. @code{assq} returns @code{nil} if no association in +@var{alist} has a @sc{car} @code{eq} to @var{key}. This function is +used more often than @code{assoc}, since @code{eq} is faster than +@code{equal} and most alists use symbols as keys. @xref{Equality +Predicates}. @smallexample (setq trees '((pine . cones) (oak . acorns) (maple . seeds))) diff --git a/etc/NEWS b/etc/NEWS index a00760c2f8..68ebdb3c15 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -100,6 +100,11 @@ required capabilities are found in terminfo. See the FAQ node * Changes in Emacs 26.1 ++++ +** The function 'assoc' now takes an optional third argument 'testfn'. +This argument, when non-nil, is used for comparison instead of +'equal'. + ** The variable 'emacs-version' no longer includes the build number. This is now stored separately in a new variable, 'emacs-build-number'. diff --git a/src/buffer.c b/src/buffer.c index 780e4d7a7d..e0972aac33 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -1164,7 +1164,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer) { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, BVAR (buf, local_var_alist)); + result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil); if (!NILP (result)) { if (blv->fwd) diff --git a/src/coding.c b/src/coding.c index 5682fc015a..50ad206be6 100644 --- a/src/coding.c +++ b/src/coding.c @@ -10539,7 +10539,7 @@ usage: (define-coding-system-internal ...) */) ASET (this_spec, 2, this_eol_type); Fputhash (this_name, this_spec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (this_name, Vcoding_system_list); - val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (this_name), Qnil), @@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */) Fputhash (name, spec_vec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (name, Vcoding_system_list); - val = Fassoc (Fsymbol_name (name), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil), Vcoding_system_alist); @@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias, Fputhash (alias, spec, Vcoding_system_hash_table); Vcoding_system_list = Fcons (alias, Vcoding_system_list); - val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist); + val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil); if (NILP (val)) Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil), Vcoding_system_alist); diff --git a/src/dbusbind.c b/src/dbusbind.c index d2460fd886..0d9d3e514f 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -955,7 +955,7 @@ xd_get_connection_address (Lisp_Object bus) DBusConnection *connection; Lisp_Object val; - val = CDR_SAFE (Fassoc (bus, xd_registered_buses)); + val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil)); if (NILP (val)) XD_SIGNAL2 (build_string ("No connection to bus"), bus); else @@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus) Lisp_Object busobj; /* Check whether we are connected. */ - val = Fassoc (bus, xd_registered_buses); + val = Fassoc (bus, xd_registered_buses, Qnil); if (NILP (val)) return; @@ -1127,7 +1127,7 @@ this connection to those buses. */) xd_close_bus (bus); /* Check, whether we are still connected. */ - val = Fassoc (bus, xd_registered_buses); + val = Fassoc (bus, xd_registered_buses, Qnil); if (!NILP (val)) { connection = xd_get_connection_address (bus); diff --git a/src/fns.c b/src/fns.c index 6610d2a6d0..f0e10e311f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1417,17 +1417,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list) return Qnil; } -DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0, - doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST. -The value is actually the first element of LIST whose car equals KEY. */) - (Lisp_Object key, Lisp_Object list) +DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0, + doc: /* Return non-nil if KEY is equal to the car of an element of LIST. +The value is actually the first element of LIST whose car equals KEY. + +Equality is defined by TESTFN if non-nil or by `equal' if nil. */) + (Lisp_Object key, Lisp_Object list, Lisp_Object testfn) { Lisp_Object tail = list; FOR_EACH_TAIL (tail) { Lisp_Object car = XCAR (tail); if (CONSP (car) - && (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key)))) + && (NILP (testfn) + ? (EQ (XCAR (car), key) || !NILP (Fequal + (XCAR (car), key))) + : !NILP (call2 (testfn, XCAR (car), key)))) return car; } CHECK_LIST_END (tail, list); diff --git a/src/font.c b/src/font.c index 5a3f271ef8..a5e5b6a5b9 100644 --- a/src/font.c +++ b/src/font.c @@ -1893,7 +1893,7 @@ otf_tag_symbol (OTF_Tag tag) static OTF * otf_open (Lisp_Object file) { - Lisp_Object val = Fassoc (file, otf_list); + Lisp_Object val = Fassoc (file, otf_list, Qnil); OTF *otf; if (! NILP (val)) diff --git a/src/fontset.c b/src/fontset.c index 850558b08a..74018060b8 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1186,7 +1186,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern) { tem = Frassoc (name, Vfontset_alias_alist); if (NILP (tem)) - tem = Fassoc (name, Vfontset_alias_alist); + tem = Fassoc (name, Vfontset_alias_alist, Qnil); if (CONSP (tem) && STRINGP (XCAR (tem))) name = XCAR (tem); else if (name_pattern == 0) diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 285a253733..fa4854c664 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -266,7 +266,7 @@ reason. Removing the watch by calling `gfile-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); + Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (NILP (watch_object)) return Qnil; else diff --git a/src/image.c b/src/image.c index 91749fb873..1426e30944 100644 --- a/src/image.c +++ b/src/image.c @@ -4231,7 +4231,7 @@ xpm_load_image (struct frame *f, color_val = Qnil; if (!NILP (color_symbols) && !NILP (symbol_color)) { - Lisp_Object specified_color = Fassoc (symbol_color, color_symbols); + Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil); if (CONSP (specified_color) && STRINGP (XCDR (specified_color))) { diff --git a/src/keymap.c b/src/keymap.c index b568f47cba..db9aa7cbf3 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1292,7 +1292,7 @@ silly_event_symbol_error (Lisp_Object c) base = XCAR (parsed); name = Fsymbol_name (base); /* This alist includes elements such as ("RET" . "\\r"). */ - assoc = Fassoc (name, exclude_keys); + assoc = Fassoc (name, exclude_keys, Qnil); if (! NILP (assoc)) { diff --git a/src/process.c b/src/process.c index abd017bb90..1900951533 100644 --- a/src/process.c +++ b/src/process.c @@ -951,7 +951,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, if (PROCESSP (name)) return name; CHECK_STRING (name); - return Fcdr (Fassoc (name, Vprocess_alist)); + return Fcdr (Fassoc (name, Vprocess_alist, Qnil)); } /* This is how commands for the user decode process arguments. It diff --git a/src/w32fns.c b/src/w32fns.c index b0842b5ee6..457599fce0 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -467,7 +467,7 @@ if the entry is new. */) block_input (); /* replace existing entry in w32-color-map or add new entry. */ - entry = Fassoc (name, Vw32_color_map); + entry = Fassoc (name, Vw32_color_map, Qnil); if (NILP (entry)) { entry = Fcons (name, rgb); diff --git a/src/w32font.c b/src/w32font.c index 67d2f6d666..314d7acdcc 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -1627,7 +1627,7 @@ x_to_w32_charset (char * lpcs) Format of each entry is (CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)). */ - this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist); + this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil); if (NILP (this_entry)) { diff --git a/src/w32notify.c b/src/w32notify.c index 25205816ba..e8bdef8bdd 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -642,7 +642,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */) /* Remove the watch object from watch list. Do this before freeing the object, do that even if we fail to free it, watch_list is kept free of junk. */ - watch_object = Fassoc (watch_descriptor, watch_list); + watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (!NILP (watch_object)) { watch_list = Fdelete (watch_object, watch_list); @@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the watch by calling `w32notify-rm-watch' also makes it invalid. */) (Lisp_Object watch_descriptor) { - Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list); + Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil); if (!NILP (watch_object)) { diff --git a/src/w32term.c b/src/w32term.c index c37805cb6c..0f7bb9337f 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6110,7 +6110,7 @@ x_calc_absolute_position (struct frame *f) list = CDR(list); - geometry = Fassoc (Qgeometry, attributes); + geometry = Fassoc (Qgeometry, attributes, Qnil); if (!NILP (geometry)) { monitor_left = Fnth (make_number (1), geometry); diff --git a/src/xdisp.c b/src/xdisp.c index 28ed768523..abca6a8137 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -23314,7 +23314,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision, props = oprops; } - aelt = Fassoc (elt, mode_line_proptrans_alist); + aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil); if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt)))) { /* AELT is what we want. Move it to the front @@ -28788,7 +28788,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg) /* By default, set up the blink-off state depending on the on-state. */ - tem = Fassoc (arg, Vblink_cursor_alist); + tem = Fassoc (arg, Vblink_cursor_alist, Qnil); if (!NILP (tem)) { FRAME_BLINK_OFF_CURSOR (f) @@ -28926,7 +28926,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Cursor is blinked off, so determine how to "toggle" it. */ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ - if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) + if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor))) return get_specified_cursor_type (XCDR (alt_cursor), width); /* Then see if frame has specified a specific blink off cursor type. */ diff --git a/src/xfont.c b/src/xfont.c index b73596ce7c..85fccf0daf 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -505,7 +505,8 @@ xfont_list (struct frame *f, Lisp_Object spec) Lisp_Object alter; if ((alter = Fassoc (SYMBOL_NAME (registry), - Vface_alternative_font_registry_alist), + Vface_alternative_font_registry_alist, + Qnil), CONSP (alter))) { /* Pointer to REGISTRY-ENCODING field. */ diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 2e463455f0..e294859226 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -373,6 +373,12 @@ (should-error (assoc 3 d1) :type 'wrong-type-argument) (should-error (assoc 3 d2) :type 'wrong-type-argument))) +(ert-deftest test-assoc-testfn () + (let ((alist '(("a" . 1) ("b" . 2)))) + (should-not (assoc "a" alist #'ignore)) + (should (eq (assoc "b" alist #'string-equal) (cadr alist))) + (should-not (assoc "b" alist #'eq)))) + (ert-deftest test-cycle-rassq () (let ((c1 (cyc1 '(0 . 1))) (c2 (cyc2 '(0 . 1) '(0 . 2))) commit 689c5c20d1174e95be50e674d05632545eb4b9c5 Author: Michael Albinus Date: Mon Jul 10 17:49:01 2017 +0200 Use `with-demoted-errors' in Tramp * lisp/net/tramp.el (tramp-with-demoted-errors): New defmacro. * lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered): Use it. diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 94518d0d35..4beb6fe521 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3432,7 +3432,9 @@ the result will be a local, non-Tramp, file name." `((,(tramp-file-name-regexp) . tramp-vc-file-name-handler)))) ;; Here we collect only file names, which need an operation. - (ignore-errors (tramp-run-real-handler 'vc-registered (list file))) + (tramp-with-demoted-errors + v "Error in 1st pass of `vc-registered': %s" + (tramp-run-real-handler 'vc-registered (list file))) (tramp-message v 10 "\n%s" tramp-vc-registered-file-names) ;; Send just one command, in order to fill the cache. @@ -3493,7 +3495,8 @@ the result will be a local, non-Tramp, file name." v vc-hg-program (tramp-get-remote-path v))))) (setq vc-handled-backends (remq 'Hg vc-handled-backends))) ;; Run. - (ignore-errors + (tramp-with-demoted-errors + v "Error in 2nd pass of `vc-registered': %s" (tramp-run-real-handler 'vc-registered (list file)))))))) ;;;###tramp-autoload diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 945f81188c..8d7fbc068b 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1641,6 +1641,18 @@ an input event arrives. The other arguments are passed to `tramp-error'." (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) +(defmacro tramp-with-demoted-errors (vec-or-proc format &rest body) + "Execute BODY while redirecting the error message to `tramp-message'. +BODY is executed like wrapped by `with-demoted-errors'. FORMAT +is a format-string containing a %-sequence meaning to substitute +the resulting error message." + (declare (debug (symbolp body)) + (indent 2)) + (let ((err (make-symbol "err"))) + `(condition-case-unless-debug ,err + (progn ,@body) + (error (tramp-message ,vec-or-proc 3 ,format ,err) nil)))) + (defmacro with-parsed-tramp-file-name (filename var &rest body) "Parse a Tramp filename and make components available in the body. commit 0440c748aaec9b8b32c8cb268f6e24e874fedc75 Author: Michael Albinus Date: Mon Jul 10 15:36:23 2017 +0200 Add Quick Start Guide to Tramp manual * doc/misc/tramp.texi: Use consequently "@value{tramp}" and "MS Windows". (Quick Start Guide): New node. * doc/misc/trampver.texi: * lisp/net/trampver.el: Change version to "2.3.3-pre". diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6209e02ebc..1b751a01db 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -43,7 +43,7 @@ copy and modify this GNU manual.'' @c Entries for @command{install-info} to use @dircategory Emacs network features @direntry -* TRAMP: (tramp). Transparent Remote Access, Multiple Protocol +* @value{tramp}: (tramp). Transparent Remote Access, Multiple Protocol Emacs remote file access via ssh and scp. @end direntry @@ -77,8 +77,8 @@ You can find the latest version of this document on the web at @ifhtml The latest release of @value{tramp} is available for @uref{https://ftp.gnu.org/gnu/tramp/, download}, or you may see -@ref{Obtaining Tramp} for more details, including the Git server -details. +@ref{Obtaining @value{tramp}} for more details, including the Git +server details. @value{tramp} also has a @uref{https://savannah.gnu.org/projects/tramp/, Savannah Project Page}. @@ -97,11 +97,12 @@ There is a mailing list for @value{tramp}, available at For the end user: -* Obtaining Tramp:: How to obtain @value{tramp}. +* Obtaining @value{tramp}:: How to obtain @value{tramp}. * History:: History of @value{tramp}. @ifset installchapter * Installation:: Installing @value{tramp} with your Emacs. @end ifset +* Quick Start Guide:: Short introduction how to use @value{tramp}. * Configuration:: Configuring @value{tramp} for use. * Usage:: An overview of the operation of @value{tramp}. * Bug Reports:: Reporting Bugs and Problems. @@ -192,7 +193,7 @@ and related programs. If these programs can successfully pass more secure alternative to @command{ftp} and other older access methods. -@value{tramp} on Windows operating systems is integrated with the +@value{tramp} on MS Windows operating systems is integrated with the PuTTY package, and uses the @command{plink} program. @value{tramp} mostly operates transparently in the background using @@ -207,7 +208,7 @@ benefit of direct integration of @value{tramp} in Emacs. @value{tramp} can transfer files using any number of available host programs for remote files, such as @command{rcp}, @command{scp}, -@command{rsync} or (under Windows) @command{pscp}. @value{tramp} +@command{rsync} or (under MS Windows) @command{pscp}. @value{tramp} provides easy ways to specify these programs and customize them to specific files, hosts, or access methods. @@ -314,9 +315,9 @@ behind the scenes when you open a file with @value{tramp}. @c For the end user -@node Obtaining Tramp +@node Obtaining @value{tramp} @chapter Obtaining @value{tramp} -@cindex obtaining Tramp +@cindex obtaining @value{tramp} @value{tramp} is included as part of Emacs (since Emacs version 22.1). @@ -354,7 +355,7 @@ From behind a firewall: @end example @noindent -Tramp developers: +@value{tramp} developers: @example ] @strong{git clone login@@git.sv.gnu.org:/srv/git/tramp.git} @@ -403,7 +404,7 @@ July 2002, @value{tramp} unified file names with Ange FTP@. In July 2004, proxy hosts replaced multi-hop methods. Running commands on remote hosts was introduced in December 2005. Support for gateways since April 2007 (and removed in December 2016). GVFS integration -started in February 2009. Remote commands on Windows hosts since +started in February 2009. Remote commands on MS Windows hosts since September 2011. Ad-hoc multi-hop methods (with a changed syntax) re-enabled in November 2011. In November 2012, added Juergen Hoetzel's @file{tramp-adb.el}. @@ -418,6 +419,147 @@ XEmacs support was stopped in January 2016. Since March 2017, @end ifset +@node Quick Start Guide +@chapter Short introduction how to use @value{tramp} +@cindex quick start guide + +@value{tramp} extends the Emacs file name syntax by a remote +component. A remote file name looks always like +@file{@trampfn{method,user@@host,/path/to/file}}. + +You can use remote files exactly like ordinary files, that means you +could open a file or directory by @kbd{C-x C-f +@trampfn{method,user@@host,/path/to/file} @key{RET}}, edit the file, +and save it. You can also mix local files and remote files in file +operations with two arguments, like @code{copy-file} or +@code{rename-file}. And finally, you can run even processes on a +remote host, when the buffer you call the process from has a remote +@code{default-directory}. + + +@anchor{Quick Start Guide: File name syntax} +@section File name syntax +@cindex file name syntax + +Remote file names are prepended by the @code{method}, @code{user} and +@code{host} parts. All of them, and also the local file name part, +are optional, in case of a missing part a default value is assumed. +The default value for an empty local file name part is the remote +user's home directory. The shortest remote file name is +@file{@trampfn{-,,}}, therefore. The @samp{-} notation for the +default host is used for syntactical reasons, @ref{Default Host}. + +The @code{method} part describes the connection method used to reach +the remote host, see below. + +The @code{user} part is the user name for accessing the remote host. +For the @option{smb} method, this could also require a domain name, in +this case it is written as @code{user%domain}. + +The @code{host} part must be a host name which could be resolved on +your local host. It could be a short host name, a fully qualified +domain name, an IPv4 or IPv6 address, @ref{File name syntax}. Some +connection methods support also a notation of the port to be used, in +this case it is written as @code{host#port}. + + +@anchor{Quick Start Guide: @option{ssh} and @option{plink} methods} +@section Using @option{ssh} and @option{plink} +@cindex method ssh +@cindex ssh method +@cindex method plink +@cindex plink method + +If your local host runs an SSH client, and the remote host runs an SSH +server, the most simple remote file name is +@file{@trampfn{ssh,user@@host,/path/to/file}}. The remote file name +@file{@trampfn{ssh,,}} opens a remote connection to yourself on the +local host, and is taken often for testing @value{tramp}. + +On MS Windows, PuTTY is often used as SSH client. Its @command{plink} +method can be used there to open a connection to a remote host running +an @command{ssh} server: +@file{@trampfn{plink,user@@host,/path/to/file}}. + + +@anchor{Quick Start Guide: @option{su}, @option{sudo} and @option{sg} methods} +@section Using @option{su}, @option{sudo} and @option{sg} +@cindex method su +@cindex su method +@cindex method sudo +@cindex sudo method +@cindex method sg +@cindex sg method + +Sometimes, it is necessary to work on your local host under different +permissions. For this, you could use the @option{su} or @option{sudo} +connection method. Both methods use @samp{root} as default user name +and the return value of @code{(system-name)} as default host name. +Therefore, it is convenient to open a file as +@file{@trampfn{sudo,,/path/to/file}}. + +The method @option{sg} stands for ``switch group''; the changed group +must be used here as user name. The default host name is the same. + + +@anchor{Quick Start Guide: @option{smb} method} +@section Using @command{smbclient} +@cindex method smb +@cindex smb method +@cindex ms windows (with smb method) +@cindex smbclient + +In order to access a remote MS Windows host or Samba server, the +@command{smbclient} client is used. The remote file name syntax is +@file{@trampfn{smb,user%domain@@host,/path/to/file}}. The first part +of the local file name is the share exported by the remote host, +@samp{path} in this example. + + +@anchor{Quick Start Guide: GVFS-based methods} +@section Using GVFS-based methods +@cindex methods, gvfs +@cindex gvfs based methods +@cindex method sftp +@cindex sftp method +@cindex method afp +@cindex afp method +@cindex method dav +@cindex method davs +@cindex dav method +@cindex davs method + +On systems, which have installed the virtual file system for the Gnome +Desktop (GVFS), its offered methods could be used by @value{tramp}. +Examples are @file{@trampfn{sftp,user@@host,/path/to/file}}, +@file{@trampfn{afp,user@@host,/path/to/file}} (accessing Apple's AFP +file system), @file{@trampfn{dav,user@@host,/path/to/file}} and +@file{@trampfn{davs,user@@host,/path/to/file}} (for WebDAV shares). + + +@anchor{Quick Start Guide: Google Drive} +@section Using Google Drive +@cindex method gdrive +@cindex gdrive method +@cindex google drive + +Another GVFS-based method allows to access a Google Drive file system. +The file name syntax is here always +@file{@trampfn{gdrive,john.doe@@gmail.com,/path/to/file}}. +@samp{john.doe@@gmail.com} stands here for your Google Drive account. + + +@anchor{Quick Start Guide: Android} +@section Using Android +@cindex method adb +@cindex adb method +@cindex android + +An Android device, which is connected via USB to your local host, can +be accessed via the @command{adb} command. No user or host name is +needed. The file name syntax is @file{@trampfn{adb,,/path/to/file}}. + + @node Configuration @chapter Configuring @value{tramp} @cindex configuration @@ -610,16 +752,16 @@ continue connecting?''. @value{tramp} cannot handle such questions. Connections will have to be setup where logins can proceed without such questions. -@option{sshx} is useful for Windows users when @command{ssh} triggers -an error about allocating a pseudo tty. This happens due to missing -shell prompts that confuses @value{tramp}. +@option{sshx} is useful for MS Windows users when @command{ssh} +triggers an error about allocating a pseudo tty. This happens due to +missing shell prompts that confuses @value{tramp}. @option{sshx} supports the @samp{-p} argument. @item @option{krlogin} @cindex method krlogin @cindex krlogin method -@cindex Kerberos (with krlogin method) +@cindex kerberos (with krlogin method) This method is also similar to @option{ssh}. It uses the @command{krlogin -x} command only for remote host login. @@ -627,7 +769,7 @@ This method is also similar to @option{ssh}. It uses the @item @option{ksu} @cindex method ksu @cindex ksu method -@cindex Kerberos (with ksu method) +@cindex kerberos (with ksu method) This is another method from the Kerberos suite. It behaves like @option{su}. @@ -635,7 +777,7 @@ This is another method from the Kerberos suite. It behaves like @option{su}. @cindex method plink @cindex plink method -@option{plink} method is for Windows users with the PuTTY +@option{plink} method is for MS Windows users with the PuTTY implementation of SSH@. It uses @samp{plink -ssh} to log in to the remote host. @@ -648,9 +790,9 @@ session. @cindex method plinkx @cindex plinkx method -Another method using PuTTY on Windows with session names instead of -host names. @option{plinkx} calls @samp{plink -load @var{session} -t}. -User names and port numbers must be defined in the session. +Another method using PuTTY on MS Windows with session names instead of +host names. @option{plinkx} calls @samp{plink -load @var{session} +-t}. User names and port numbers must be defined in the session. Check the @samp{Share SSH connections if possible} control for that session. @@ -730,9 +872,9 @@ This method supports the @samp{-p} argument. in performance to @option{scp}. @option{scpx} uses @samp{ssh -t -t @var{host} -l @var{user} /bin/sh} to open a connection. -@option{scpx} is useful for Windows users when @command{ssh} triggers -an error about allocating a pseudo tty. This happens due to missing -shell prompts that confuses @value{tramp}. +@option{scpx} is useful for MS Windows users when @command{ssh} +triggers an error about allocating a pseudo tty. This happens due to +missing shell prompts that confuses @value{tramp}. This method supports the @samp{-p} argument. @@ -742,17 +884,17 @@ This method supports the @samp{-p} argument. @cindex pscp method @cindex pscp (with pscp method) @cindex plink (with pscp method) -@cindex PuTTY (with pscp method) +@cindex putty (with pscp method) @cindex method psftp @cindex psftp method @cindex pscp (with psftp method) @cindex plink (with psftp method) -@cindex PuTTY (with psftp method) +@cindex putty (with psftp method) These methods are similar to @option{scp} or @option{sftp}, but they use the @command{plink} command to connect to the remote host, and they use @command{pscp} or @command{psftp} for transferring the files. -These programs are part of PuTTY, an SSH implementation for Windows. +These programs are part of PuTTY, an SSH implementation for MS Windows. Check the @samp{Share SSH connections if possible} control for that session. @@ -805,6 +947,8 @@ capable of servicing requests from @value{tramp}. @item @option{smb} @cindex method smb @cindex smb method +@cindex ms windows (with smb method) +@cindex smbclient This non-native @value{tramp} method connects via the Server Message Block (SMB) networking protocol to hosts running file servers that are @@ -831,15 +975,16 @@ handling}. To accommodate user name/domain name syntax required by MS Windows authorization, @value{tramp} provides for an extended syntax in -@code{user%domain} format (where user is user name, @code{%} is the -percent symbol, and domain is the windows domain name). An example: +@code{user%domain} format (where @code{user} is the user name, +@code{%} is the percent symbol, and @code{domain} is the MS Windows +domain name). An example: @example @trampfn{smb,daniel%BIZARRE@@melancholia,/daniel$$/.emacs} @end example where user @code{daniel} connects as a domain user to the SMB host -@code{melancholia} in the windows domain @code{BIZARRE} to edit +@code{melancholia} in the MS Windows domain @code{BIZARRE} to edit @file{.emacs} located in the home directory (share @code{daniel$}). Alternatively, for local WINS users (as opposed to domain users), @@ -876,6 +1021,7 @@ can. @item @option{adb} @cindex method adb @cindex adb method +@cindex android (with adb method) This method uses Android Debug Bridge program for accessing Android devices. The Android Debug Bridge must be installed locally for @@ -949,7 +1095,7 @@ but with SSL encryption. Both methods support the port numbers. @item @option{gdrive} @cindex method gdrive @cindex gdrive method -@cindex Google Drive +@cindex google drive Via the @option{gdrive} method it is possible to access your Google Drive online storage. User and host name of the remote file name are @@ -981,8 +1127,8 @@ that for security reasons refuse @command{ssh} connections. @cindex method synce @cindex synce method -@option{synce} method allows connecting to Windows Mobile devices. It -uses GVFS for mounting remote files and directories via FUSE and +@option{synce} method allows connecting to MS Windows Mobile devices. +It uses GVFS for mounting remote files and directories via FUSE and requires the SYNCE-GVFS plugin. @end table @@ -1070,7 +1216,7 @@ access and it has the most reasonable security protocols, use @end example If @option{ssh} is unavailable for whatever reason, look for other -obvious options. For Windows, try the @option{plink} method. For +obvious options. For MS Windows, try the @option{plink} method. For Kerberos, try @option{krlogin}. For editing local files as @option{su} or @option{sudo} methods, try @@ -1289,8 +1435,8 @@ restricted shell: @node Firewalls @section Passing firewalls -@cindex HTTP tunnel -@cindex proxy hosts, HTTP tunnel +@cindex http tunnel +@cindex proxy hosts, http tunnel Sometimes, it is not possible to reach a remote host directly. A firewall might be in the way, which could be passed via a proxy @@ -1746,8 +1892,8 @@ Similar localization may be necessary for handling wrong password prompts, for which @value{tramp} uses @option{tramp-wrong-passwd-regexp}. @item @command{tset} and other questions -@cindex Unix command tset -@cindex tset Unix command +@cindex unix command tset +@cindex tset unix command @vindex tramp-terminal-type To suppress inappropriate prompts for terminal type, @value{tramp} @@ -1847,7 +1993,7 @@ Then re-set the prompt string in @file{~/.emacs_SHELLNAME} as follows: @example @group -# Reset the prompt for remote Tramp shells. +# Reset the prompt for remote @value{tramp} shells. if [ "$@{INSIDE_EMACS/*tramp*/tramp@}" == "tramp" ] ; then PS1="[\u@@\h \w]$ " fi @@ -1859,8 +2005,8 @@ fi @end ifinfo @item @command{busybox} / @command{nc} -@cindex Unix command nc -@cindex nc Unix command +@cindex unix command nc +@cindex nc unix command @value{tramp}'s @option{nc} method uses the @command{nc} command to install and execute a listener as follows (see @code{tramp-methods}): @@ -1891,7 +2037,7 @@ where @samp{192.168.0.1} is the remote host IP address @node Android shell setup @section Android shell setup hints -@cindex android shell setup +@cindex android shell setup for ssh @value{tramp} uses the @option{adb} method to access Android devices. Android devices provide a restricted shell access through an USB @@ -2072,12 +2218,12 @@ to direct all auto saves to that location. @node Windows setup hints @section Issues with Cygwin ssh -@cindex Cygwin, issues +@cindex cygwin, issues This section is incomplete. Please share your solutions. -@cindex method sshx with Cygwin -@cindex sshx method with Cygwin +@cindex method sshx with cygwin +@cindex sshx method with cygwin Cygwin's @command{ssh} works only with a Cygwin version of Emacs. To check for compatibility: type @kbd{M-x eshell}, and start @kbd{ssh @@ -2091,34 +2237,34 @@ Some older versions of Cygwin's @command{ssh} work with the @option{sshx} access method. Consult Cygwin's FAQ at @uref{https://cygwin.com/faq/} for details. -@cindex Cygwin and fakecygpty -@cindex fakecygpty and Cygwin +@cindex cygwin and fakecygpty +@cindex fakecygpty and cygwin On @uref{https://www.emacswiki.org/emacs/SshWithNTEmacs, the Emacs Wiki} it is explained how to use the helper program @code{fakecygpty} to fix this problem. -@cindex method scpx with Cygwin -@cindex scpx method with Cygwin +@cindex method scpx with cygwin +@cindex scpx method with cygwin When using the @option{scpx} access method, Emacs may call -@command{scp} with Windows file naming, such as @code{c:/foo}. But +@command{scp} with MS Windows file naming, such as @code{c:/foo}. But the version of @command{scp} that is installed with Cygwin does not -know about Windows file naming, which causes it to incorrectly look +know about MS Windows file naming, which causes it to incorrectly look for a host named @code{c}. A workaround: write a wrapper script for @option{scp} to convert Windows file names to Cygwin file names. -@cindex Cygwin and ssh-agent -@cindex SSH_AUTH_SOCK and Emacs on Windows +@cindex cygwin and ssh-agent +@cindex SSH_AUTH_SOCK and emacs on ms windows -When using the @command{ssh-agent} on Windows for password-less +When using the @command{ssh-agent} on MS Windows for password-less interaction, @option{ssh} methods depend on the environment variable @env{SSH_AUTH_SOCK}. But this variable is not set when Emacs is started from a Desktop shortcut and authentication fails. -One workaround is to use a Windows based SSH Agent, such as +One workaround is to use an MS Windows based SSH Agent, such as Pageant. It is part of the Putty Suite of tools. The fallback is to start Emacs from a shell. @@ -2716,11 +2862,11 @@ Arguments of the program to be debugged must be literal, can take relative or absolute paths, but not remote paths. -@subsection Running remote processes on Windows hosts +@subsection Running remote processes on MS Windows hosts @cindex winexe @cindex powershell -@command{winexe} runs processes on a remote Windows host, and +@command{winexe} runs processes on a remote MS Windows host, and @value{tramp} can use it for @code{process-file} and @code{start-file-process}. @@ -2730,7 +2876,7 @@ processes triggered from @value{tramp}. @option{explicit-shell-file-name} and @option{explicit-*-args} have to be set properly so @kbd{M-x shell} can open a proper remote shell on a -Windows host. To open @command{cmd}, set it as follows: +MS Windows host. To open @command{cmd}, set it as follows: @lisp @group @@ -3283,7 +3429,7 @@ Redefine another key sequence in Emacs for @kbd{C-x C-f}: (interactive) (find-file (read-file-name - "Find Tramp file: " + "Find @value{tramp} file: " "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}")))) @end group @end lisp @@ -3353,7 +3499,7 @@ The minibuffer expands for further editing. @item Use bookmarks: -Use bookmarks to save Tramp file names. +Use bookmarks to save @value{tramp} file names. @ifinfo @pxref{Bookmarks, , , emacs}. @end ifinfo @@ -3736,4 +3882,3 @@ strings from being written to @file{*trace-output*}. @c * Explain how tramp.el works in principle: open a shell on a remote @c host and then send commands to it. @c * Consistent small or capitalized words especially in menus. -@c * Make a unique declaration of @trampfn. diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index 05b577da00..5d9dcc5635 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -8,7 +8,7 @@ @c In the Tramp GIT, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.3.2 +@set trampver 2.3.3-pre @c Other flags from configuration @set instprefix /usr/local diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 4be487e1f4..527630d747 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -7,7 +7,7 @@ ;; Maintainer: Michael Albinus ;; Keywords: comm, processes ;; Package: tramp -;; Version: 2.3.2 +;; Version: 2.3.3-pre ;; This file is part of GNU Emacs. @@ -33,7 +33,7 @@ ;; should be changed only there. ;;;###tramp-autoload -(defconst tramp-version "2.3.2" +(defconst tramp-version "2.3.3-pre" "This version of Tramp.") ;;;###tramp-autoload @@ -55,7 +55,7 @@ ;; Check for Emacs version. (let ((x (if (>= emacs-major-version 24) "ok" - (format "Tramp 2.3.2 is not fit for %s" + (format "Tramp 2.3.3-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) commit 273f4bde39af5d87f10fd58f35b666dfa8a996a3 Author: Glenn Morris Date: Sun Jul 9 16:43:09 2017 -0700 Fix failing module tests on GNU/Linux * test/src/emacs-module-tests.el (module--test-assertions--load-non-live-object) (module--test-assertions--call-emacs-from-gc): Avoid test failures due to backtraces. diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index 988a7a178c..2aa85f0b24 100644 --- a/test/src/emacs-module-tests.el +++ b/test/src/emacs-module-tests.el @@ -230,7 +230,7 @@ aren’t accessed." (should (eq (mod-test-invalid-store) 123)) (module--test-assertion (rx "Emacs value not found in " (+ digit) " values of " - (+ digit) " environments\n" eos) + (+ digit) " environments\n") ;; Storing and reloading a local value causes undefined behavior, ;; which should be detected by the module assertions. (mod-test-invalid-store) @@ -241,7 +241,7 @@ aren’t accessed." during garbage collection." (skip-unless (file-executable-p mod-test-emacs)) (module--test-assertion - (rx "Module function called during garbage collection\n" eos) + (rx "Module function called during garbage collection\n") (mod-test-invalid-finalizer))) ;;; emacs-module-tests.el ends here commit 083940a93df17c6e50d6523e30d56ca3d179f688 Author: Paul Eggert Date: Sun Jul 9 16:04:02 2017 -0700 Fix core dump in substitute-object-in-subtree Without this fix, (substitute-object-in-subtree #0=(#0# 'a) 'a) would dump core, since the C code would recurse indefinitely through the infinite structure. This patch adds an argument to the function, and renames it to lread--substitute-object-in-subtree as the function is not general-purpose and should not be relied on by outside code. See Bug#23660. * src/intervals.c (traverse_intervals_noorder): ARG is now void *, not Lisp_Object, so that callers need not cons unnecessarily. All callers changed. Also, remove related #if-0 code that was “temporary” in the early 1990s and has not been compilable for some time. * src/lread.c (struct subst): New type, for substitution closure data. (seen_list): Remove this static var, as this info is now part of struct subst. All uses removed. (Flread__substitute_object_in_subtree): Rename from Fsubstitute_object_in_subtree, and give it a 3rd arg so that it doesn’t dump core when called from the top level with an already-cyclic structure. All callers changed. (SUBSTITUTE): Remove. All callers expanded and then simplified. (substitute_object_recurse): Take a single argument SUBST rather than a pair OBJECT and PLACEHOLDER, so that its address can be passed around as part of a closure; this avoids the need for an AUTO_CONS call. All callers changed. If the COMPLETED component is t, treat every subobject as potentially circular. (substitute_in_interval): Take a struct subst * rather than a Lisp_Object, for the closure data. All callers changed. * test/src/lread-tests.el (lread-lread--substitute-object-in-subtree): New test, to check that the core dump does not reoccur. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 65e30f8677..1494ed1d9c 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -906,7 +906,7 @@ circular objects. Let `read' read everything else." ;; with the object itself, wherever it occurs. (forward-char 1) (let ((obj (edebug-read-storing-offsets stream))) - (substitute-object-in-subtree obj placeholder) + (lread--substitute-object-in-subtree obj placeholder t) (throw 'return (setf (cdr elem) obj))))) ((eq ?# (following-char)) ;; #n# returns a previously read object. diff --git a/src/alloc.c b/src/alloc.c index ac3de83b2b..2d785d5b9a 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -1553,7 +1553,7 @@ make_interval (void) /* Mark Lisp objects in interval I. */ static void -mark_interval (register INTERVAL i, Lisp_Object dummy) +mark_interval (INTERVAL i, void *dummy) { /* Intervals should never be shared. So, if extra internal checking is enabled, GC aborts if it seems to have visited an interval twice. */ @@ -1567,7 +1567,7 @@ mark_interval (register INTERVAL i, Lisp_Object dummy) #define MARK_INTERVAL_TREE(i) \ do { \ if (i && !i->gcmarkbit) \ - traverse_intervals_noorder (i, mark_interval, Qnil); \ + traverse_intervals_noorder (i, mark_interval, NULL); \ } while (0) /*********************************************************************** diff --git a/src/intervals.c b/src/intervals.c index d17d80ac86..0089ecb8dd 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -224,7 +224,8 @@ intervals_equal (INTERVAL i0, INTERVAL i1) Pass FUNCTION two args: an interval, and ARG. */ void -traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) +traverse_intervals_noorder (INTERVAL tree, void (*function) (INTERVAL, void *), + void *arg) { /* Minimize stack usage. */ while (tree) @@ -257,69 +258,6 @@ traverse_intervals (INTERVAL tree, ptrdiff_t position, } } -#if 0 - -static int icount; -static int idepth; -static int zero_length; - -/* These functions are temporary, for debugging purposes only. */ - -INTERVAL search_interval, found_interval; - -void -check_for_interval (INTERVAL i) -{ - if (i == search_interval) - { - found_interval = i; - icount++; - } -} - -INTERVAL -search_for_interval (INTERVAL i, INTERVAL tree) -{ - icount = 0; - search_interval = i; - found_interval = NULL; - traverse_intervals_noorder (tree, &check_for_interval, Qnil); - return found_interval; -} - -static void -inc_interval_count (INTERVAL i) -{ - icount++; - if (LENGTH (i) == 0) - zero_length++; - if (depth > idepth) - idepth = depth; -} - -int -count_intervals (INTERVAL i) -{ - icount = 0; - idepth = 0; - zero_length = 0; - traverse_intervals_noorder (i, &inc_interval_count, Qnil); - - return icount; -} - -static INTERVAL -root_interval (INTERVAL interval) -{ - register INTERVAL i = interval; - - while (! ROOT_INTERVAL_P (i)) - i = INTERVAL_PARENT (i); - - return i; -} -#endif - /* Assuming that a left child exists, perform the following operation: A B diff --git a/src/intervals.h b/src/intervals.h index a0da6f3780..9140e0c17a 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -242,8 +242,7 @@ extern void traverse_intervals (INTERVAL, ptrdiff_t, void (*) (INTERVAL, Lisp_Object), Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, - void (*) (INTERVAL, Lisp_Object), - Lisp_Object); + void (*) (INTERVAL, void *), void *); extern INTERVAL split_interval_right (INTERVAL, ptrdiff_t); extern INTERVAL split_interval_left (INTERVAL, ptrdiff_t); extern INTERVAL find_interval (INTERVAL, ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index 8e7cd3c551..4d1a27d1c1 100644 --- a/src/lread.c +++ b/src/lread.c @@ -595,6 +595,20 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea } +/* An in-progress substitution of OBJECT for PLACEHOLDER. */ +struct subst +{ + Lisp_Object object; + Lisp_Object placeholder; + + /* Hash table of subobjects of OBJECT that might be circular. If + Qt, all such objects might be circular. */ + Lisp_Object completed; + + /* List of subobjects of OBJECT that have already been visited. */ + Lisp_Object seen; +}; + static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object read0 (Lisp_Object); @@ -603,9 +617,8 @@ static Lisp_Object read1 (Lisp_Object, int *, bool); static Lisp_Object read_list (bool, Lisp_Object); static Lisp_Object read_vector (Lisp_Object, bool); -static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, - Lisp_Object); -static void substitute_in_interval (INTERVAL, Lisp_Object); +static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object); +static void substitute_in_interval (INTERVAL, void *); /* Get a character from the tty. */ @@ -3107,7 +3120,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Fsubstitute_object_in_subtree (tem, placeholder); + Flread__substitute_object_in_subtree + (tem, placeholder, read_objects_completed); /* ...and #n# will use the real value from now on. */ i = hash_lookup (h, number, &hash); @@ -3513,26 +3527,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } } - -/* List of nodes we've seen during substitute_object_in_subtree. */ -static Lisp_Object seen_list; - -DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, - Ssubstitute_object_in_subtree, 2, 2, 0, - doc: /* Replace every reference to PLACEHOLDER in OBJECT with OBJECT. */) - (Lisp_Object object, Lisp_Object placeholder) +DEFUN ("lread--substitute-object-in-subtree", + Flread__substitute_object_in_subtree, + Slread__substitute_object_in_subtree, 3, 3, 0, + doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT. +COMPLETED is a hash table of objects that might be circular, or is t +if any object might be circular. */) + (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed) { - Lisp_Object check_object; - - /* We haven't seen any objects when we start. */ - seen_list = Qnil; - - /* Make all the substitutions. */ - check_object - = substitute_object_recurse (object, placeholder, object); - - /* Clear seen_list because we're done with it. */ - seen_list = Qnil; + struct subst subst = { object, placeholder, completed, Qnil }; + Lisp_Object check_object = substitute_object_recurse (&subst, object); /* The returned object here is expected to always eq the original. */ @@ -3541,26 +3545,12 @@ DEFUN ("substitute-object-in-subtree", Fsubstitute_object_in_subtree, return Qnil; } -/* Feval doesn't get called from here, so no gc protection is needed. */ -#define SUBSTITUTE(get_val, set_val) \ - do { \ - Lisp_Object old_value = get_val; \ - Lisp_Object true_value \ - = substitute_object_recurse (object, placeholder, \ - old_value); \ - \ - if (!EQ (old_value, true_value)) \ - { \ - set_val; \ - } \ - } while (0) - static Lisp_Object -substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) +substitute_object_recurse (struct subst *subst, Lisp_Object subtree) { /* If we find the placeholder, return the target object. */ - if (EQ (placeholder, subtree)) - return object; + if (EQ (subst->placeholder, subtree)) + return subst->object; /* For common object types that can't contain other objects, don't bother looking them up; we're done. */ @@ -3570,15 +3560,16 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj return subtree; /* If we've been to this node before, don't explore it again. */ - if (!EQ (Qnil, Fmemq (subtree, seen_list))) + if (!EQ (Qnil, Fmemq (subtree, subst->seen))) return subtree; /* If this node can be the entry point to a cycle, remember that we've seen it. It can only be such an entry point if it was made by #n=, which means that we can find it as a value in - read_objects_completed. */ - if (hash_lookup (XHASH_TABLE (read_objects_completed), subtree, NULL) >= 0) - seen_list = Fcons (subtree, seen_list); + COMPLETED. */ + if (EQ (subst->completed, Qt) + || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0) + subst->seen = Fcons (subtree, subst->seen); /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ @@ -3605,19 +3596,15 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj if (SUB_CHAR_TABLE_P (subtree)) i = 2; for ( ; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); + ASET (subtree, i, + substitute_object_recurse (subst, AREF (subtree, i))); return subtree; } case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } + XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree))); + XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree))); + return subtree; case Lisp_String: { @@ -3625,11 +3612,8 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj substitute_in_interval contains part of the logic. */ INTERVAL root_interval = string_intervals (subtree); - AUTO_CONS (arg, object, placeholder); - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); - + substitute_in_interval, subst); return subtree; } @@ -3641,12 +3625,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Helper function for substitute_object_recurse. */ static void -substitute_in_interval (INTERVAL interval, Lisp_Object arg) +substitute_in_interval (INTERVAL interval, void *arg) { - Lisp_Object object = Fcar (arg); - Lisp_Object placeholder = Fcdr (arg); - - SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value)); + set_interval_plist (interval, + substitute_object_recurse (arg, interval->plist)); } @@ -4744,7 +4726,7 @@ syms_of_lread (void) { defsubr (&Sread); defsubr (&Sread_from_string); - defsubr (&Ssubstitute_object_in_subtree); + defsubr (&Slread__substitute_object_in_subtree); defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); @@ -5057,8 +5039,6 @@ that are loaded before your customizations are read! */); read_objects_map = Qnil; staticpro (&read_objects_completed); read_objects_completed = Qnil; - staticpro (&seen_list); - seen_list = Qnil; Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); diff --git a/src/print.c b/src/print.c index 50c75d7712..b6ea3ff62a 100644 --- a/src/print.c +++ b/src/print.c @@ -566,7 +566,7 @@ temp_output_buffer_setup (const char *bufname) static void print (Lisp_Object, Lisp_Object, bool); static void print_preprocess (Lisp_Object); -static void print_preprocess_string (INTERVAL, Lisp_Object); +static void print_preprocess_string (INTERVAL, void *); static void print_object (Lisp_Object, Lisp_Object, bool); DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0, @@ -1214,7 +1214,7 @@ print_preprocess (Lisp_Object obj) case Lisp_String: /* A string may have text properties, which can be circular. */ traverse_intervals_noorder (string_intervals (obj), - print_preprocess_string, Qnil); + print_preprocess_string, NULL); break; case Lisp_Cons: @@ -1263,7 +1263,7 @@ Fills `print-number-table'. */) } static void -print_preprocess_string (INTERVAL interval, Lisp_Object arg) +print_preprocess_string (INTERVAL interval, void *arg) { print_preprocess (interval->plist); } diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 98cbb6a301..a0a317feee 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -164,4 +164,10 @@ literals (Bug#20852)." (concat (format-message "Loading `%s': " file-name) "old-style backquotes detected!"))))) +(ert-deftest lread-lread--substitute-object-in-subtree () + (let ((x (cons 0 1))) + (setcar x x) + (lread--substitute-object-in-subtree x 1 t) + (should (eq x (cdr x))))) + ;;; lread-tests.el ends here commit ce6773aad5c71f6c486244a6fc9fcb69fc99784d Author: Philipp Stephani Date: Mon Jul 10 00:33:30 2017 +0200 Minor simplification of module_free_global_ref * src/emacs-module.c (module_free_global_ref): Remove unused variable 'hashcode'. Inline variable 'value' that's only used once. diff --git a/src/emacs-module.c b/src/emacs-module.c index 7e0ba3c16c..ad6c8fb010 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -315,18 +315,13 @@ module_free_global_ref (emacs_env *env, emacs_value ref) MODULE_FUNCTION_BEGIN (); struct Lisp_Hash_Table *h = XHASH_TABLE (Vmodule_refs_hash); Lisp_Object obj = value_to_lisp (ref); - EMACS_UINT hashcode; - ptrdiff_t i = hash_lookup (h, obj, &hashcode); + ptrdiff_t i = hash_lookup (h, obj, NULL); if (i >= 0) { - Lisp_Object value = HASH_VALUE (h, i); - EMACS_INT refcount = XFASTINT (value) - 1; + EMACS_INT refcount = XFASTINT (HASH_VALUE (h, i)) - 1; if (refcount > 0) - { - value = make_natnum (refcount); - set_hash_value_slot (h, i, value); - } + set_hash_value_slot (h, i, make_natnum (refcount)); else { eassert (refcount == 0); commit 81131ff26fe2a36c2ed0a4853d85af3bcb8bbdb1 Author: Philipp Stephani Date: Mon Jul 10 00:28:50 2017 +0200 Re-add a useful assertion * src/emacs-module.c (module_free_global_ref): Re-add assertion that the reference count is zero. This assertion was removed in commit 8afaa1321f8088bfb877fe4b6676e8517adb0bb7, but it's not included in the test performed by XFASTINT before, because the previous reference count could have been zero already in the case of a buggy implementation. This assertion might have detected Bug#27587. diff --git a/src/emacs-module.c b/src/emacs-module.c index ba99698260..7e0ba3c16c 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -328,7 +328,10 @@ module_free_global_ref (emacs_env *env, emacs_value ref) set_hash_value_slot (h, i, value); } else - hash_remove_from_table (h, obj); + { + eassert (refcount == 0); + hash_remove_from_table (h, obj); + } } if (module_assertions) commit 22af69906cca871fdb893e06d6f10dbbab4518e6 Author: Valentin Gatien-Baron Date: Mon Jul 10 00:08:52 2017 +0200 Fix bug in module_free_global_ref (Bug#27587) * src/emacs-module.c (module_free_global_ref): Actually remove entry from hash table. Copyright-paperwork-exempt: yes diff --git a/src/emacs-module.c b/src/emacs-module.c index c5e56b1344..ba99698260 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -328,7 +328,7 @@ module_free_global_ref (emacs_env *env, emacs_value ref) set_hash_value_slot (h, i, value); } else - hash_remove_from_table (h, value); + hash_remove_from_table (h, obj); } if (module_assertions) commit bb2ea81bc569bdc51e1c9af1c503a22fb95e4384 Author: Philipp Stephani Date: Sun Jul 2 18:14:21 2017 +0200 Further improve electric quote support for Markdown (Bug#24709) Markdown sets both 'comment-start' and 'comment-use-syntax' to non-nil values. Therefore 'electric-quote-mode' recognized it as a programming mode. Fix this by first checking whether the current major mode is derived from 'text-mode'. * lisp/electric.el (electric-quote-post-self-insert-function): Treat 'text-mode' as stronger signal than comment syntax. * test/lisp/electric-tests.el (electric-quote-markdown-in-text) (electric-quote-markdown-in-code): Adapt unit tests. diff --git a/lisp/electric.el b/lisp/electric.el index 96c805bb5f..a71e79ff78 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -469,20 +469,20 @@ This requotes when a quoting key is typed." (and (not electric-quote-context-sensitive) (eq last-command-event ?\`))) (not (run-hook-with-args-until-success - 'electric-quote-inhibit-functions))) - (if (and comment-start comment-use-syntax) - (when (or electric-quote-comment electric-quote-string) - (let* ((syntax (syntax-ppss)) - (beg (nth 8 syntax))) - (and beg - (or (and electric-quote-comment (nth 4 syntax)) - (and electric-quote-string (nth 3 syntax))) - ;; Do not requote a quote that starts or ends - ;; a comment or string. - (eq beg (nth 8 (save-excursion - (syntax-ppss (1- (point))))))))) - (and electric-quote-paragraph - (derived-mode-p 'text-mode)))) + 'electric-quote-inhibit-functions)) + (if (derived-mode-p 'text-mode) + electric-quote-paragraph + (and comment-start comment-use-syntax + (or electric-quote-comment electric-quote-string) + (let* ((syntax (syntax-ppss)) + (beg (nth 8 syntax))) + (and beg + (or (and electric-quote-comment (nth 4 syntax)) + (and electric-quote-string (nth 3 syntax))) + ;; Do not requote a quote that starts or ends + ;; a comment or string. + (eq beg (nth 8 (save-excursion + (syntax-ppss (1- (point))))))))))) (pcase electric-quote-chars (`(,q< ,q> ,q<< ,q>>) (save-excursion diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el index c4ccec7a0d..c6ffccc079 100644 --- a/test/lisp/electric-tests.el +++ b/test/lisp/electric-tests.el @@ -694,6 +694,8 @@ baz\"\"" :bindings '((electric-quote-context-sensitive . t)) :test-in-comments nil :test-in-strings nil) +;; Simulate ‘markdown-mode’: it sets both ‘comment-start’ and +;; ‘comment-use-syntax’, but derives from ‘text-mode’. (define-electric-pair-test electric-quote-markdown-in-text "" "'" :expected-string "’" :expected-point 2 :modes '(text-mode) @@ -703,6 +705,7 @@ baz\"\"" (lambda () (save-excursion (search-backward "`" nil t))) nil :local)) + :bindings '((comment-start . " Alice: Authentication Response + +Alice -> Bob: Another authentication Request +Alice <-- Bob: another authentication Response +@enduml +#+end_src + +Please note that *pdf* *does not work out of the box* and needs additional +setup in addition to plantuml. See [[http://plantuml.com/pdf.html]] for +details and setup information. + +*** Rewrite of radio lists + +Radio lists, i.e, Org plain lists in foreign buffers, have been +rewritten to be on par with Radio tables. You can use a large set of +parameters to control how a given list should be rendered. See manual +for details. + +*** org-bbdb-anniversaries-future + +Used like ~org-bbdb-anniversaries~, it provides a few days warning for +upcoming anniversaries (default: 7 days). + +*** Clear non-repeated SCHEDULED upon repeating a task + +If the task is repeated, and therefore done at least one, scheduling +information is no longer relevant. It is therefore removed. + +See [[git:481719fbd5751aaa9c672b762cb43aea8ee986b0][commit message]] for more information. + +*** Support for ISO week trees + +ISO week trees are an alternative date tree format that orders entries +by ISO week and not by month. + +For example: + +: * 2015 +: ** 2015-W35 +: ** 2015-W36 +: *** 2015-08-31 Monday + +They are supported in org-capture via ~file+weektree~ and +~file+weektree+prompt~ target specifications. + +*** Accept ~:indent~ parameter when capturing column view + +When defining a "columnview" dynamic block, it is now possible to add +an :indent parameter, much like the one in the clock table. + +On the other hand, stars no longer appear in an ITEM field. + +*** Columns view + +**** ~org-columns~ accepts a prefix argument + +When called with a prefix argument, ~org-columns~ apply to the whole +buffer unconditionally. + +**** New variable : ~org-agenda-view-columns-initially~ + +The variable used to be a ~defvar~, it is now a ~defcustom~. + +**** Allow custom summaries + +It is now possible to add new summary types, or override those +provided by Org by customizing ~org-columns-summary-types~, which see. + +**** Allow multiple summaries for any property + +Columns can now summarize the same property using different summary +types. + +*** Preview LaTeX snippets in buffers not visiting files +*** New option ~org-attach-commit~ + +When non-nil, commit attachments with git, assuming the document is in +a git repository. + +*** Allow conditional case-fold searches in ~org-occur~ + +When set to ~smart~, the new variable ~org-occur-case-fold-search~ allows +to mimic =isearch.el=: if the regexp searched contains any upper case +character (or character class), the search is case sensitive. +Otherwise, it is case insensitive. + +*** More robust repeated =ox-latex= footnote handling + +Repeated footnotes are now numbered by referring to a label in the +first footnote. + +*** The ~org-block~ face is inherited by ~src-blocks~ + +This works also when =org-src-fontify-natively= is non-nil. It is also +possible to specify per-languages faces. See =org-src-block-faces= and +the manual for details. + +*** Links are now customizable + +Links can now have custom colors, tooltips, keymaps, display behavior, +etc. Links are now centralized in ~org-link-parameters~. + +** New functions + +*** ~org-next-line-empty-p~ + +It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~. + +*** ~org-show-children~ + +It is a faster implementation of ~outline-show-children~. + +** Removed functions + +*** ~org-agenda-filter-by-tag-refine~ has been removed. + +Use ~org-agenda-filter-by-tag~ instead. + +*** ~org-agenda-todayp~ is deprecated. + +Use ~org-agenda-today-p~ instead. + +*** ~org-babel-get-header~ is removed. + +Use ~org-babel--get-vars~ or ~assq~ instead, as applicable. + +*** ~org-babel-trim~ is deprecated. + +Use ~org-trim~ instead. + +*** ~org-element-remove-indentation~ is deprecated. + +Use ~org-remove-indentation~ instead. + +*** ~org-image-file-name-regexp~ is deprecated + +Use ~image-file-name-regexp~ instead. +The never-used-in-core ~extensions~ argument has been dropped. + +*** ~org-list-parse-list~ is deprecated + +Use ~org-list-to-lisp~ instead. + +*** ~org-on-heading-p~ is deprecated + +A comment to this effect was in the source code since 7.8.03, but +now a byte-compiler warning will be generated as well. + +*** ~org-table-p~ is deprecated + +Use ~org-at-table-p~ instead. + +*** ~org-table-recognize-table.el~ is deprecated + +It was not called by any org code since 2010. + +*** Various reimplementations of cl-lib functions are deprecated + +The affected functions are: +- ~org-count~ +- ~org-remove-if~ +- ~org-remove-if-not~ +- ~org-reduce~ +- ~org-every~ +- ~org-some~ + +Additionally, ~org-sublist~ is deprecated in favor of ~cl-subseq~. Note +the differences in indexing conventions: ~org-sublist~ is 1-based and +end-inclusive; ~cl-subseq~ is 0-based and end-exclusive. + +** Removed options + +*** Remove all options related to ~ido~ or ~iswitchb~ + +This includes ~org-completion-use-iswitchb~ and ~org-completion-use-ido~. +Instead Org uses regular functions, e.g., ~completion-read~ so as to +let those libraries operate. + +*** Remove ~org-list-empty-line-terminates-plain-lists~ + +Two consecutive blank lines always terminate all levels of current +plain list. + +*** ~fixltx2e~ is removed from ~org-latex-default-packages-alist~ + +fixltx2e is obsolete, see LaTeX News 22. + +** Miscellaneous +*** Add Icelandic smart quotes +*** Allow multiple receiver locations in radio tables and lists +*** Allow angular links within link descriptions + +It is now allowed to write, e.g., +~[[http:orgmode.org][]]~ as an equivalent to +~[[http:orgmode.org][file:unicorn.png]]~. The advantage of the former +is that spaces are allowed within the path. + +*** Beamer export back-ends uses ~org-latex-prefer-user-labels~ +*** ~:preparation-function~ called earlier during publishing + +Functions in this list are called before any file is associated to the +current projet. Thus, they can be used to generate to be published +Org files. + +*** Function ~org-remove-indentation~ changes. + +The new algorithm doesn't remove TAB characters not used for +indentation. + +*** Secure placeholders in capture templates + +Placeholders in capture templates are no longer expanded recursively. +However, ~%(...)~ constructs are expanded very late, so you can fill +the contents of the S-exp with the replacement text of non-interactive +placeholders. As before, interactive ones are still expanded as the +very last step, so the previous statement doesn't apply to them. + +Note that only ~%(...)~ placeholders initially present in the +template, or introduced using a file placeholder, i.e., ~%[...]~ are +expanded. This prevents evaluating potentially malicious code when +another placeholder, e.g., ~%i~ expands to a S-exp. + +*** Links stored by ~org-gnus-store-link~ in nnir groups + +Since gnus nnir groups are temporary, ~org-gnus-store-link~ now refers +to the article's original group. + +*** ~org-babel-check-confirm-evaluate~ is now a function instead of a macro + +The calling convention has changed. + +*** HTML export table row customization changes + +Variable ~org-html-table-row-tags~ has been split into +~org-html-table-row-open-tag~ and ~org-html-table-row-close-tag~. +Both new variables can be either a string or a function which will be +called with 6 parameters. + +*** =ITEM= special property returns headline without stars +*** Rename ~org-insert-columns-dblock~ into ~org-columns-insert-dblock~ + +The previous name is, for the time being, kept as an obsolete alias. + +*** ~org-trim~ can preserve leading indentation. + +When setting a new optional argument to a non-nil value, ~org-trim~ +preserves leading indentation while removing blank lines at the +beginning of the string. The behavior is identical for white space at +the end of the string. + +*** Function ~org-info-export~ changes. + +HTML links created from certain info links now point to =gnu.org= URL's rather +than just to local files. For example info links such as =info:emacs#List +Buffers= used to be converted to HTML links like this: + +: emacs#List Buffers + +where local file =emacs.html= is referenced. +For most folks this file does not exist. +Thus the new behavior is to generate this HTML link instead: + +: emacs#List Buffers + +All emacs related info links are similarly translated plus few other +=gnu.org= manuals. + +*** Repeaters with a ~++~ interval and a time can be shifted to later today + +Previously, if a recurring task had a timestamp of +~<2016-01-01 Fri 20:00 ++1d>~ and was completed on =2016-01-02= at +=08:00=, the task would skip =2016-01-02= and would be rescheduled for +=2016-01-03=. Timestamps with ~++~ cookies and a specific time will +now shift to the first possible future occurrence, even if the +occurrence is later the same day the task is completed. (Timestamps +already in the future are still shifted one time further into the +future.) + +*** ~org-mobile-action-alist~ is now a defconst + +It used to be a defcustom, with a warning that it shouldn't be +modified anyway. + +*** ~file+emacs~ and ~file+sys~ link types are deprecated + +They are still supported in Org 9.0 but will eventually be removed in +a later release. Use ~file~ link type along with universal arguments +to force opening it in either Emacs or with system application. + +*** New defcustom ~org-babel-J-command~ stores the j command +*** New defalias ~org-babel-execute:j~ + +Allows J source blocks be indicated by letter j. Previously the +indication letter was solely J. + +*** ~org-open-line~ ignores tables at the very beginning of the buffer + +When ~org-special-ctrl-o~ is non-nil, it is impractical to create +a blank line above a table at the beginning of the document. Now, as +a special case, ~org-open-line~ behaves normally in this situation. + +*** ~org-babel-hash-show-time~ is now customizable + +The experimental variable used to be more or less confidential, as +a ~defvar~. + +*** New ~:format~ property to parsed links + +It defines the format of the original link. Possible values are: +~plain~, ~bracket~ and ~angle~. + +* Version 8.3 + +** Incompatible changes + +*** Properties drawers syntax changes + +Properties drawers are now required to be located right after a +headline and its planning line, when applicable. + +It will break some documents as TODO states changes were sometimes +logged before the property drawer. + +The following function will repair them: + +#+BEGIN_SRC emacs-lisp +(defun org-repair-property-drawers () + "Fix properties drawers in current buffer. +Ignore non Org buffers." + (when (eq major-mode 'org-mode) + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t) + (inline-re (and (featurep 'org-inlinetask) + (concat (org-inlinetask-outline-regexp) + "END[ \t]*$")))) + (org-map-entries + (lambda () + (unless (and inline-re (org-looking-at-p inline-re)) + (save-excursion + (let ((end (save-excursion (outline-next-heading) (point)))) + (forward-line) + (when (org-looking-at-p org-planning-line-re) (forward-line)) + (when (and (< (point) end) + (not (org-looking-at-p org-property-drawer-re)) + (save-excursion + (and (re-search-forward org-property-drawer-re end t) + (eq (org-element-type + (save-match-data (org-element-at-point))) + 'drawer)))) + (insert (delete-and-extract-region + (match-beginning 0) + (min (1+ (match-end 0)) end))) + (unless (bolp) (insert "\n")))))))))))) +#+END_SRC + +*** Using "COMMENT" is now equivalent to commenting with "#" + +If you used "COMMENT" in headlines to prevent a subtree from being +exported, you can still do it but all information within the subtree +is now commented out, i.e. no #+OPTIONS line will be parsed or taken +into account when exporting. + +If you want to exclude a headline from export while using its contents +for setting options, use =:noexport:= (see =org-export-exclude-tags=.) + +*** =#+CATEGORY= keywords no longer apply partially to document + +It was possible to use several such keywords and have them apply to +the text below until the next one, but strongly deprecated since Org +5.14 (2008). + +=#+CATEGORY= keywords are now global to the document. You can use node +properties to set category for a subtree, e.g., + +#+BEGIN_SRC org +,* Headline + :PROPERTIES: + :CATEGORY: some category + :END: +#+END_SRC + +*** New variable to control visibility when revealing a location + +~org-show-following-heading~, ~org-show-siblings~, ~org-show-entry-below~ +and ~org-show-hierarchy-above~ no longer exist. Instead, visibility is +controlled through a single variable: ~org-show-context-detail~, which +see. + +*** Replace disputed keys again when reading a date + +~org-replace-disputed-keys~ has been ignored when reading date since +version 8.1, but the former behavior is restored again. + +Keybinding for reading date can be customized with a new variable +~org-read-date-minibuffer-local-map~. + +*** No default title is provided when =TITLE= keyword is missing + +Skipping =TITLE= keyword no longer provides the current file name, or +buffer name, as the title. Instead, simply ignore the title. + +*** Default bindings of =C-c C-n= and =C-c C-p= changed + +The key sequences =C-c C-n= and =C-c C-p= are now bound to +~org-next-visible-heading~ and ~org-previous-visible-heading~ +respectively, rather than the =outline-mode= versions of these +functions. The Org version of these functions skips over inline tasks +(and even-level headlines when ~org-odd-levels-only~ is set). + +*** ~org-element-context~ no longer return objects in keywords + +~org-element-context~ used to return objects on some keywords, i.e., +=TITLE=, =DATE= and =AUTHOR=. It now returns only the keyword. + +*** ~org-timer-default-timer~ type changed from number to string + +If you have, in your configuration, something like =(setq +org-timer-default-timer 10)= replace it with =(setq +org-timer-default-timer "10")=. + +*** Functions signature changes + +The following functions require an additional argument. See their +docstring for more information. + +- ~org-export-collect-footnote-definitions~ +- ~org-html-format-headline-function~ +- ~org-html-format-inlinetask-function~ +- ~org-latex-format-headline-function~ +- ~org-latex-format-inlinetask-function~ +- ~org-link-search~ + +** New features + +*** Default lexical evaluation of emacs-lisp src blocks + +Emacs-lisp src blocks in babel are now evaluated using lexical +scoping. There is a new header to control this behavior. + +The default results in an eval with lexical scoping. +:lexical yes + +This turns lexical scoping off in the eval (the former behavior). +:lexical no + +This uses the lexical environment with x=42 in the eval. +:lexical '((x . 42)) + +*** Behavior of ~org-return~ changed + +If point is before or after the headline title, insert a new line +without changing the headline. + +*** Hierarchies of tags + +The functionality of nesting tags in hierarchies is added to org-mode. +This is the generalization of what was previously called "Tag groups" +in the manual. That term is now changed to "Tag hierarchy". + +The following in-buffer definition: + +#+BEGIN_SRC org + ,#+TAGS: [ Group : SubOne SubTwo ] + ,#+TAGS: [ SubOne : SubOne1 SubOne2 ] + ,#+TAGS: [ SubTwo : SubTwo1 SubTwo2 ] +#+END_SRC + +Should be seen as the following tree of tags: + +- Group + - SubOne + - SubOne1 + - SubOne2 + - SubTwo + - SubTwo1 + - SubTwo2 + +Searching for "Group" should return all tags defined above. Filtering +on SubOne filters also it's sub-tags. Etc. + +There is no limit on the depth for the tag hierarchy. + +*** Additional syntax for non-unique grouptags + +Additional syntax is defined for grouptags if the tags in the group +don't have to be distinct on a heading. + +Grouptags had to previously be defined with { }. This syntax is +already used for exclusive tags and Grouptags need their own, +non-exclusive syntax. This behaviour is achieved with [ ]. Note: { } +can still be used also for Grouptags but then only one of the given +tags can be used on the headline at the same time. Example: + +[ group : sub1 sub2 ] + +#+BEGIN_SRC org +,* Test :sub1:sub2: +#+END_SRC + +This is a more general case than the already existing syntax for +grouptags; { }. + +*** Define regular expression patterns as tags + +Tags can be defined as grouptags with regular expressions as +"sub-tags". + +The regular expressions in the group must be marked up within { }. +Example use: + +: #+TAGS: [ Project : {P@.+} ] + +Searching for the tag Project will now list all tags also including +regular expression matches for P@.+. This is good for example for +projects tagged with a common identifier, i.e. P@2014_OrgTags. + +*** Filtering in the agenda on grouptags (Tag hierarchies) + +Filtering in the agenda on grouptags filters all of the related tags. +Except if a filter is applied with a (double) prefix-argument. + +Filtering in the agenda on subcategories does not filter the "above" +levels anymore. + +If a grouptag contains a regular expression the regular expression +is also used as a filter. + +*** Minor refactoring of ~org-agenda-filter-by-tag~ + +Now uses the argument ARG and optional argument exclude instead of +strip and narrow. ARG because the argument has multiple purposes and +makes more sense than strip now. The term "narrowing" is changed to +exclude. + +The main purpose is for the function to make more logical sense when +filtering on tags now when tags can be structured in hierarchies. + +*** Babel: support for sed scripts + +Thanks to Bjarte Johansen for this feature. + +*** Babel: support for Processing language + +New ob-processing.el library. + +This library implements necessary functions for implementing editing +of Processing code blocks, viewing the resulting sketches in an +external viewer, and HTML export of the sketches. + +Check the documentation for more details. + +Thanks to Jarmo Hurri for this feature. + +*** New behaviour for ~org-toggle-latex-fragment~ + +The new behaviour is the following: + +- With a double prefix argument or with a single prefix argument when + point is before the first headline, toggle overlays in the whole + buffer; + +- With a single prefix argument, toggle overlays in the current + subtree; + +- On latex code, toggle overlay at point; + +- Otherwise, toggle overlays in the current section. + +*** Additional markup with =#+INCLUDE= keyword + +The content of the included file can now be optionally marked up, for +instance as HTML. See the documentation for details. + +*** File links with =#+INCLUDE= keyword + +Objects can be extracted via =#+INCLUDE= using file links. It is +possible to include only the contents of the object. See manual for +more information. + +*** Drawers do not need anymore to be referenced in =#+DRAWERS= + +One can use a drawer without listing it in the =#+DRAWERS= keyword, +which is now obsolete. As a consequence, this change also deprecates +~org-drawers~ variable. + +*** ~org-edit-special~ can edit export blocks + +Using C-c ' on an export block now opens a sub-editing buffer. Major +mode in that buffer is determined by export backend name (e.g., +"latex" \to "latex-mode"). You can define exceptions to this rule by +configuring ~org-src-lang-modes~, which see. + +*** Additional =:hline= processing to ob-shell + +If the argument =:hlines yes= is present in a babel call, an optional +argument =:hlines-string= can be used to define a string to use as a +representation for the lisp symbol ='hline= in the shell program. The +default is =hline=. + +*** Markdown export supports switches in source blocks + +For example, it is now possible to number lines using the =-n= switch in +a source block. + +*** New option in ASCII export + +Plain lists can have an extra margin by setting ~org-ascii-list-margin~ +variable to an appopriate integer. + +*** New blocks in ASCII export + +ASCII export now supports =#+BEGIN_JUSTIFYRIGHT= and =#+BEGIN_JUSTIFYLEFT= +blocks. See documentation for details. + +*** More back-end specific publishing options + +The number of publishing options specific to each back-end has been +increased. See manual for details. + +*** Export inline source blocks + +Inline source code was used to be removed upon exporting. They are +now handled as standard code blocks, i.e., the source code can appear +in the output, depending on the parameters. + +*** Extend ~org-export-first-sibling-p~ and ~org-export-last-sibling-p~ + +These functions now support any element or object, not only headlines. + +*** New function: ~org-export-table-row-in-header-p~ + +*** New function: ~org-export-get-reference~ + +*** New function: ~org-element-lineage~ + +This function deprecates ~org-export-get-genealogy~. It also provides +more features. See docstring for details. + +*** New function: ~org-element-copy~ + +*** New filter: ~org-export-filter-body-functions~ + +Functions in this filter are applied on the body of the exported +document, befor wrapping it within the template. + +*** New :environment parameter when exporting example blocks to LaTeX + +: #+ATTR_LATEX: :environment myverbatim +: #+BEGIN_EXAMPLE +: This sentence is false. +: #+END_EXAMPLE + +will be exported using =@samp(myverbatim)= instead of =@samp(verbatim)=. + +*** Various improvements on radio tables + +Radio tables feature now relies on Org's export framework ("ox.el"). +~:no-escape~ parameter no longer exists, but additional global +parameters are now supported: ~:raw~, ~:backend~. Moreover, there are new +parameters specific to some pre-defined translators, e.g., +~:environment~ and ~:booktabs~ for ~orgtbl-to-latex~. See translators +docstrings (including ~orgtbl-to-generic~) for details. + +*** Non-floating minted listings in Latex export + +It is not possible to specify =#+attr_latex: :float nil= in conjunction +with source blocks exported by the minted package. + +*** Field formulas can now create columns as needed + +Previously, evaluating formulas that referenced out-of-bounds columns +would throw an error. A new variable ~org-table-formula-create-columns~ +was added to adjust this behavior. It is now possible to silently add +new columns, to do so with a warning or to explicitly ask the user +each time. + +*** ASCII plot + +Ability to plot values in a column through ASCII-art bars. See manual +for details. + +*** New hook: ~org-archive-hook~ + +This hook is called after successfully archiving a subtree, with point +on the original subtree, not yet deleted. + +*** New option: ~org-attach-archive-delete~ + +When non-nil, attachments from archived subtrees are removed. + +*** New option: ~org-latex-caption-above~ + +This variable generalizes ~org-latex-table-caption-above~, which is now +deprecated. In addition to tables, it applies to source blocks, +special blocks and images. See docstring for more information. + +*** New option: ~org-latex-prefer-user-labels~ + +See the docstring for more information. + +*** Export unnumbered headlines + +Headlines, for which the property ~UNNUMBERED~ is non-nil, are now +exported without section numbers irrespective of their levels. The +property is inherited by children. + +*** Tables can be sorted with an arbitrary function + +It is now possible to specify a function, both programatically, +through a new optional argument, and interactively with ~f~ or ~F~ keys, +to sort a table. + +*** Table of contents can be local to a section + +The ~TOC~ keywords now accepts an optional ~local~ parameter. See manual +for details. + +*** Countdown timers can now be paused + +~org-timer-pause-time~ now pauses and restarts both relative and +countdown timers. + +*** New option ~only-window~ for ~org-agenda-window-setup~ + +When ~org-agenda-window-setup~ is set to ~only-window~, the agenda is +displayed as the sole window of the current frame. + +*** ~{{{date}}}~ macro supports optional formatting argument + +It is now possible to supply and optional formatting argument to +~{{{date}}}~. See manual for details. + +*** ~{{{property}}}~ macro supports optional search argument + +It is now possible to supply an optional search option to +~{{{property}}}~ in order to retrieve remote properties optional. See +manual for details. + +*** New option ~org-export-with-title~ + +It is possible to suppress the title insertion with ~#+OPTIONS: +title:nil~ or globally using the variable ~org-export-with-title~. + +*** New entities family: "\_ " + +"\_ " are used to insert up to 20 contiguous spaces in various +back-ends. In particular, this family can be used to introduce +leading spaces within table cells. + +*** New MathJax configuration options + +Org uses the MathJax CDN by default. See the manual and the docstring +of ~org-html-mathjax-options~ for details. + +*** New behaviour in `org-export-options-alist' + +When defining a back-end, it is now possible to specify to give +`parse' behaviour on a keyword. It is equivalent to call +`org-element-parse-secondary-string' on the value. + +However, parsed =KEYWORD= is automatically associated to an +=:EXPORT_KEYWORD:= property, which can be used to override the keyword +value during a subtree export. Moreover, macros are expanded in such +keywords and properties. + +*** Viewport support in html export + +Viewport for mobile-optimized website is now automatically inserted +when exporting to html. See ~org-html-viewport~ for details. + +*** New ~#+SUBTITLE~ export keyword + +Org can typeset a subtitle in some export backends. See the manual +for details. + +*** Remotely edit a footnote definition + +Calling ~org-edit-footnote-reference~ (C-c ') on a footnote reference +allows to edit its definition, as long as it is not anonymous, in a +dedicated buffer. It works even if buffer is currently narrowed. + +*** New function ~org-delete-indentation~ bound to ~M-^~ + +Work as ~delete-indentation~ unless at heading, in which case text is +added to headline text. + +*** Support for images in Texinfo export + +~Texinfo~ back-end now handles images. See the manual for details. + +*** Support for captions in Texinfo export + +Tables and source blocks can now have captions. Additionally, lists +of tables and lists of listings can be inserted in the document with +=#+TOC= keyword. + +*** Countdown timer support hh:mm:ss format + +In addition to setting countdown timers in minutes, they can also be +set using the hh:mm:ss format. + +*** Extend ~org-clone-subtree-with-time-shift~ + +~org-clone-subtree-with-time-shift~ now accepts 0 as an argument for the +number of clones, which removes the repeater from the original subtree +and creates one shifted, repeating clone. + +*** New time block for clock tables: ~untilnow~ + +It encompasses all past closed clocks. + +*** Support for the ~polyglossia~ LaTeX package + +See the docstring of ~org-latex-classes~ and +~org-latex-guess-polyglossia-language~ for details. + +*** None-floating tables, graphics and blocks can have captions + +*** `org-insert-heading' can be forced to insert top-level headline + +** Removed functions + +*** Removed function ~org-translate-time~ + +Use ~org-timestamp-translate~ instead. + +*** Removed function ~org-beamer-insert-options-template~ + +This function inserted a Beamer specific template at point or in +current subtree. Use ~org-export-insert-default-template~ instead, as +it provides more features and covers all export back-ends. It is also +accessible from the export dispatcher. + +*** Removed function ~org-timer-cancel-timer~ + +~org-timer-stop~ now stops both relative and countdown timers. + +*** Removed function ~org-export-solidify-link-text~ + +This function, being non-bijective, introduced bug in internal +references. Use ~org-export-get-reference~ instead. + +*** Removed function ~org-end-of-meta-data-and-drawers~ + +The function is superseded by ~org-end-of-meta-data~, called with an +optional argument. + +*** Removed functions ~org-table-colgroup-line-p~, ~org-table-cookie-line-p~ + +These functions were left-over from pre 8.0 era. They are not correct +anymore. Since they are not needed, they have no replacement. + +** Removed options + +*** ~org-list-empty-line-terminates-plain-lists~ is deprecated + +It will be kept in code base until next release, for backward +compatibility. + +If you need to separate consecutive lists with blank lines, always use +two of them, as if this option was nil (default value). + +*** ~org-export-with-creator~ is a boolean + +Special ~comment~ value is no longer allowed. It is possible to use a +body filter to add comments about the creator at the end of the +document instead. + +*** Removed option =org-html-use-unicode-chars= + +Setting this to non-nil was problematic as it converted characters +everywhere in the buffer, possibly corrupting URLs. + +*** Removed option =org-babel-sh-command= + +This undocumented option defaulted to the value of =shell-file-name= at +the time of loading =ob-shell=. The new behaviour is to use the value +of =shell-file-name= directly when the shell langage is =shell=. To chose +a different shell, either customize =shell-file-name= or bind this +variable locally. + +*** Removed option =org-babel-sh-var-quote-fmt= + +This undocumented option was supposed to provide different quoting +styles when changing the shell type. Changing the shell type can now +be done directly from the source block and the quoting style has to be +compatible across all shells, so a customization doesn't make sense +anymore. The chosen hard coded quoting style conforms to POSIX. + +*** Removed option ~org-insert-labeled-timestamps-at-point~ + +Setting this option to anything else that the default value (nil) +would create invalid planning info. This dangerous option is now +removed. + +*** Removed option ~org-koma-letter-use-title~ + +Use org-export-with-title instead. See also below. + +*** Removed option ~org-entities-ascii-explanatory~ + +This variable has no effect since Org 8.0. + +*** Removed option ~org-table-error-on-row-ref-crossing-hline~ + +This variable has no effect since August 2009. + +*** Removed MathML-related options from ~org-html-mathjax-options~ + +MathJax automatically chooses the best display technology based on the +end-users browser. You may force initial usage of MathML via +~org-html-mathjax-template~ or by setting the ~path~ property of +~org-html-mathjax-options~. + +*** Removed comment-related filters + +~org-export-filter-comment-functions~ and +~org-export-filter-comment-block-functions~ variables do not exist +anymore. + +** Miscellaneous + +*** Strip all meta data from ITEM special property + +ITEM special property does not contain TODO, priority or tags anymore. + +*** File names in links accept are now compatible with URI syntax + +Absolute file names can now start with =///= in addition to =/=. E.g., +=[[file:///home/me/unicorn.jpg]]=. + +*** Footnotes in included files are now local to the file + +As a consequence, it is possible to include multiple Org files with +footnotes in a master document without being concerned about footnote +labels colliding. + +*** Mailto links now use regular URI syntax + +This change deprecates old Org syntax for mailto links: +=mailto:user@domain::Subject=. + +*** =QUOTE= keywords do not exist anymore + +=QUOTE= keywords have been deprecated since Org 8.2. + +*** Select tests to perform with the build system + +The build system has been enhanced to allow test selection with a +regular expression by defining =BTEST_RE= during the test invocation. +This is especially useful during bisection to find just when a +particular test failure was introduced. + +*** Exact heading search for external links ignore spaces and cookies + +Exact heading search for links now ignore spaces and cookies. This is +the case for links of the form ~file:projects.org::*task title~, as well +as links of the form ~file:projects.org::some words~ when +~org-link-search-must-match-exact-headline~ is not nil. + +*** ~org-latex-hyperref-template~, ~org-latex-title-command~ formatting + +New formatting keys are supported. See the respective docstrings. +Note, ~org-latex-hyperref-template~ has a new default value. + +*** ~float, wasysym, marvosym~ are removed from ~org-latex-default-packages-alist~ + +If you require any of these package add them to your preamble via +~org-latex-packages-alist~. Org also uses default LaTeX ~\tolerance~ now. + +*** When exporting, throw an error on unresolved id/fuzzy links and code refs + +This helps spotting wrong links. + +* Version 8.2 + +** Incompatible changes +*** =ob-sh.el= renamed to =ob-shell= +This may require two changes in user config. + +1. In =org-babel-do-load-languages=, change =(sh . t)= to =(shell . t)=. +2. Edit =local.mk= files to change the value of =BTEST_OB_LANGUAGES= + to remove "sh" and include "shell". + *** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el Please remove calls to =(require 'org-mac-message)= and =(require @@ -171,6 +1522,18 @@ then inline code snippets will be wrapped into the formatting string. - =org-screenshot.el= by Max Mikhanosha :: an utility to handle screenshots easily from Org, using the external tool [[http://freecode.com/projects/scrot][scrot]]. +** Miscellaneous + +*** "QUOTE" keywords in headlines are deprecated + +"QUOTE" keywords are an undocumented feature in Org. When a headline +starts with the keyword "QUOTE", its contents are parsed as +a ~quote-section~ and treated as an example block. You can achieve +the same with example blocks. + +This feature is deprecated and will be removed in the next Org +release. + * Version 8.0.1 ** Installation @@ -835,14 +2198,14 @@ See [[http://orgmode.org/org.html#Lookup-functions][the manual]] for details. These new startup keywords are now available: -| Startup keyword | Option | -|----------------------------------+---------------------------------------------| +| Startup keyword | Option | +|--------------------------------+-------------------------------------------| | =#+STARTUP: logdrawer= | =(setq org-log-into-drawer t)= | | =#+STARTUP: nologdrawer= | =(setq org-log-into-drawer nil)= | -|----------------------------------+---------------------------------------------| +|--------------------------------+-------------------------------------------| | =#+STARTUP: logstatesreversed= | =(setq org-log-states-order-reversed t)= | | =#+STARTUP: nologstatesreversed= | =(setq org-log-states-order-reversed nil)= | -|----------------------------------+---------------------------------------------| +|--------------------------------+-------------------------------------------| | =#+STARTUP: latexpreview= | =(setq org-startup-with-latex-preview t)= | | =#+STARTUP: nolatexpreview= | =(setq org-startup-with-latex-preview nil)= | @@ -952,7 +2315,7 @@ instead of requiring each Babel library one by one. - New option [[doc:org-gnus-no-server][org-gnus-no-server]] to start Gnus with =gnus-no-server= - Org is now distributed with =htmlize.el= version 1.43 - ~org-drill.el~ has been updated to version 2.3.7 -- ~org-mac-iCal.el~ now supports OS X versions up to 10.8 +- ~org-mac-iCal.el~ now supports MacOSX version up to 10.8 - Various improvements to ~org-contacts.el~ and =orgpan.el= ** Outside Org @@ -1021,6 +2384,13 @@ consistent with using the `:' key in agenda view. You can now use `=' for [[doc::org-columns][org-columns]]. ** =org-float= is now obsolete, use =diary-float= instead +** No GPL manual anymore + +There used to be a GPL version of the Org manual, but this is not the +case anymore, the Free Software Foundation does not permit this. + +The GNU FDL license is now included in the manual directly. + ** Enhanced compatibility with Emacs 22 and XEmacs Thanks to Achim for his work on enhancing Org's compatibility with @@ -1046,8 +2416,8 @@ See http://orgmode.org/elpa/ ** Overview of the new keybindings - | Keybinding | Speedy | Command | - |-----------------+--------+-----------------------------| + | Keybinding | Speedy | Command | + |---------------+--------+-----------------------------| | =C-c C-x C-z= | | [[doc::org-clock-resolve][org-clock-resolve]] | | =C-c C-x C-q= | | [[doc::org-clock-cancel][org-clock-cancel]] | | =C-c C-x C-x= | | [[doc::org-clock-in-last][org-clock-in-last]] | @@ -1055,12 +2425,12 @@ See http://orgmode.org/elpa/ | =*= | | [[doc::org-agenda-bulk-mark-all][org-agenda-bulk-mark-all]] | | =C-c C-M-l= | | [[doc::org-insert-all-links][org-insert-all-links]] | | =C-c C-x C-M-v= | | [[doc::org-redisplay-inline-images][org-redisplay-inline-images]] | - | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] | - | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] | - | | =:= | [[doc::org-columns][org-columns]] | - | | =W= | Set =APPT_WARNTIME= | + | =C-c C-x E= | =E= | [[doc::org-inc-effort][org-inc-effort]] | + | | =#= | [[doc::org-toggle-comment][org-toggle-comment]] | + | | =:= | [[doc::org-columns][org-columns]] | + | | =W= | Set =APPT_WARNTIME= | | =k= | | [[doc::org-agenda-capture][org-agenda-capture]] | - | C-c , | , | [[doc::org-priority][org-priority]] | + | C-c , | , | [[doc::org-priority][org-priority]] | ** New package and Babel language @@ -1225,7 +2595,7 @@ See http://orgmode.org/elpa/ **** New =todo-unblocked= and =nottodo-unblocked= skip conditions - See the [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3Df426da][git commit]] for more explanations. + See the [[http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=f426da][git commit]] for more explanations. **** Allow category filtering in the agenda @@ -1542,7 +2912,7 @@ See http://orgmode.org/elpa/ Thanks to Carsten for implementing this. **** ODT: Add support for ODT export in org-bbdb.el -**** ODT: Add support for indented tables (see [[http://orgmode.org/w/?p%3Dorg-mode.git%3Ba%3Dcommit%3Bh%3De9fd33][this commit]] for details) +**** ODT: Add support for indented tables (see [[http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=e9fd33][this commit]] for details) **** ODT: Improve the conversion from ODT to other formats **** ASCII: Swap the level-1/level-2 characters to underline the headlines **** Support for Chinese, simplified Chinese, Russian, Ukrainian and Japanese diff --git a/etc/org/OrgOdtStyles.xml b/etc/org/OrgOdtStyles.xml index f41d9840cb..1a8edee99b 100644 --- a/etc/org/OrgOdtStyles.xml +++ b/etc/org/OrgOdtStyles.xml @@ -109,33 +109,53 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/etc/org/README b/etc/org/README index 68905add81..d04f434962 100644 --- a/etc/org/README +++ b/etc/org/README @@ -1,7 +1,7 @@ The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the following copyright information: -Copyright (C) 2010-2017 Free Software Foundation, Inc. +Copyright (C) 2010-2014 Free Software Foundation, Inc. These files are part of GNU Emacs. diff --git a/etc/org/library-of-babel.org b/etc/org/library-of-babel.org new file mode 100644 index 0000000000..0098e72639 --- /dev/null +++ b/etc/org/library-of-babel.org @@ -0,0 +1,584 @@ +#+title: The Library of Babel +#+author: Org-mode People +#+STARTUP: hideblocks + +* Introduction + +The Library of Babel is an extensible collection of ready-made and +easily-shortcut-callable source-code blocks for handling common tasks. +Org-babel comes pre-populated with the source-code blocks located in +this file. It is possible to add source-code blocks from any org-mode +file to the library by calling =(org-babel-lob-ingest +"path/to/file.org")=. + +This file is included in worg mainly less for viewing through the web +interface, and more for contribution through the worg git repository. +If you have code snippets that you think others may find useful please +add them to this file and [[file:~/src/worg/worg-git.org::contribute-to-worg][contribute them]] to worg. + +The raw Org-mode text of this file can be downloaded at +[[repofile:contrib/babel/library-of-babel.org][library-of-babel.org]] + +* Simple + +A collection of simple utility functions: + +#+name: echo +#+begin_src emacs-lisp :var input="echo'd" + input +#+end_src + +* File I/O + +** Reading and writing files + +Read the contents of the file at =file=. The =:results vector= and +=:results scalar= header arguments can be used to read the contents of +file as either a table or a string. + +#+name: read +#+begin_src emacs-lisp :var file="" :var format="" + (if (string= format "csv") + (with-temp-buffer + (org-table-import (expand-file-name file) nil) + (org-table-to-lisp)) + (with-temp-buffer + (insert-file-contents (expand-file-name file)) + (buffer-string))) +#+end_src + +Write =data= to a file at =file=. If =data= is a list, then write it +as a table in traditional Org-mode table syntax. + +#+name: write +#+begin_src emacs-lisp :var data="" :var file="" :var ext='() + (flet ((echo (r) (if (stringp r) r (format "%S" r)))) + (with-temp-file file + (case (and (listp data) + (or ext (intern (file-name-extension file)))) + ('tsv (insert (orgtbl-to-tsv data '(:fmt echo)))) + ('csv (insert (orgtbl-to-csv data '(:fmt echo)))) + (t (org-babel-insert-result data))))) + nil +#+end_src + +** Remote files + +*** json + +Read local or remote file in [[http://www.json.org/][json]] format into emacs-lisp objects. + +#+name: json +#+begin_src emacs-lisp :var file='() :var url='() + (require 'json) + (cond + (file + (with-temp-filebuffer file + (goto-char (point-min)) + (json-read))) + (url + (require 'w3m) + (with-temp-buffer + (w3m-retrieve url) + (goto-char (point-min)) + (json-read)))) +#+end_src + +*** Google docs + +The following code blocks make use of the [[http://code.google.com/p/googlecl/][googlecl]] Google command line +tool. This tool provides functionality for accessing Google services +from the command line, and the following code blocks use /googlecl/ +for reading from and writing to Google docs with Org-mode code blocks. + +**** Read a document from Google docs + +The =google= command seems to be throwing "Moved Temporarily" errors +when trying to download textual documents, but this is working fine +for spreadsheets. + +#+name: gdoc-read +#+begin_src emacs-lisp :var title="example" :var format="csv" + (let* ((file (concat title "." format)) + (cmd (format "google docs get --format %S --title %S" format title))) + (message cmd) (message (shell-command-to-string cmd)) + (prog1 (if (string= format "csv") + (with-temp-buffer + (org-table-import (shell-quote-argument file) '(4)) + (org-table-to-lisp)) + (with-temp-buffer + (insert-file-contents (shell-quote-argument file)) + (buffer-string))) + (delete-file file))) +#+end_src + +For example, a line like the following can be used to read the +contents of a spreadsheet named =num-cells= into a table. +: #+call: gdoc-read(title="num-cells"") + +A line like the following can be used to read the contents of a +document as a string. + +: #+call: gdoc-read(title="loremi", :format "txt") + +**** Write a document to a Google docs + +Write =data= to a google document named =title=. If =data= is tabular +it will be saved to a spreadsheet, otherwise it will be saved as a +normal document. + +#+name: gdoc-write +#+begin_src emacs-lisp :var title="babel-upload" :var data=fibs(n=10) :results silent + (let* ((format (if (listp data) "csv" "txt")) + (tmp-file (make-temp-file "org-babel-google-doc" nil (concat "." format))) + (cmd (format "google docs upload --title %S %S" title tmp-file))) + (with-temp-file tmp-file + (insert + (if (listp data) + (orgtbl-to-csv + data '(:fmt (lambda (el) (if (stringp el) el (format "%S" el))))) + (if (stringp data) data (format "%S" data))))) + (message cmd) + (prog1 (shell-command-to-string cmd) (delete-file tmp-file))) +#+end_src + +example usage +: #+name: fibs +: #+begin_src emacs-lisp :var n=8 +: (flet ((fib (m) (if (< m 2) 1 (+ (fib (- m 1)) (fib (- m 2)))))) +: (mapcar (lambda (el) (list el (fib el))) (number-sequence 0 (- n 1)))) +: #+end_src +: +: #+call: gdoc-write(title="fibs", data=fibs(n=10)) + +* Plotting code + +** R + +Plot column 2 (y axis) against column 1 (x axis). Columns 3 and +beyond, if present, are ignored. + +#+name: R-plot +#+begin_src R :var data=R-plot-example-data +plot(data) +#+end_src + +#+tblname: R-plot-example-data +| 1 | 2 | +| 2 | 4 | +| 3 | 9 | +| 4 | 16 | +| 5 | 25 | + +#+call: R-plot(data=R-plot-example-data) + +#+resname: R-plot(data=R-plot-example-data) +: nil + +** Gnuplot + +* Org reference + +** Headline references + +#+name: headline +#+begin_src emacs-lisp :var headline=top :var file='() + (save-excursion + (when file (get-file-buffer file)) + (org-open-link-from-string (org-make-link-string headline)) + (save-restriction + (org-narrow-to-subtree) + (buffer-string))) +#+end_src + +#+call: headline(headline="headline references") + +* Tables + +** LaTeX Table Export + +*** booktabs + +This source block can be used to wrap a table in the latex =booktabs= +environment. The source block adds a =toprule= and =bottomrule= (so +don't use =hline= at the top or bottom of the table). The =hline= +after the header is replaced with a =midrule=. + +Note that this function bypasses the Org-mode LaTeX exporter and calls +=orgtbl-to-generic= to create the output table. This means that the +entries in the table are not translated from Org-mode to LaTeX. + +It takes the following arguments -- all but the first two are +optional. + +| arg | description | +|-------+--------------------------------------------| +| table | a reference to the table | +| align | alignment string | +| env | optional environment, default to "tabular" | +| width | optional width specification string | + +#+name: booktabs +#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var align='() :var env="tabular" :var width='() :noweb yes :results latex + (flet ((to-tab (tab) + (orgtbl-to-generic + (mapcar (lambda (lis) + (if (listp lis) + (mapcar (lambda (el) + (if (stringp el) + el + (format "%S" el))) lis) + lis)) tab) + (list :lend " \\\\" :sep " & " :hline "\\hline")))) + (org-fill-template + " + \\begin{%env}%width%align + \\toprule + %table + \\bottomrule + \\end{%env}\n" + (list + (cons "env" (or env "table")) + (cons "width" (if width (format "{%s}" width) "")) + (cons "align" (if align (format "{%s}" align) "")) + (cons "table" + ;; only use \midrule if it looks like there are column headers + (if (equal 'hline (second table)) + (concat (to-tab (list (first table))) + "\n\\midrule\n" + (to-tab (cddr table))) + (to-tab table)))))) +#+end_src + +*** longtable + +This block can be used to wrap a table in the latex =longtable= +environment, it takes the following arguments -- all but the first two +are optional. + +| arg | description | +|-----------+-------------------------------------------------------------| +| table | a reference to the table | +| align | optional alignment string | +| width | optional width specification string | +| hline | the string to use as hline separator, defaults to "\\hline" | +| head | optional "head" string | +| firsthead | optional "firsthead" string | +| foot | optional "foot" string | +| lastfoot | optional "lastfoot" string | + +#+name: longtable +#+begin_src emacs-lisp :var table='((:table)) :var align='() :var width='() :var hline="\\hline" :var firsthead='() :var head='() :var foot='() :var lastfoot='() :noweb yes :results latex + (org-fill-template + " + \\begin{longtable}%width%align + %firsthead + %head + %foot + %lastfoot + + %table + \\end{longtable}\n" + (list + (cons "width" (if width (format "{%s}" width) "")) + (cons "align" (if align (format "{%s}" align) "")) + (cons "firsthead" (if firsthead (concat firsthead "\n\\endfirsthead\n") "")) + (cons "head" (if head (concat head "\n\\endhead\n") "")) + (cons "foot" (if foot (concat foot "\n\\endfoot\n") "")) + (cons "lastfoot" (if lastfoot (concat lastfoot "\n\\endlastfoot\n") "")) + (cons "table" (orgtbl-to-generic + (mapcar (lambda (lis) + (if (listp lis) + (mapcar (lambda (el) + (if (stringp el) + el + (format "%S" el))) lis) + lis)) table) + (list :lend " \\\\" :sep " & " :hline hline))))) +#+end_src + +*** booktabs-notes + +This source block builds on [[booktabs]]. It accepts two additional +arguments, both of which are optional. + +#+tblname: arguments +| arg | description | +|--------+------------------------------------------------------| +| notes | an org-mode table with footnotes | +| lspace | if non-nil, insert =addlinespace= after =bottomrule= | + +An example footnote to the =arguments= table specifies the column +span. Note the use of LaTeX, rather than Org-mode, markup. + +#+tblname: arguments-notes +| \multicolumn{2}{l}{This is a footnote to the \emph{arguments} table.} | + +#+name: booktabs-notes +#+begin_src emacs-lisp :var table='((:head) hline (:body)) :var notes='() :var align='() :var env="tabular" :var width='() :var lspace='() :noweb yes :results latex + (flet ((to-tab (tab) + (orgtbl-to-generic + (mapcar (lambda (lis) + (if (listp lis) + (mapcar (lambda (el) + (if (stringp el) + el + (format "%S" el))) lis) + lis)) tab) + (list :lend " \\\\" :sep " & " :hline "\\hline")))) + (org-fill-template + " + \\begin{%env}%width%align + \\toprule + %table + \\bottomrule%spacer + %notes + \\end{%env}\n" + (list + (cons "env" (or env "table")) + (cons "width" (if width (format "{%s}" width) "")) + (cons "align" (if align (format "{%s}" align) "")) + (cons "spacer" (if lspace "\\addlinespace" "")) + (cons "table" + ;; only use \midrule if it looks like there are column headers + (if (equal 'hline (second table)) + (concat (to-tab (list (first table))) + "\n\\midrule\n" + (to-tab (cddr table))) + (to-tab table))) + (cons "notes" (if notes (to-tab notes) "")) + ))) +#+end_src + +** Elegant lisp for transposing a matrix + +#+tblname: transpose-example +| 1 | 2 | 3 | +| 4 | 5 | 6 | + +#+name: transpose +#+begin_src emacs-lisp :var table=transpose-example + (apply #'mapcar* #'list table) +#+end_src + +#+resname: +| 1 | 4 | +| 2 | 5 | +| 3 | 6 | + +** Convert every element of a table to a string + +#+tblname: hetero-table +| 1 | 2 | 3 | +| a | b | c | + +#+name: all-to-string +#+begin_src emacs-lisp :var tbl='() + (defun all-to-string (tbl) + (if (listp tbl) + (mapcar #'all-to-string tbl) + (if (stringp tbl) + tbl + (format "%s" tbl)))) + (all-to-string tbl) +#+end_src + +#+begin_src emacs-lisp :var tbl=hetero-table + (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl) +#+end_src + +#+name: +| nil | nil | nil | +| t | t | t | + +#+begin_src emacs-lisp :var tbl=all-to-string(hetero-table) + (mapcar (lambda (row) (mapcar (lambda (cell) (stringp cell)) row)) tbl) +#+end_src + +#+name: +| t | t | t | +| t | t | t | + +* Misc + +** File-specific Version Control logging + :PROPERTIES: + :AUTHOR: Luke Crook + :END: + +This function will attempt to retrieve the entire commit log for the +file associated with the current buffer and insert this log into the +export. The function uses the Emacs VC commands to interface to the +local version control system, but has only been tested to work with +Git. 'limit' is currently unsupported. + +#+name: vc-log +#+headers: :var limit=-1 +#+headers: :var buf=(buffer-name (current-buffer)) +#+begin_src emacs-lisp + ;; Most of this code is copied from vc.el vc-print-log + (require 'vc) + (when (vc-find-backend-function + (vc-backend (buffer-file-name (get-buffer buf))) 'print-log) + (let ((limit -1) + (vc-fileset nil) + (backend nil) + (files nil)) + (with-current-buffer (get-buffer buf) + (setq vc-fileset (vc-deduce-fileset t)) ; FIXME: Why t? --Stef + (setq backend (car vc-fileset)) + (setq files (cadr vc-fileset))) + (with-temp-buffer + (let ((status (vc-call-backend + backend 'print-log files (current-buffer)))) + (when (and (processp status) ; Make sure status is a process + (= 0 (process-exit-status status))) ; which has not terminated + (while (not (eq 'exit (process-status status))) + (sit-for 1 t))) + (buffer-string))))) +#+end_src + +** Trivial python code blocks + +#+name: python-identity +#+begin_src python :var a=1 +a +#+end_src + +#+name: python-add +#+begin_src python :var a=1 :var b=2 +a + b +#+end_src + +** Arithmetic + +#+name: lob-add +#+begin_src emacs-lisp :var a=0 :var b=0 + (+ a b) +#+end_src + +#+name: lob-minus +#+begin_src emacs-lisp :var a=0 :var b=0 + (- a b) +#+end_src + +#+name: lob-times +#+begin_src emacs-lisp :var a=0 :var b=0 + (* a b) +#+end_src + +#+name: lob-div +#+begin_src emacs-lisp :var a=0 :var b=0 + (/ a b) +#+end_src + +* GANTT Charts + +The =elispgantt= source block was sent to the mailing list by Eric +Fraga. It was modified slightly by Tom Dye. + +#+name: elispgantt +#+begin_src emacs-lisp :var table=gantttest + (let ((dates "") + (entries (nthcdr 2 table)) + (milestones "") + (nmilestones 0) + (ntasks 0) + (projecttime 0) + (tasks "") + (xlength 1)) + (message "Initial: %s\n" table) + (message "Entries: %s\n" entries) + (while entries + (let ((entry (first entries))) + (if (listp entry) + (let ((id (first entry)) + (type (nth 1 entry)) + (label (nth 2 entry)) + (task (nth 3 entry)) + (dependencies (nth 4 entry)) + (start (nth 5 entry)) + (duration (nth 6 entry)) + (end (nth 7 entry)) + (alignment (nth 8 entry))) + (if (> start projecttime) (setq projecttime start)) + (if (string= type "task") + (let ((end (+ start duration)) + (textposition (+ start (/ duration 2))) + (flush "")) + (if (string= alignment "left") + (progn + (setq textposition start) + (setq flush "[left]")) + (if (string= alignment "right") + (progn + (setq textposition end) + (setq flush "[right]")))) + (setq tasks + (format "%s \\gantttask{%s}{%s}{%d}{%d}{%d}{%s}\n" + tasks label task start end textposition flush)) + (setq ntasks (+ 1 ntasks)) + (if (> end projecttime) + (setq projecttime end))) + (if (string= type "milestone") + (progn + (setq milestones + (format + "%s \\ganttmilestone{$\\begin{array}{c}\\mbox{%s}\\\\ \\mbox{%s}\\end{array}$}{%d}\n" + milestones label task start)) + (setq nmilestones (+ 1 nmilestones))) + (if (string= type "date") + (setq dates (format "%s \\ganttdateline{%s}{%d}\n" + dates label start)) + (message "Ignoring entry with type %s\n" type))))) + (message "Ignoring non-list entry %s\n" entry)) ; end if list entry + (setq entries (cdr entries)))) ; end while entries left + (format "\\pgfdeclarelayer{background} + \\pgfdeclarelayer{foreground} + \\pgfsetlayers{background,foreground} + \\renewcommand{\\ganttprojecttime}{%d} + \\renewcommand{\\ganttntasks}{%d} + \\noindent + \\begin{tikzpicture}[y=-0.75cm,x=0.75\\textwidth] + \\begin{pgfonlayer}{background} + \\draw[very thin, red!10!white] (0,1+\\ganttntasks) grid [ystep=0.75cm,xstep=1/\\ganttprojecttime] (1,0); + \\draw[\\ganttdatelinecolour] (0,0) -- (1,0); + \\draw[\\ganttdatelinecolour] (0,1+\\ganttntasks) -- (1,1+\\ganttntasks); + \\end{pgfonlayer} + %s + %s + %s + \\end{tikzpicture}" projecttime ntasks tasks milestones dates)) +#+end_src + +* Available languages + :PROPERTIES: + :AUTHOR: Bastien + :END: + +** From Org's core + +| Language | Identifier | Language | Identifier | +|------------+------------+----------------+------------| +| Asymptote | asymptote | Awk | awk | +| Emacs Calc | calc | C | C | +| C++ | C++ | Clojure | clojure | +| CSS | css | ditaa | ditaa | +| Graphviz | dot | Emacs Lisp | emacs-lisp | +| gnuplot | gnuplot | Haskell | haskell | +| Javascript | js | LaTeX | latex | +| Ledger | ledger | Lisp | lisp | +| Lilypond | lilypond | MATLAB | matlab | +| Mscgen | mscgen | Objective Caml | ocaml | +| Octave | octave | Org-mode | org | +| | | Perl | perl | +| Plantuml | plantuml | Python | python | +| R | R | Ruby | ruby | +| Sass | sass | Scheme | scheme | +| GNU Screen | screen | shell | sh | +| SQL | sql | SQLite | sqlite | + +** From Org's contrib/babel/langs + +- ob-oz.el, by Torsten Anders and Eric Schulte +- ob-fomus.el, by Torsten Anders diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index b12ae7be59..9ab6b4aef1 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,7 +1,7 @@ % Reference Card for Org Mode -\def\orgversionnumber{8.2} -\def\versionyear{2014} % latest update -\input emacsver.tex +\def\orgversionnumber{9.0.9} +\def\versionyear{2017} % latest update +\def\year{2017} % latest copyright year %**start of header \newcount\columnsperpage @@ -80,9 +80,6 @@ \centerline{Released under the terms of the GNU General Public License} \centerline{version 3 or later.} -\centerline{For more Emacs documentation, and the \TeX{} source for this card, see} -\centerline{the Emacs distribution, or {\tt http://www.gnu.org/software/emacs}} - \endgroup} % make \bye not \outer so that the \def\bye in the \else clause below @@ -312,10 +309,11 @@ \section{Structure Editing} \key{turn item/line into headline}{C-c *} \key{promote/demote heading}{M-LEFT/RIGHT} \metax{promote/demote current subtree}{M-S-LEFT/RIGHT} -\metax{move subtree/list item up/down}{M-S-UP/DOWN} +\metax{move subtree/list item up/down}{M-UP/DOWN} +\metax{move the line at point up/down}{M-S-UP/DOWN} \metax{sort subtree/region/plain-list}{C-c \^{}} \metax{clone a subtree}{C-c C-x c} -\metax{copy visible text}{C-c C-x v} +\metax{copy visible parts of the region}{C-c C-x v} \metax{kill/copy subtree}{C-c C-x C-w/M-w} \metax{yank subtree}{C-c C-x C-y or C-y} \metax{narrow buffer to subtree / widen}{C-x n s/w} @@ -333,7 +331,6 @@ \section{Filtering and Sparse Trees} \key{construct a sparse tree by various criteria}{C-c /} \key{view TODO's in sparse tree}{C-c / t/T} \key{global TODO list in agenda mode}{C-c a t \noteone} -\key{time sorted view of current org file}{C-c a L} \section{Tables} @@ -375,7 +372,6 @@ \section{Tables} \metax{cut/copy/paste rectangular region}{C-c C-x C-w/M-w/C-y} %\key{copy rectangular region}{C-c C-x M-w} %\key{paste rectangular region}{C-c C-x C-y} -\key{fill paragraph across selected cells}{C-c C-q} {\bf Miscellaneous} @@ -574,7 +570,6 @@ \section{Agenda Views} \key{match tags, TODO kwds, properties}{C-c a m \noteone} \key{match only in TODO entries}{C-c a M \noteone} \key{find stuck projects}{C-c a \# \noteone} -\key{show timeline of current org file}{C-c a L \noteone} \key{configure custom commands}{C-c a C \noteone} %\key{configure stuck projects}{C-c a ! \noteone} \key{agenda for date at cursor}{C-c C-o} @@ -661,8 +656,11 @@ \section{Exporting and Publishing} \key{export/publish dispatcher}{C-c C-e} -\key{export visible part only}{C-c C-e v} -\key{insert template of export options}{C-c C-e t} +\key{toggle asynchronous export}{C-c C-e C-a} +\key{toggle body/visible only export}{C-c C-e C-b/v} +\key{toggle subtree export}{C-c C-e C-s} +\key{insert template of export options}{C-c C-e \#} + \key{toggle fixed width for entry or region}{C-c :} \key{toggle pretty display of scripts, entities}{C-c C-x {\tt\char`\\}} @@ -690,6 +688,5 @@ \section{Notes} \bye % Local variables: -% compile-command: "tex refcard" +% compile-command: "pdftex orgcard" % End: - diff --git a/etc/schema/od-manifest-schema-v1.2-os.rnc b/etc/schema/od-manifest-schema-v1.2-os.rnc new file mode 100644 index 0000000000..87f84d1ea8 --- /dev/null +++ b/etc/schema/od-manifest-schema-v1.2-os.rnc @@ -0,0 +1,88 @@ +# Open Document Format for Office Applications (OpenDocument) Version 1.2 +# OASIS Standard, 29 September 2011 +# Manifest Relax-NG Schema +# Source: http://docs.oasis-open.org/office/v1.2/os/ +# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. +# +# All capitalized terms in the following text have the meanings assigned to them +# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The +# full Policy may be found at the OASIS website. +# +# This document and translations of it may be copied and furnished to others, and +# derivative works that comment on or otherwise explain it or assist in its +# implementation may be prepared, copied, published, and distributed, in whole or +# in part, without restriction of any kind, provided that the above copyright +# notice and this section are included on all such copies and derivative works. +# However, this document itself may not be modified in any way, including by +# removing the copyright notice or references to OASIS, except as needed for the +# purpose of developing any document or deliverable produced by an OASIS +# Technical Committee (in which case the rules applicable to copyrights, as set +# forth in the OASIS IPR Policy, must be followed) or as required to translate it +# into languages other than English. +# +# The limited permissions granted above are perpetual and will not be revoked by +# OASIS or its successors or assigns. +# +# This document and the information contained herein is provided on an "AS IS" +# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT +# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT +# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR +# FITNESS FOR A PARTICULAR PURPOSE. + +namespace manifest = + "urn:oasis:names:tc:opendocument:xmlns:manifest:1.0" + +start = manifest +manifest = element manifest:manifest { manifest-attlist, file-entry+ } +manifest-attlist = attribute manifest:version { "1.2" } +file-entry = + element manifest:file-entry { file-entry-attlist, encryption-data? } +file-entry-attlist = + attribute manifest:full-path { \string } + & attribute manifest:size { nonNegativeInteger }? + & attribute manifest:media-type { \string } + & attribute manifest:preferred-view-mode { + "edit" | "presentation-slide-show" | "read-only" | namespacedToken + }? + & attribute manifest:version { \string }? +encryption-data = + element manifest:encryption-data { + encryption-data-attlist, + algorithm, + start-key-generation?, + key-derivation + } +encryption-data-attlist = + attribute manifest:checksum-type { "SHA1/1K" | anyURI } + & attribute manifest:checksum { base64Binary } +algorithm = + element manifest:algorithm { algorithm-attlist, anyElements } +algorithm-attlist = + attribute manifest:algorithm-name { "Blowfish CFB" | anyURI } + & attribute manifest:initialisation-vector { base64Binary } +anyAttListOrElements = + attribute * { text }*, + anyElements +anyElements = + element * { + mixed { anyAttListOrElements } + }* +key-derivation = + element manifest:key-derivation { key-derivation-attlist, empty } +key-derivation-attlist = + attribute manifest:key-derivation-name { "PBKDF2" | anyURI } + & attribute manifest:salt { base64Binary } + & attribute manifest:iteration-count { nonNegativeInteger } + & attribute manifest:key-size { nonNegativeInteger }? +start-key-generation = + element manifest:start-key-generation { + start-key-generation-attlist, empty + } +start-key-generation-attlist = + attribute manifest:start-key-generation-name { "SHA1" | anyURI } + & attribute manifest:key-size { nonNegativeInteger }? +base64Binary = xsd:base64Binary +namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" } +nonNegativeInteger = xsd:nonNegativeInteger +\string = xsd:string +anyURI = xsd:anyURI diff --git a/etc/schema/od-schema-v1.2-os.rnc b/etc/schema/od-schema-v1.2-os.rnc new file mode 100644 index 0000000000..8d679d62e4 --- /dev/null +++ b/etc/schema/od-schema-v1.2-os.rnc @@ -0,0 +1,6280 @@ +# Open Document Format for Office Applications (OpenDocument) Version 1.2 +# OASIS Standard, 29 September 2011 +# Relax-NG Schema +# Source: http://docs.oasis-open.org/office/v1.2/os/ +# Copyright (c) OASIS Open 2002-2011, 2013. All Rights Reserved. +# +# All capitalized terms in the following text have the meanings assigned to them +# in the OASIS Intellectual Property Rights Policy (the "OASIS IPR Policy"). The +# full Policy may be found at the OASIS website. +# +# This document and translations of it may be copied and furnished to others, and +# derivative works that comment on or otherwise explain it or assist in its +# implementation may be prepared, copied, published, and distributed, in whole or +# in part, without restriction of any kind, provided that the above copyright +# notice and this section are included on all such copies and derivative works. +# However, this document itself may not be modified in any way, including by +# removing the copyright notice or references to OASIS, except as needed for the +# purpose of developing any document or deliverable produced by an OASIS +# Technical Committee (in which case the rules applicable to copyrights, as set +# forth in the OASIS IPR Policy, must be followed) or as required to translate it +# into languages other than English. +# +# The limited permissions granted above are perpetual and will not be revoked by +# OASIS or its successors or assigns. +# +# This document and the information contained herein is provided on an "AS IS" +# basis and OASIS DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT +# LIMITED TO ANY WARRANTY THAT THE USE OF THE INFORMATION HEREIN WILL NOT +# INFRINGE ANY OWNERSHIP RIGHTS OR ANY IMPLIED WARRANTIES OF MERCHANTABILITY OR +# FITNESS FOR A PARTICULAR PURPOSE. + +namespace anim = "urn:oasis:names:tc:opendocument:xmlns:animation:1.0" +namespace chart = "urn:oasis:names:tc:opendocument:xmlns:chart:1.0" +namespace config = "urn:oasis:names:tc:opendocument:xmlns:config:1.0" +namespace db = "urn:oasis:names:tc:opendocument:xmlns:database:1.0" +namespace dc = "http://purl.org/dc/elements/1.1/" +namespace dr3d = "urn:oasis:names:tc:opendocument:xmlns:dr3d:1.0" +namespace draw = "urn:oasis:names:tc:opendocument:xmlns:drawing:1.0" +namespace fo = + "urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0" +namespace form = "urn:oasis:names:tc:opendocument:xmlns:form:1.0" +namespace grddl = "http://www.w3.org/2003/g/data-view#" +namespace math = "http://www.w3.org/1998/Math/MathML" +namespace meta = "urn:oasis:names:tc:opendocument:xmlns:meta:1.0" +namespace number = "urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0" +namespace office = "urn:oasis:names:tc:opendocument:xmlns:office:1.0" +namespace presentation = + "urn:oasis:names:tc:opendocument:xmlns:presentation:1.0" +namespace script = "urn:oasis:names:tc:opendocument:xmlns:script:1.0" +namespace smil = + "urn:oasis:names:tc:opendocument:xmlns:smil-compatible:1.0" +namespace style = "urn:oasis:names:tc:opendocument:xmlns:style:1.0" +namespace svg = + "urn:oasis:names:tc:opendocument:xmlns:svg-compatible:1.0" +namespace table = "urn:oasis:names:tc:opendocument:xmlns:table:1.0" +namespace text = "urn:oasis:names:tc:opendocument:xmlns:text:1.0" +namespace xforms = "http://www.w3.org/2002/xforms" +namespace xhtml = "http://www.w3.org/1999/xhtml" +namespace xlink = "http://www.w3.org/1999/xlink" + +office-process-content = attribute office:process-content { boolean }? +start = + office-document + | office-document-content + | office-document-styles + | office-document-meta + | office-document-settings +office-document = + element office:document { + office-document-attrs, + office-document-common-attrs, + office-meta, + office-settings, + office-scripts, + office-font-face-decls, + office-styles, + office-automatic-styles, + office-master-styles, + office-body + } +office-document-content = + element office:document-content { + office-document-common-attrs, + office-scripts, + office-font-face-decls, + office-automatic-styles, + office-body + } +office-document-styles = + element office:document-styles { + office-document-common-attrs, + office-font-face-decls, + office-styles, + office-automatic-styles, + office-master-styles + } +office-document-meta = + element office:document-meta { + office-document-common-attrs, office-meta + } +office-document-settings = + element office:document-settings { + office-document-common-attrs, office-settings + } +office-document-common-attrs = + attribute office:version { "1.2" } + & attribute grddl:transformation { + list { anyIRI* } + }? +office-document-attrs = attribute office:mimetype { \string } +office-meta = element office:meta { office-meta-content-strict }? +office-meta-content-strict = office-meta-data* +office-body = element office:body { office-body-content } +office-body-content = + element office:text { + office-text-attlist, + office-text-content-prelude, + office-text-content-main, + office-text-content-epilogue + } + | element office:drawing { + office-drawing-attlist, + office-drawing-content-prelude, + office-drawing-content-main, + office-drawing-content-epilogue + } + | element office:presentation { + office-presentation-attlist, + office-presentation-content-prelude, + office-presentation-content-main, + office-presentation-content-epilogue + } + | element office:spreadsheet { + office-spreadsheet-attlist, + office-spreadsheet-content-prelude, + office-spreadsheet-content-main, + office-spreadsheet-content-epilogue + } + | element office:chart { + office-chart-attlist, + office-chart-content-prelude, + office-chart-content-main, + office-chart-content-epilogue + } + | element office:image { + office-image-attlist, + office-image-content-prelude, + office-image-content-main, + office-image-content-epilogue + } + | office-database +office-text-content-prelude = + office-forms, text-tracked-changes, text-decls, table-decls +office-text-content-main = + text-content* + | (text-page-sequence, (shape)*) +text-content = + text-h + | text-p + | text-list + | text-numbered-paragraph + | table-table + | text-section + | text-soft-page-break + | text-table-of-content + | text-illustration-index + | text-table-index + | text-object-index + | text-user-index + | text-alphabetical-index + | text-bibliography + | shape + | change-marks +office-text-content-epilogue = table-functions +office-text-attlist = + attribute text:global { boolean }? + & attribute text:use-soft-page-breaks { boolean }? +office-drawing-attlist = empty +office-drawing-content-prelude = text-decls, table-decls +office-drawing-content-main = draw-page* +office-drawing-content-epilogue = table-functions +office-presentation-attlist = empty +office-presentation-content-prelude = + text-decls, table-decls, presentation-decls +office-presentation-content-main = draw-page* +office-presentation-content-epilogue = + presentation-settings, table-functions +office-spreadsheet-content-prelude = + table-tracked-changes?, text-decls, table-decls +table-decls = + table-calculation-settings?, + table-content-validations?, + table-label-ranges? +office-spreadsheet-content-main = table-table* +office-spreadsheet-content-epilogue = table-functions +table-functions = + table-named-expressions?, + table-database-ranges?, + table-data-pilot-tables?, + table-consolidation?, + table-dde-links? +office-chart-attlist = empty +office-chart-content-prelude = text-decls, table-decls +office-chart-content-main = chart-chart +office-chart-content-epilogue = table-functions +office-image-attlist = empty +office-image-content-prelude = empty +office-image-content-main = draw-frame +office-image-content-epilogue = empty +office-settings = element office:settings { config-config-item-set+ }? +config-config-item-set = + element config:config-item-set { + config-config-item-set-attlist, config-items + } +config-items = + (config-config-item + | config-config-item-set + | config-config-item-map-named + | config-config-item-map-indexed)+ +config-config-item-set-attlist = attribute config:name { \string } +config-config-item = + element config:config-item { config-config-item-attlist, text } +config-config-item-attlist = + attribute config:name { \string } + & attribute config:type { + "boolean" + | "short" + | "int" + | "long" + | "double" + | "string" + | "datetime" + | "base64Binary" + } +config-config-item-map-indexed = + element config:config-item-map-indexed { + config-config-item-map-indexed-attlist, + config-config-item-map-entry+ + } +config-config-item-map-indexed-attlist = + attribute config:name { \string } +config-config-item-map-entry = + element config:config-item-map-entry { + config-config-item-map-entry-attlist, config-items + } +config-config-item-map-entry-attlist = + attribute config:name { \string }? +config-config-item-map-named = + element config:config-item-map-named { + config-config-item-map-named-attlist, config-config-item-map-entry+ + } +config-config-item-map-named-attlist = attribute config:name { \string } +office-scripts = + element office:scripts { office-script*, office-event-listeners? }? +office-script = + element office:script { + office-script-attlist, + mixed { anyElements } + } +office-script-attlist = attribute script:language { \string } +office-font-face-decls = + element office:font-face-decls { style-font-face* }? +office-styles = + element office:styles { + styles + & style-default-style* + & style-default-page-layout? + & text-outline-style? + & text-notes-configuration* + & text-bibliography-configuration? + & text-linenumbering-configuration? + & draw-gradient* + & svg-linearGradient* + & svg-radialGradient* + & draw-hatch* + & draw-fill-image* + & draw-marker* + & draw-stroke-dash* + & draw-opacity* + & style-presentation-page-layout* + & table-table-template* + }? +office-automatic-styles = + element office:automatic-styles { styles & style-page-layout* }? +office-master-styles = + element office:master-styles { + style-master-page* & style-handout-master? & draw-layer-set? + }? +styles = + style-style* + & text-list-style* + & number-number-style* + & number-currency-style* + & number-percentage-style* + & number-date-style* + & number-time-style* + & number-boolean-style* + & number-text-style* +office-meta-data = + element meta:generator { \string } + | element dc:title { \string } + | element dc:description { \string } + | element dc:subject { \string } + | element meta:keyword { \string } + | element meta:initial-creator { \string } + | dc-creator + | element meta:printed-by { \string } + | element meta:creation-date { dateTime } + | dc-date + | element meta:print-date { dateTime } + | element meta:template { + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:actuate { "onRequest" }?, + attribute xlink:title { \string }?, + attribute meta:date { dateTime }? + } + | element meta:auto-reload { + (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "replace" }?, + attribute xlink:actuate { "onLoad" }?)?, + attribute meta:delay { duration }? + } + | element meta:hyperlink-behaviour { + attribute office:target-frame-name { targetFrameName }?, + attribute xlink:show { "new" | "replace" }? + } + | element dc:language { language } + | element meta:editing-cycles { nonNegativeInteger } + | element meta:editing-duration { duration } + | element meta:document-statistic { + attribute meta:page-count { nonNegativeInteger }?, + attribute meta:table-count { nonNegativeInteger }?, + attribute meta:draw-count { nonNegativeInteger }?, + attribute meta:image-count { nonNegativeInteger }?, + attribute meta:ole-object-count { nonNegativeInteger }?, + attribute meta:object-count { nonNegativeInteger }?, + attribute meta:paragraph-count { nonNegativeInteger }?, + attribute meta:word-count { nonNegativeInteger }?, + attribute meta:character-count { nonNegativeInteger }?, + attribute meta:frame-count { nonNegativeInteger }?, + attribute meta:sentence-count { nonNegativeInteger }?, + attribute meta:syllable-count { nonNegativeInteger }?, + attribute meta:non-whitespace-character-count { + nonNegativeInteger + }?, + attribute meta:row-count { nonNegativeInteger }?, + attribute meta:cell-count { nonNegativeInteger }? + } + | element meta:user-defined { + attribute meta:name { \string }, + ((attribute meta:value-type { "float" }, + double) + | (attribute meta:value-type { "date" }, + dateOrDateTime) + | (attribute meta:value-type { "time" }, + duration) + | (attribute meta:value-type { "boolean" }, + boolean) + | (attribute meta:value-type { "string" }, + \string) + | text) + } +dc-creator = element dc:creator { \string } +dc-date = element dc:date { dateTime } +text-h = + element text:h { + heading-attrs, + paragraph-attrs, + text-number?, + paragraph-content-or-hyperlink* + } +heading-attrs = + attribute text:outline-level { positiveInteger } + & attribute text:restart-numbering { boolean }? + & attribute text:start-value { nonNegativeInteger }? + & attribute text:is-list-header { boolean }? +text-number = element text:number { \string } +text-p = + element text:p { paragraph-attrs, paragraph-content-or-hyperlink* } +paragraph-attrs = + attribute text:style-name { styleNameRef }? + & attribute text:class-names { styleNameRefs }? + & attribute text:cond-style-name { styleNameRef }? + & (xml-id, + attribute text:id { NCName }?)? + & common-in-content-meta-attlist? +text-page-sequence = element text:page-sequence { text-page+ } +text-page = element text:page { text-page-attlist, empty } +text-page-attlist = attribute text:master-page-name { styleNameRef } +text-list = + element text:list { + text-list-attr, text-list-header?, text-list-item* + } +text-list-attr = + attribute text:style-name { styleNameRef }? + & attribute text:continue-numbering { boolean }? + & attribute text:continue-list { IDREF }? + & xml-id? +text-list-item = + element text:list-item { text-list-item-attr, text-list-item-content } +text-list-item-content = + text-number?, (text-p | text-h | text-list | text-soft-page-break)* +text-list-item-attr = + attribute text:start-value { nonNegativeInteger }? + & attribute text:style-override { styleNameRef }? + & xml-id? +text-list-header = + element text:list-header { + text-list-header-attr, text-list-item-content + } +text-list-header-attr = xml-id? +text-numbered-paragraph = + element text:numbered-paragraph { + text-numbered-paragraph-attr, text-number?, (text-p | text-h) + } +text-numbered-paragraph-attr = + attribute text:list-id { NCName } + & attribute text:level { positiveInteger }? + & (attribute text:style-name { styleNameRef }, + attribute text:continue-numbering { boolean }, + attribute text:start-value { nonNegativeInteger })? + & xml-id? +text-section = + element text:section { + text-section-attlist, + (text-section-source | text-section-source-dde | empty), + text-content* + } +text-section-attlist = + common-section-attlist + & (attribute text:display { "true" | "none" } + | (attribute text:display { "condition" }, + attribute text:condition { \string }) + | empty) +common-section-attlist = + attribute text:style-name { styleNameRef }? + & attribute text:name { \string } + & attribute text:protected { boolean }? + & attribute text:protection-key { \string }? + & attribute text:protection-key-digest-algorithm { anyIRI }? + & xml-id? +text-section-source = + element text:section-source { text-section-source-attr } +text-section-source-attr = + (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "embed" }?)? + & attribute text:section-name { \string }? + & attribute text:filter-name { \string }? +text-section-source-dde = office-dde-source +text-tracked-changes = + element text:tracked-changes { + text-tracked-changes-attr, text-changed-region* + }? +text-tracked-changes-attr = attribute text:track-changes { boolean }? +text-changed-region = + element text:changed-region { + text-changed-region-attr, text-changed-region-content + } +text-changed-region-attr = + xml-id, + attribute text:id { NCName }? +text-changed-region-content = + element text:insertion { office-change-info } + | element text:deletion { office-change-info, text-content* } + | element text:format-change { office-change-info } +change-marks = + element text:change { change-mark-attr } + | element text:change-start { change-mark-attr } + | element text:change-end { change-mark-attr } +change-mark-attr = attribute text:change-id { IDREF } +text-soft-page-break = element text:soft-page-break { empty } +text-decls = + element text:variable-decls { text-variable-decl* }?, + element text:sequence-decls { text-sequence-decl* }?, + element text:user-field-decls { text-user-field-decl* }?, + element text:dde-connection-decls { text-dde-connection-decl* }?, + text-alphabetical-index-auto-mark-file? +paragraph-content-or-hyperlink = paragraph-content | text-a +paragraph-content = + text + | element text:s { + attribute text:c { nonNegativeInteger }? + } + | element text:tab { text-tab-attr } + | element text:line-break { empty } + | text-soft-page-break + | element text:span { + attribute text:style-name { styleNameRef }?, + attribute text:class-names { styleNameRefs }?, + paragraph-content-or-hyperlink* + } + | element text:meta { + text-meta-attlist, paragraph-content-or-hyperlink* + } + | (text-bookmark | text-bookmark-start | text-bookmark-end) + | element text:reference-mark { + attribute text:name { \string } + } + | (element text:reference-mark-start { + attribute text:name { \string } + } + | element text:reference-mark-end { + attribute text:name { \string } + }) + | element text:note { + text-note-class, + attribute text:id { \string }?, + element text:note-citation { + attribute text:label { \string }?, + text + }, + element text:note-body { text-content* } + } + | element text:ruby { + attribute text:style-name { styleNameRef }?, + element text:ruby-base { paragraph-content-or-hyperlink* }, + element text:ruby-text { + attribute text:style-name { styleNameRef }?, + text + } + } + | (office-annotation | office-annotation-end) + | change-marks + | shape + | element text:date { text-date-attlist, text } + | element text:time { text-time-attlist, text } + | element text:page-number { text-page-number-attlist, text } + | element text:page-continuation { + text-page-continuation-attlist, text + } + | element text:sender-firstname { common-field-fixed-attlist, text } + | element text:sender-lastname { common-field-fixed-attlist, text } + | element text:sender-initials { common-field-fixed-attlist, text } + | element text:sender-title { common-field-fixed-attlist, text } + | element text:sender-position { common-field-fixed-attlist, text } + | element text:sender-email { common-field-fixed-attlist, text } + | element text:sender-phone-private { + common-field-fixed-attlist, text + } + | element text:sender-fax { common-field-fixed-attlist, text } + | element text:sender-company { common-field-fixed-attlist, text } + | element text:sender-phone-work { common-field-fixed-attlist, text } + | element text:sender-street { common-field-fixed-attlist, text } + | element text:sender-city { common-field-fixed-attlist, text } + | element text:sender-postal-code { common-field-fixed-attlist, text } + | element text:sender-country { common-field-fixed-attlist, text } + | element text:sender-state-or-province { + common-field-fixed-attlist, text + } + | element text:author-name { common-field-fixed-attlist, text } + | element text:author-initials { common-field-fixed-attlist, text } + | element text:chapter { text-chapter-attlist, text } + | element text:file-name { text-file-name-attlist, text } + | element text:template-name { text-template-name-attlist, text } + | element text:sheet-name { text } + | element text:variable-set { + (common-field-name-attlist + & common-field-formula-attlist + & common-value-and-type-attlist + & common-field-display-value-none-attlist + & common-field-data-style-name-attlist), + text + } + | element text:variable-get { + (common-field-name-attlist + & common-field-display-value-formula-attlist + & common-field-data-style-name-attlist), + text + } + | element text:variable-input { + (common-field-name-attlist + & common-field-description-attlist + & common-value-type-attlist + & common-field-display-value-none-attlist + & common-field-data-style-name-attlist), + text + } + | element text:user-field-get { + (common-field-name-attlist + & common-field-display-value-formula-none-attlist + & common-field-data-style-name-attlist), + text + } + | element text:user-field-input { + (common-field-name-attlist + & common-field-description-attlist + & common-field-data-style-name-attlist), + text + } + | element text:sequence { + (common-field-name-attlist + & common-field-formula-attlist + & common-field-num-format-attlist + & text-sequence-ref-name), + text + } + | element text:expression { + (common-field-formula-attlist + & common-value-and-type-attlist? + & common-field-display-value-formula-attlist + & common-field-data-style-name-attlist), + text + } + | element text:text-input { common-field-description-attlist, text } + | element text:initial-creator { common-field-fixed-attlist, text } + | element text:creation-date { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:date-value { dateOrDateTime }?), + text + } + | element text:creation-time { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:time-value { timeOrDateTime }?), + text + } + | element text:description { common-field-fixed-attlist, text } + | element text:user-defined { + (common-field-fixed-attlist + & attribute text:name { \string } + & common-field-data-style-name-attlist + & attribute office:value { double }? + & attribute office:date-value { dateOrDateTime }? + & attribute office:time-value { duration }? + & attribute office:boolean-value { boolean }? + & attribute office:string-value { \string }?), + text + } + | element text:print-time { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:time-value { time }?), + text + } + | element text:print-date { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:date-value { date }?), + text + } + | element text:printed-by { common-field-fixed-attlist, text } + | element text:title { common-field-fixed-attlist, text } + | element text:subject { common-field-fixed-attlist, text } + | element text:keywords { common-field-fixed-attlist, text } + | element text:editing-cycles { common-field-fixed-attlist, text } + | element text:editing-duration { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:duration { duration }?), + text + } + | element text:modification-time { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:time-value { time }?), + text + } + | element text:modification-date { + (common-field-fixed-attlist + & common-field-data-style-name-attlist + & attribute text:date-value { date }?), + text + } + | element text:creator { common-field-fixed-attlist, text } + | element text:page-count + | text:paragraph-count + | text:word-count + | text:character-count + | text:table-count + | text:image-count + | text:object-count { + common-field-num-format-attlist, text + } + | element text:database-display { + text-database-display-attlist, text + } + | element text:database-next { text-database-next-attlist } + | element text:database-row-select { + text-database-row-select-attlist + } + | element text:database-row-number { + (common-field-database-table + & common-field-num-format-attlist + & attribute text:value { nonNegativeInteger }?), + text + } + | element text:database-name { common-field-database-table, text } + | element text:page-variable-set { + text-set-page-variable-attlist, text + } + | element text:page-variable-get { + text-get-page-variable-attlist, text + } + | element text:placeholder { text-placeholder-attlist, text } + | element text:conditional-text { + text-conditional-text-attlist, text + } + | element text:hidden-text { text-hidden-text-attlist, text } + | element text:reference-ref | text:bookmark-ref { + text-common-ref-content & text-bookmark-ref-content + } + | element text:note-ref { + text-common-ref-content & text-note-ref-content + } + | element text:sequence-ref { + text-common-ref-content & text-sequence-ref-content + } + | element text:script { + ((attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }) + | text) + & attribute script:language { \string }? + } + | element text:execute-macro { + attribute text:name { \string }?, + office-event-listeners?, + text + } + | element text:hidden-paragraph { + text-hidden-paragraph-attlist, text + } + | element text:dde-connection { + attribute text:connection-name { \string }, + text + } + | element text:measure { + attribute text:kind { "value" | "unit" | "gap" }, + text + } + | element text:table-formula { + (common-field-formula-attlist + & common-field-display-value-formula-attlist + & common-field-data-style-name-attlist), + text + } + | element text:meta-field { + text-meta-field-attlist, paragraph-content-or-hyperlink* + } + | element text:toc-mark-start { text-toc-mark-start-attrs } + | element text:toc-mark-end { text-id } + | element text:toc-mark { + attribute text:string-value { \string }, + text-outline-level + } + | element text:user-index-mark-start { + text-id, text-outline-level, text-index-name + } + | element text:user-index-mark-end { text-id } + | element text:user-index-mark { + attribute text:string-value { \string }, + text-outline-level, + text-index-name + } + | element text:alphabetical-index-mark-start { + text-id, text-alphabetical-index-mark-attrs + } + | element text:alphabetical-index-mark-end { text-id } + | element text:alphabetical-index-mark { + attribute text:string-value { \string }, + text-alphabetical-index-mark-attrs + } + | element text:bibliography-mark { + attribute text:bibliography-type { text-bibliography-types }, + attribute text:identifier + | text:address + | text:annote + | text:author + | text:booktitle + | text:chapter + | text:edition + | text:editor + | text:howpublished + | text:institution + | text:journal + | text:month + | text:note + | text:number + | text:organizations + | text:pages + | text:publisher + | text:school + | text:series + | text:title + | text:report-type + | text:volume + | text:year + | text:url + | text:custom1 + | text:custom2 + | text:custom3 + | text:custom4 + | text:custom5 + | text:isbn + | text:issn { \string }*, + text + } + | element presentation:header { empty } + | element presentation:footer { empty } + | element presentation:date-time { empty } +text-tab-attr = attribute text:tab-ref { nonNegativeInteger }? +text-a = + element text:a { + text-a-attlist, office-event-listeners?, paragraph-content* + } +text-a-attlist = + attribute office:name { \string }? + & attribute office:title { \string }? + & attribute xlink:type { "simple" } + & attribute xlink:href { anyIRI } + & attribute xlink:actuate { "onRequest" }? + & attribute office:target-frame-name { targetFrameName }? + & attribute xlink:show { "new" | "replace" }? + & attribute text:style-name { styleNameRef }? + & attribute text:visited-style-name { styleNameRef }? +text-meta-attlist = common-in-content-meta-attlist? & xml-id? +text-bookmark = element text:bookmark { text-bookmark-attlist, empty } +text-bookmark-start = + element text:bookmark-start { text-bookmark-start-attlist, empty } +text-bookmark-end = + element text:bookmark-end { text-bookmark-end-attlist, empty } +text-bookmark-attlist = + attribute text:name { \string } + & xml-id? +text-bookmark-start-attlist = + attribute text:name { \string } + & xml-id? + & common-in-content-meta-attlist? +text-bookmark-end-attlist = attribute text:name { \string } +text-note-class = attribute text:note-class { "footnote" | "endnote" } +text-date-attlist = + (common-field-fixed-attlist & common-field-data-style-name-attlist) + & attribute text:date-value { dateOrDateTime }? + & attribute text:date-adjust { duration }? +text-time-attlist = + (common-field-fixed-attlist & common-field-data-style-name-attlist) + & attribute text:time-value { timeOrDateTime }? + & attribute text:time-adjust { duration }? +text-page-number-attlist = + (common-field-num-format-attlist & common-field-fixed-attlist) + & attribute text:page-adjust { integer }? + & attribute text:select-page { "previous" | "current" | "next" }? +text-page-continuation-attlist = + attribute text:select-page { "previous" | "next" } + & attribute text:string-value { \string }? +text-chapter-attlist = + attribute text:display { + "name" + | "number" + | "number-and-name" + | "plain-number-and-name" + | "plain-number" + } + & attribute text:outline-level { nonNegativeInteger } +text-file-name-attlist = + attribute text:display { + "full" | "path" | "name" | "name-and-extension" + }? + & common-field-fixed-attlist +text-template-name-attlist = + attribute text:display { + "full" | "path" | "name" | "name-and-extension" | "area" | "title" + }? +text-variable-decl = + element text:variable-decl { + common-field-name-attlist, common-value-type-attlist + } +text-user-field-decl = + element text:user-field-decl { + common-field-name-attlist, + common-field-formula-attlist?, + common-value-and-type-attlist + } +text-sequence-decl = + element text:sequence-decl { text-sequence-decl-attlist } +text-sequence-decl-attlist = + common-field-name-attlist + & attribute text:display-outline-level { nonNegativeInteger } + & attribute text:separation-character { character }? +text-sequence-ref-name = attribute text:ref-name { \string }? +common-field-database-table = + common-field-database-table-attlist, common-field-database-name +common-field-database-name = + attribute text:database-name { \string }? + | form-connection-resource +common-field-database-table-attlist = + attribute text:table-name { \string } + & attribute text:table-type { "table" | "query" | "command" }? +text-database-display-attlist = + common-field-database-table + & common-field-data-style-name-attlist + & attribute text:column-name { \string } +text-database-next-attlist = + common-field-database-table + & attribute text:condition { \string }? +text-database-row-select-attlist = + common-field-database-table + & attribute text:condition { \string }? + & attribute text:row-number { nonNegativeInteger }? +text-set-page-variable-attlist = + attribute text:active { boolean }? + & attribute text:page-adjust { integer }? +text-get-page-variable-attlist = common-field-num-format-attlist +text-placeholder-attlist = + attribute text:placeholder-type { + "text" | "table" | "text-box" | "image" | "object" + } + & common-field-description-attlist +text-conditional-text-attlist = + attribute text:condition { \string } + & attribute text:string-value-if-true { \string } + & attribute text:string-value-if-false { \string } + & attribute text:current-value { boolean }? +text-hidden-text-attlist = + attribute text:condition { \string } + & attribute text:string-value { \string } + & attribute text:is-hidden { boolean }? +text-common-ref-content = + text + & attribute text:ref-name { \string }? +text-bookmark-ref-content = + attribute text:reference-format { + common-ref-format-values + | "number-no-superior" + | "number-all-superior" + | "number" + }? +text-note-ref-content = + attribute text:reference-format { common-ref-format-values }? + & text-note-class +text-sequence-ref-content = + attribute text:reference-format { + common-ref-format-values + | "category-and-value" + | "caption" + | "value" + }? +common-ref-format-values = "page" | "chapter" | "direction" | "text" +text-hidden-paragraph-attlist = + attribute text:condition { \string } + & attribute text:is-hidden { boolean }? +text-meta-field-attlist = xml-id & common-field-data-style-name-attlist +common-value-type-attlist = attribute office:value-type { valueType } +common-value-and-type-attlist = + (attribute office:value-type { "float" }, + attribute office:value { double }) + | (attribute office:value-type { "percentage" }, + attribute office:value { double }) + | (attribute office:value-type { "currency" }, + attribute office:value { double }, + attribute office:currency { \string }?) + | (attribute office:value-type { "date" }, + attribute office:date-value { dateOrDateTime }) + | (attribute office:value-type { "time" }, + attribute office:time-value { duration }) + | (attribute office:value-type { "boolean" }, + attribute office:boolean-value { boolean }) + | (attribute office:value-type { "string" }, + attribute office:string-value { \string }?) +common-field-fixed-attlist = attribute text:fixed { boolean }? +common-field-name-attlist = attribute text:name { variableName } +common-field-description-attlist = + attribute text:description { \string }? +common-field-display-value-none-attlist = + attribute text:display { "value" | "none" }? +common-field-display-value-formula-none-attlist = + attribute text:display { "value" | "formula" | "none" }? +common-field-display-value-formula-attlist = + attribute text:display { "value" | "formula" }? +common-field-formula-attlist = attribute text:formula { \string }? +common-field-data-style-name-attlist = + attribute style:data-style-name { styleNameRef }? +common-field-num-format-attlist = common-num-format-attlist? +text-toc-mark-start-attrs = text-id, text-outline-level +text-outline-level = attribute text:outline-level { positiveInteger }? +text-id = attribute text:id { \string } +text-index-name = attribute text:index-name { \string } +text-alphabetical-index-mark-attrs = + attribute text:key1 { \string }? + & attribute text:key2 { \string }? + & attribute text:string-value-phonetic { \string }? + & attribute text:key1-phonetic { \string }? + & attribute text:key2-phonetic { \string }? + & attribute text:main-entry { boolean }? +text-bibliography-types = + "article" + | "book" + | "booklet" + | "conference" + | "custom1" + | "custom2" + | "custom3" + | "custom4" + | "custom5" + | "email" + | "inbook" + | "incollection" + | "inproceedings" + | "journal" + | "manual" + | "mastersthesis" + | "misc" + | "phdthesis" + | "proceedings" + | "techreport" + | "unpublished" + | "www" +text-index-body = element text:index-body { index-content-main* } +index-content-main = text-content | text-index-title +text-index-title = + element text:index-title { + common-section-attlist, index-content-main* + } +text-table-of-content = + element text:table-of-content { + common-section-attlist, + text-table-of-content-source, + text-index-body + } +text-table-of-content-source = + element text:table-of-content-source { + text-table-of-content-source-attlist, + text-index-title-template?, + text-table-of-content-entry-template*, + text-index-source-styles* + } +text-table-of-content-source-attlist = + attribute text:outline-level { positiveInteger }? + & attribute text:use-outline-level { boolean }? + & attribute text:use-index-marks { boolean }? + & attribute text:use-index-source-styles { boolean }? + & attribute text:index-scope { "document" | "chapter" }? + & attribute text:relative-tab-stop-position { boolean }? +text-table-of-content-entry-template = + element text:table-of-content-entry-template { + text-table-of-content-entry-template-attlist, + text-table-of-content-children* + } +text-table-of-content-children = + text-index-entry-chapter + | text-index-entry-page-number + | text-index-entry-text + | text-index-entry-span + | text-index-entry-tab-stop + | text-index-entry-link-start + | text-index-entry-link-end +text-table-of-content-entry-template-attlist = + attribute text:outline-level { positiveInteger } + & attribute text:style-name { styleNameRef } +text-illustration-index = + element text:illustration-index { + common-section-attlist, + text-illustration-index-source, + text-index-body + } +text-illustration-index-source = + element text:illustration-index-source { + text-illustration-index-source-attrs, + text-index-title-template?, + text-illustration-index-entry-template? + } +text-illustration-index-source-attrs = + text-index-scope-attr + & text-relative-tab-stop-position-attr + & attribute text:use-caption { boolean }? + & attribute text:caption-sequence-name { \string }? + & attribute text:caption-sequence-format { + "text" | "category-and-value" | "caption" + }? +text-index-scope-attr = + attribute text:index-scope { "document" | "chapter" }? +text-relative-tab-stop-position-attr = + attribute text:relative-tab-stop-position { boolean }? +text-illustration-index-entry-template = + element text:illustration-index-entry-template { + text-illustration-index-entry-content + } +text-illustration-index-entry-content = + text-illustration-index-entry-template-attrs, + (text-index-entry-chapter + | text-index-entry-page-number + | text-index-entry-text + | text-index-entry-span + | text-index-entry-tab-stop)* +text-illustration-index-entry-template-attrs = + attribute text:style-name { styleNameRef } +text-table-index = + element text:table-index { + common-section-attlist, text-table-index-source, text-index-body + } +text-table-index-source = + element text:table-index-source { + text-illustration-index-source-attrs, + text-index-title-template?, + text-table-index-entry-template? + } +text-table-index-entry-template = + element text:table-index-entry-template { + text-illustration-index-entry-content + } +text-object-index = + element text:object-index { + common-section-attlist, text-object-index-source, text-index-body + } +text-object-index-source = + element text:object-index-source { + text-object-index-source-attrs, + text-index-title-template?, + text-object-index-entry-template? + } +text-object-index-source-attrs = + text-index-scope-attr + & text-relative-tab-stop-position-attr + & attribute text:use-spreadsheet-objects { boolean }? + & attribute text:use-math-objects { boolean }? + & attribute text:use-draw-objects { boolean }? + & attribute text:use-chart-objects { boolean }? + & attribute text:use-other-objects { boolean }? +text-object-index-entry-template = + element text:object-index-entry-template { + text-illustration-index-entry-content + } +text-user-index = + element text:user-index { + common-section-attlist, text-user-index-source, text-index-body + } +text-user-index-source = + element text:user-index-source { + text-user-index-source-attr, + text-index-title-template?, + text-user-index-entry-template*, + text-index-source-styles* + } +text-user-index-source-attr = + text-index-scope-attr + & text-relative-tab-stop-position-attr + & attribute text:use-index-marks { boolean }? + & attribute text:use-index-source-styles { boolean }? + & attribute text:use-graphics { boolean }? + & attribute text:use-tables { boolean }? + & attribute text:use-floating-frames { boolean }? + & attribute text:use-objects { boolean }? + & attribute text:copy-outline-levels { boolean }? + & attribute text:index-name { \string } +text-user-index-entry-template = + element text:user-index-entry-template { + text-user-index-entry-template-attrs, + (text-index-entry-chapter + | text-index-entry-page-number + | text-index-entry-text + | text-index-entry-span + | text-index-entry-tab-stop)* + } +text-user-index-entry-template-attrs = + attribute text:outline-level { positiveInteger } + & attribute text:style-name { styleNameRef } +text-alphabetical-index = + element text:alphabetical-index { + common-section-attlist, + text-alphabetical-index-source, + text-index-body + } +text-alphabetical-index-source = + element text:alphabetical-index-source { + text-alphabetical-index-source-attrs, + text-index-title-template?, + text-alphabetical-index-entry-template* + } +text-alphabetical-index-source-attrs = + text-index-scope-attr + & text-relative-tab-stop-position-attr + & attribute text:ignore-case { boolean }? + & attribute text:main-entry-style-name { styleNameRef }? + & attribute text:alphabetical-separators { boolean }? + & attribute text:combine-entries { boolean }? + & attribute text:combine-entries-with-dash { boolean }? + & attribute text:combine-entries-with-pp { boolean }? + & attribute text:use-keys-as-entries { boolean }? + & attribute text:capitalize-entries { boolean }? + & attribute text:comma-separated { boolean }? + & attribute fo:language { languageCode }? + & attribute fo:country { countryCode }? + & attribute fo:script { scriptCode }? + & attribute style:rfc-language-tag { language }? + & attribute text:sort-algorithm { \string }? +text-alphabetical-index-auto-mark-file = + element text:alphabetical-index-auto-mark-file { + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI } + } +text-alphabetical-index-entry-template = + element text:alphabetical-index-entry-template { + text-alphabetical-index-entry-template-attrs, + (text-index-entry-chapter + | text-index-entry-page-number + | text-index-entry-text + | text-index-entry-span + | text-index-entry-tab-stop)* + } +text-alphabetical-index-entry-template-attrs = + attribute text:outline-level { "1" | "2" | "3" | "separator" } + & attribute text:style-name { styleNameRef } +text-bibliography = + element text:bibliography { + common-section-attlist, text-bibliography-source, text-index-body + } +text-bibliography-source = + element text:bibliography-source { + text-index-title-template?, text-bibliography-entry-template* + } +text-bibliography-entry-template = + element text:bibliography-entry-template { + text-bibliography-entry-template-attrs, + (text-index-entry-span + | text-index-entry-tab-stop + | text-index-entry-bibliography)* + } +text-bibliography-entry-template-attrs = + attribute text:bibliography-type { text-bibliography-types } + & attribute text:style-name { styleNameRef } +text-index-source-styles = + element text:index-source-styles { + attribute text:outline-level { positiveInteger }, + text-index-source-style* + } +text-index-source-style = + element text:index-source-style { + attribute text:style-name { styleName }, + empty + } +text-index-title-template = + element text:index-title-template { + attribute text:style-name { styleNameRef }?, + text + } +text-index-entry-chapter = + element text:index-entry-chapter { + attribute text:style-name { styleNameRef }?, + text-index-entry-chapter-attrs + } +text-index-entry-chapter-attrs = + attribute text:display { + "name" + | "number" + | "number-and-name" + | "plain-number" + | "plain-number-and-name" + }? + & attribute text:outline-level { positiveInteger }? +text-index-entry-text = + element text:index-entry-text { + attribute text:style-name { styleNameRef }? + } +text-index-entry-page-number = + element text:index-entry-page-number { + attribute text:style-name { styleNameRef }? + } +text-index-entry-span = + element text:index-entry-span { + attribute text:style-name { styleNameRef }?, + text + } +text-index-entry-bibliography = + element text:index-entry-bibliography { + text-index-entry-bibliography-attrs + } +text-index-entry-bibliography-attrs = + attribute text:style-name { styleNameRef }? + & attribute text:bibliography-data-field { + "address" + | "annote" + | "author" + | "bibliography-type" + | "booktitle" + | "chapter" + | "custom1" + | "custom2" + | "custom3" + | "custom4" + | "custom5" + | "edition" + | "editor" + | "howpublished" + | "identifier" + | "institution" + | "isbn" + | "issn" + | "journal" + | "month" + | "note" + | "number" + | "organizations" + | "pages" + | "publisher" + | "report-type" + | "school" + | "series" + | "title" + | "url" + | "volume" + | "year" + } +text-index-entry-tab-stop = + element text:index-entry-tab-stop { + attribute text:style-name { styleNameRef }?, + text-index-entry-tab-stop-attrs + } +text-index-entry-tab-stop-attrs = + attribute style:leader-char { character }? + & (attribute style:type { "right" } + | (attribute style:type { "left" }, + attribute style:position { length })) +text-index-entry-link-start = + element text:index-entry-link-start { + attribute text:style-name { styleNameRef }? + } +text-index-entry-link-end = + element text:index-entry-link-end { + attribute text:style-name { styleNameRef }? + } +table-table = + element table:table { + table-table-attlist, + table-title?, + table-desc?, + table-table-source?, + office-dde-source?, + table-scenario?, + office-forms?, + table-shapes?, + table-columns-and-groups, + table-rows-and-groups, + table-named-expressions? + } +table-columns-and-groups = + (table-table-column-group | table-columns-no-group)+ +table-columns-no-group = + (table-columns, (table-table-header-columns, table-columns?)?) + | (table-table-header-columns, table-columns?) +table-columns = table-table-columns | table-table-column+ +table-rows-and-groups = (table-table-row-group | table-rows-no-group)+ +table-rows-no-group = + (table-rows, (table-table-header-rows, table-rows?)?) + | (table-table-header-rows, table-rows?) +table-rows = + table-table-rows | (text-soft-page-break?, table-table-row)+ +table-table-attlist = + attribute table:name { \string }? + & attribute table:style-name { styleNameRef }? + & attribute table:template-name { \string }? + & attribute table:use-first-row-styles { boolean }? + & attribute table:use-last-row-styles { boolean }? + & attribute table:use-first-column-styles { boolean }? + & attribute table:use-last-column-styles { boolean }? + & attribute table:use-banding-rows-styles { boolean }? + & attribute table:use-banding-columns-styles { boolean }? + & attribute table:protected { boolean }? + & attribute table:protection-key { \string }? + & attribute table:protection-key-digest-algorithm { anyIRI }? + & attribute table:print { boolean }? + & attribute table:print-ranges { cellRangeAddressList }? + & xml-id? + & attribute table:is-sub-table { boolean }? +table-title = element table:title { text } +table-desc = element table:desc { text } +table-table-row = + element table:table-row { + table-table-row-attlist, + (table-table-cell | table-covered-table-cell)+ + } +table-table-row-attlist = + attribute table:number-rows-repeated { positiveInteger }? + & attribute table:style-name { styleNameRef }? + & attribute table:default-cell-style-name { styleNameRef }? + & attribute table:visibility { table-visibility-value }? + & xml-id? +table-visibility-value = "visible" | "collapse" | "filter" +table-table-cell = + element table:table-cell { + table-table-cell-attlist, + table-table-cell-attlist-extra, + table-table-cell-content + } +table-covered-table-cell = + element table:covered-table-cell { + table-table-cell-attlist, table-table-cell-content + } +table-table-cell-content = + table-cell-range-source?, + office-annotation?, + table-detective?, + text-content* +table-table-cell-attlist = + attribute table:number-columns-repeated { positiveInteger }? + & attribute table:style-name { styleNameRef }? + & attribute table:content-validation-name { \string }? + & attribute table:formula { \string }? + & common-value-and-type-attlist? + & attribute table:protect { boolean }? + & attribute table:protected { boolean }? + & xml-id? + & common-in-content-meta-attlist? +table-table-cell-attlist-extra = + attribute table:number-columns-spanned { positiveInteger }? + & attribute table:number-rows-spanned { positiveInteger }? + & attribute table:number-matrix-columns-spanned { positiveInteger }? + & attribute table:number-matrix-rows-spanned { positiveInteger }? +table-table-column = + element table:table-column { table-table-column-attlist, empty } +table-table-column-attlist = + attribute table:number-columns-repeated { positiveInteger }? + & attribute table:style-name { styleNameRef }? + & attribute table:visibility { table-visibility-value }? + & attribute table:default-cell-style-name { styleNameRef }? + & xml-id? +table-table-header-columns = + element table:table-header-columns { table-table-column+ } +table-table-columns = + element table:table-columns { table-table-column+ } +table-table-column-group = + element table:table-column-group { + table-table-column-group-attlist, table-columns-and-groups + } +table-table-column-group-attlist = attribute table:display { boolean }? +table-table-header-rows = + element table:table-header-rows { + (text-soft-page-break?, table-table-row)+ + } +table-table-rows = + element table:table-rows { (text-soft-page-break?, table-table-row)+ } +table-table-row-group = + element table:table-row-group { + table-table-row-group-attlist, table-rows-and-groups + } +table-table-row-group-attlist = attribute table:display { boolean }? +cellAddress = + xsd:string { + pattern = "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+" + } +cellRangeAddress = + xsd:string { + pattern = + "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+(:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+$?[0-9]+)?" + } + | xsd:string { + pattern = + "($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+:($?([^\. ']+|'([^']|'')+'))?\.$?[0-9]+" + } + | xsd:string { + pattern = + "($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+:($?([^\. ']+|'([^']|'')+'))?\.$?[A-Z]+" + } +cellRangeAddressList = + xsd:string + >> dc:description [ + 'Value is a space separated list of "cellRangeAddress" patterns' + ] +table-table-source = + element table:table-source { + table-table-source-attlist, table-linked-source-attlist, empty + } +table-table-source-attlist = + attribute table:mode { "copy-all" | "copy-results-only" }? + & attribute table:table-name { \string }? +table-linked-source-attlist = + attribute xlink:type { "simple" } + & attribute xlink:href { anyIRI } + & attribute xlink:actuate { "onRequest" }? + & attribute table:filter-name { \string }? + & attribute table:filter-options { \string }? + & attribute table:refresh-delay { duration }? +table-scenario = + element table:scenario { table-scenario-attlist, empty } +table-scenario-attlist = + attribute table:scenario-ranges { cellRangeAddressList } + & attribute table:is-active { boolean } + & attribute table:display-border { boolean }? + & attribute table:border-color { color }? + & attribute table:copy-back { boolean }? + & attribute table:copy-styles { boolean }? + & attribute table:copy-formulas { boolean }? + & attribute table:comment { \string }? + & attribute table:protected { boolean }? +table-shapes = element table:shapes { shape+ } +table-cell-range-source = + element table:cell-range-source { + table-table-cell-range-source-attlist, + table-linked-source-attlist, + empty + } +table-table-cell-range-source-attlist = + attribute table:name { \string } + & attribute table:last-column-spanned { positiveInteger } + & attribute table:last-row-spanned { positiveInteger } +table-detective = + element table:detective { table-highlighted-range*, table-operation* } +table-operation = + element table:operation { table-operation-attlist, empty } +table-operation-attlist = + attribute table:name { + "trace-dependents" + | "remove-dependents" + | "trace-precedents" + | "remove-precedents" + | "trace-errors" + } + & attribute table:index { nonNegativeInteger } +table-highlighted-range = + element table:highlighted-range { + (table-highlighted-range-attlist + | table-highlighted-range-attlist-invalid), + empty + } +table-highlighted-range-attlist = + attribute table:cell-range-address { cellRangeAddress }? + & attribute table:direction { + "from-another-table" | "to-another-table" | "from-same-table" + } + & attribute table:contains-error { boolean }? +table-highlighted-range-attlist-invalid = + attribute table:marked-invalid { boolean } +office-spreadsheet-attlist = + attribute table:structure-protected { boolean }?, + attribute table:protection-key { \string }?, + attribute table:protection-key-digest-algorithm { anyIRI }? +table-calculation-settings = + element table:calculation-settings { + table-calculation-setting-attlist, + table-null-date?, + table-iteration? + } +table-calculation-setting-attlist = + attribute table:case-sensitive { boolean }? + & attribute table:precision-as-shown { boolean }? + & attribute table:search-criteria-must-apply-to-whole-cell { + boolean + }? + & attribute table:automatic-find-labels { boolean }? + & attribute table:use-regular-expressions { boolean }? + & attribute table:use-wildcards { boolean }? + & attribute table:null-year { positiveInteger }? +table-null-date = + element table:null-date { + attribute table:value-type { "date" }?, + attribute table:date-value { date }?, + empty + } +table-iteration = + element table:iteration { + attribute table:status { "enable" | "disable" }?, + attribute table:steps { positiveInteger }?, + attribute table:maximum-difference { double }?, + empty + } +table-content-validations = + element table:content-validations { table-content-validation+ } +table-content-validation = + element table:content-validation { + table-validation-attlist, + table-help-message?, + (table-error-message | (table-error-macro, office-event-listeners))? + } +table-validation-attlist = + attribute table:name { \string } + & attribute table:condition { \string }? + & attribute table:base-cell-address { cellAddress }? + & attribute table:allow-empty-cell { boolean }? + & attribute table:display-list { + "none" | "unsorted" | "sort-ascending" + }? +table-help-message = + element table:help-message { + attribute table:title { \string }?, + attribute table:display { boolean }?, + text-p* + } +table-error-message = + element table:error-message { + attribute table:title { \string }?, + attribute table:display { boolean }?, + attribute table:message-type { + "stop" | "warning" | "information" + }?, + text-p* + } +table-error-macro = + element table:error-macro { + attribute table:execute { boolean }? + } +table-label-ranges = element table:label-ranges { table-label-range* } +table-label-range = + element table:label-range { table-label-range-attlist, empty } +table-label-range-attlist = + attribute table:label-cell-range-address { cellRangeAddress } + & attribute table:data-cell-range-address { cellRangeAddress } + & attribute table:orientation { "column" | "row" } +table-named-expressions = + element table:named-expressions { + (table-named-range | table-named-expression)* + } +table-named-range = + element table:named-range { table-named-range-attlist, empty } +table-named-range-attlist = + attribute table:name { \string }, + attribute table:cell-range-address { cellRangeAddress }, + attribute table:base-cell-address { cellAddress }?, + attribute table:range-usable-as { + "none" + | list { + ("print-range" | "filter" | "repeat-row" | "repeat-column")+ + } + }? +table-named-expression = + element table:named-expression { + table-named-expression-attlist, empty + } +table-named-expression-attlist = + attribute table:name { \string }, + attribute table:expression { \string }, + attribute table:base-cell-address { cellAddress }? +table-database-ranges = + element table:database-ranges { table-database-range* } +table-database-range = + element table:database-range { + table-database-range-attlist, + (table-database-source-sql + | table-database-source-table + | table-database-source-query)?, + table-filter?, + table-sort?, + table-subtotal-rules? + } +table-database-range-attlist = + attribute table:name { \string }? + & attribute table:is-selection { boolean }? + & attribute table:on-update-keep-styles { boolean }? + & attribute table:on-update-keep-size { boolean }? + & attribute table:has-persistent-data { boolean }? + & attribute table:orientation { "column" | "row" }? + & attribute table:contains-header { boolean }? + & attribute table:display-filter-buttons { boolean }? + & attribute table:target-range-address { cellRangeAddress } + & attribute table:refresh-delay { boolean }? +table-database-source-sql = + element table:database-source-sql { + table-database-source-sql-attlist, empty + } +table-database-source-sql-attlist = + attribute table:database-name { \string } + & attribute table:sql-statement { \string } + & attribute table:parse-sql-statement { boolean }? +table-database-source-query = + element table:database-source-table { + table-database-source-table-attlist, empty + } +table-database-source-table-attlist = + attribute table:database-name { \string } + & attribute table:database-table-name { \string } +table-database-source-table = + element table:database-source-query { + table-database-source-query-attlist, empty + } +table-database-source-query-attlist = + attribute table:database-name { \string } + & attribute table:query-name { \string } +table-sort = element table:sort { table-sort-attlist, table-sort-by+ } +table-sort-attlist = + attribute table:bind-styles-to-content { boolean }? + & attribute table:target-range-address { cellRangeAddress }? + & attribute table:case-sensitive { boolean }? + & attribute table:language { languageCode }? + & attribute table:country { countryCode }? + & attribute table:script { scriptCode }? + & attribute table:rfc-language-tag { language }? + & attribute table:algorithm { \string }? + & attribute table:embedded-number-behavior { + "alpha-numeric" | "integer" | "double" + }? +table-sort-by = element table:sort-by { table-sort-by-attlist, empty } +table-sort-by-attlist = + attribute table:field-number { nonNegativeInteger } + & attribute table:data-type { + "text" | "number" | "automatic" | \string + }? + & attribute table:order { "ascending" | "descending" }? +table-subtotal-rules = + element table:subtotal-rules { + table-subtotal-rules-attlist, + table-sort-groups?, + table-subtotal-rule* + } +table-subtotal-rules-attlist = + attribute table:bind-styles-to-content { boolean }? + & attribute table:case-sensitive { boolean }? + & attribute table:page-breaks-on-group-change { boolean }? +table-sort-groups = + element table:sort-groups { table-sort-groups-attlist, empty } +table-sort-groups-attlist = + attribute table:data-type { + "text" | "number" | "automatic" | \string + }? + & attribute table:order { "ascending" | "descending" }? +table-subtotal-rule = + element table:subtotal-rule { + table-subtotal-rule-attlist, table-subtotal-field* + } +table-subtotal-rule-attlist = + attribute table:group-by-field-number { nonNegativeInteger } +table-subtotal-field = + element table:subtotal-field { table-subtotal-field-attlist, empty } +table-subtotal-field-attlist = + attribute table:field-number { nonNegativeInteger } + & attribute table:function { + "average" + | "count" + | "countnums" + | "max" + | "min" + | "product" + | "stdev" + | "stdevp" + | "sum" + | "var" + | "varp" + | \string + } +table-filter = + element table:filter { + table-filter-attlist, + (table-filter-condition | table-filter-and | table-filter-or) + } +table-filter-attlist = + attribute table:target-range-address { cellRangeAddress }? + & attribute table:condition-source { "self" | "cell-range" }? + & attribute table:condition-source-range-address { cellRangeAddress }? + & attribute table:display-duplicates { boolean }? +table-filter-and = + element table:filter-and { + (table-filter-or | table-filter-condition)+ + } +table-filter-or = + element table:filter-or { + (table-filter-and | table-filter-condition)+ + } +table-filter-condition = + element table:filter-condition { + table-filter-condition-attlist, table-filter-set-item* + } +table-filter-condition-attlist = + attribute table:field-number { nonNegativeInteger } + & attribute table:value { \string | double } + & attribute table:operator { \string } + & attribute table:case-sensitive { \string }? + & attribute table:data-type { "text" | "number" }? +table-filter-set-item = + element table:filter-set-item { + attribute table:value { \string }, + empty + } +table-data-pilot-tables = + element table:data-pilot-tables { table-data-pilot-table* } +table-data-pilot-table = + element table:data-pilot-table { + table-data-pilot-table-attlist, + (table-database-source-sql + | table-database-source-table + | table-database-source-query + | table-source-service + | table-source-cell-range)?, + table-data-pilot-field+ + } +table-data-pilot-table-attlist = + attribute table:name { \string } + & attribute table:application-data { \string }? + & attribute table:grand-total { "none" | "row" | "column" | "both" }? + & attribute table:ignore-empty-rows { boolean }? + & attribute table:identify-categories { boolean }? + & attribute table:target-range-address { cellRangeAddress } + & attribute table:buttons { cellRangeAddressList }? + & attribute table:show-filter-button { boolean }? + & attribute table:drill-down-on-double-click { boolean }? +table-source-cell-range = + element table:source-cell-range { + table-source-cell-range-attlist, table-filter? + } +table-source-cell-range-attlist = + attribute table:cell-range-address { cellRangeAddress } +table-source-service = + element table:source-service { table-source-service-attlist, empty } +table-source-service-attlist = + attribute table:name { \string } + & attribute table:source-name { \string } + & attribute table:object-name { \string } + & attribute table:user-name { \string }? + & attribute table:password { \string }? +table-data-pilot-field = + element table:data-pilot-field { + table-data-pilot-field-attlist, + table-data-pilot-level?, + table-data-pilot-field-reference?, + table-data-pilot-groups? + } +table-data-pilot-field-attlist = + attribute table:source-field-name { \string } + & (attribute table:orientation { + "row" | "column" | "data" | "hidden" + } + | (attribute table:orientation { "page" }, + attribute table:selected-page { \string })) + & attribute table:is-data-layout-field { \string }? + & attribute table:function { + "auto" + | "average" + | "count" + | "countnums" + | "max" + | "min" + | "product" + | "stdev" + | "stdevp" + | "sum" + | "var" + | "varp" + | \string + }? + & attribute table:used-hierarchy { integer }? +table-data-pilot-level = + element table:data-pilot-level { + table-data-pilot-level-attlist, + table-data-pilot-subtotals?, + table-data-pilot-members?, + table-data-pilot-display-info?, + table-data-pilot-sort-info?, + table-data-pilot-layout-info? + } +table-data-pilot-level-attlist = attribute table:show-empty { boolean }? +table-data-pilot-subtotals = + element table:data-pilot-subtotals { table-data-pilot-subtotal* } +table-data-pilot-subtotal = + element table:data-pilot-subtotal { + table-data-pilot-subtotal-attlist, empty + } +table-data-pilot-subtotal-attlist = + attribute table:function { + "auto" + | "average" + | "count" + | "countnums" + | "max" + | "min" + | "product" + | "stdev" + | "stdevp" + | "sum" + | "var" + | "varp" + | \string + } +table-data-pilot-members = + element table:data-pilot-members { table-data-pilot-member* } +table-data-pilot-member = + element table:data-pilot-member { + table-data-pilot-member-attlist, empty + } +table-data-pilot-member-attlist = + attribute table:name { \string } + & attribute table:display { boolean }? + & attribute table:show-details { boolean }? +table-data-pilot-display-info = + element table:data-pilot-display-info { + table-data-pilot-display-info-attlist, empty + } +table-data-pilot-display-info-attlist = + attribute table:enabled { boolean } + & attribute table:data-field { \string } + & attribute table:member-count { nonNegativeInteger } + & attribute table:display-member-mode { "from-top" | "from-bottom" } +table-data-pilot-sort-info = + element table:data-pilot-sort-info { + table-data-pilot-sort-info-attlist, empty + } +table-data-pilot-sort-info-attlist = + ((attribute table:sort-mode { "data" }, + attribute table:data-field { \string }) + | attribute table:sort-mode { "none" | "manual" | "name" }) + & attribute table:order { "ascending" | "descending" } +table-data-pilot-layout-info = + element table:data-pilot-layout-info { + table-data-pilot-layout-info-attlist, empty + } +table-data-pilot-layout-info-attlist = + attribute table:layout-mode { + "tabular-layout" + | "outline-subtotals-top" + | "outline-subtotals-bottom" + } + & attribute table:add-empty-lines { boolean } +table-data-pilot-field-reference = + element table:data-pilot-field-reference { + table-data-pilot-field-reference-attlist + } +table-data-pilot-field-reference-attlist = + attribute table:field-name { \string } + & ((attribute table:member-type { "named" }, + attribute table:member-name { \string }) + | attribute table:member-type { "previous" | "next" }) + & attribute table:type { + "none" + | "member-difference" + | "member-percentage" + | "member-percentage-difference" + | "running-total" + | "row-percentage" + | "column-percentage" + | "total-percentage" + | "index" + } +table-data-pilot-groups = + element table:data-pilot-groups { + table-data-pilot-groups-attlist, table-data-pilot-group+ + } +table-data-pilot-groups-attlist = + attribute table:source-field-name { \string } + & (attribute table:date-start { dateOrDateTime | "auto" } + | attribute table:start { double | "auto" }) + & (attribute table:date-end { dateOrDateTime | "auto" } + | attribute table:end { double | "auto" }) + & attribute table:step { double } + & attribute table:grouped-by { + "seconds" + | "minutes" + | "hours" + | "days" + | "months" + | "quarters" + | "years" + } +table-data-pilot-group = + element table:data-pilot-group { + table-data-pilot-group-attlist, table-data-pilot-group-member+ + } +table-data-pilot-group-attlist = attribute table:name { \string } +table-data-pilot-group-member = + element table:data-pilot-group-member { + table-data-pilot-group-member-attlist + } +table-data-pilot-group-member-attlist = attribute table:name { \string } +table-consolidation = + element table:consolidation { table-consolidation-attlist, empty } +table-consolidation-attlist = + attribute table:function { + "average" + | "count" + | "countnums" + | "max" + | "min" + | "product" + | "stdev" + | "stdevp" + | "sum" + | "var" + | "varp" + | \string + } + & attribute table:source-cell-range-addresses { cellRangeAddressList } + & attribute table:target-cell-address { cellAddress } + & attribute table:use-labels { "none" | "row" | "column" | "both" }? + & attribute table:link-to-source-data { boolean }? +table-dde-links = element table:dde-links { table-dde-link+ } +table-tracked-changes = + element table:tracked-changes { + table-tracked-changes-attlist, + (table-cell-content-change + | table-insertion + | table-deletion + | table-movement)* + } +table-tracked-changes-attlist = + attribute table:track-changes { boolean }? +table-insertion = + element table:insertion { + table-insertion-attlist, + common-table-change-attlist, + office-change-info, + table-dependencies?, + table-deletions? + } +table-insertion-attlist = + attribute table:type { "row" | "column" | "table" } + & attribute table:position { integer } + & attribute table:count { positiveInteger }? + & attribute table:table { integer }? +table-dependencies = element table:dependencies { table-dependency+ } +table-dependency = + element table:dependency { + attribute table:id { \string }, + empty + } +table-deletions = + element table:deletions { + (table-cell-content-deletion | table-change-deletion)+ + } +table-cell-content-deletion = + element table:cell-content-deletion { + attribute table:id { \string }?, + table-cell-address?, + table-change-track-table-cell? + } +table-change-deletion = + element table:change-deletion { + attribute table:id { \string }?, + empty + } +table-deletion = + element table:deletion { + table-deletion-attlist, + common-table-change-attlist, + office-change-info, + table-dependencies?, + table-deletions?, + table-cut-offs? + } +table-deletion-attlist = + attribute table:type { "row" | "column" | "table" } + & attribute table:position { integer } + & attribute table:table { integer }? + & attribute table:multi-deletion-spanned { integer }? +table-cut-offs = + element table:cut-offs { + table-movement-cut-off+ + | (table-insertion-cut-off, table-movement-cut-off*) + } +table-insertion-cut-off = + element table:insertion-cut-off { + table-insertion-cut-off-attlist, empty + } +table-insertion-cut-off-attlist = + attribute table:id { \string } + & attribute table:position { integer } +table-movement-cut-off = + element table:movement-cut-off { + table-movement-cut-off-attlist, empty + } +table-movement-cut-off-attlist = + attribute table:position { integer } + | (attribute table:start-position { integer }, + attribute table:end-position { integer }) +table-movement = + element table:movement { + common-table-change-attlist, + table-source-range-address, + table-target-range-address, + office-change-info, + table-dependencies?, + table-deletions? + } +table-source-range-address = + element table:source-range-address { + common-table-range-attlist, empty + } +table-target-range-address = + element table:target-range-address { + common-table-range-attlist, empty + } +common-table-range-attlist = + common-table-cell-address-attlist + | common-table-cell-range-address-attlist +common-table-cell-address-attlist = + attribute table:column { integer }, + attribute table:row { integer }, + attribute table:table { integer } +common-table-cell-range-address-attlist = + attribute table:start-column { integer }, + attribute table:start-row { integer }, + attribute table:start-table { integer }, + attribute table:end-column { integer }, + attribute table:end-row { integer }, + attribute table:end-table { integer } +table-change-track-table-cell = + element table:change-track-table-cell { + table-change-track-table-cell-attlist, text-p* + } +table-change-track-table-cell-attlist = + attribute table:cell-address { cellAddress }? + & attribute table:matrix-covered { boolean }? + & attribute table:formula { \string }? + & attribute table:number-matrix-columns-spanned { positiveInteger }? + & attribute table:number-matrix-rows-spanned { positiveInteger }? + & common-value-and-type-attlist? +table-cell-content-change = + element table:cell-content-change { + common-table-change-attlist, + table-cell-address, + office-change-info, + table-dependencies?, + table-deletions?, + table-previous + } +table-cell-address = + element table:cell-address { + common-table-cell-address-attlist, empty + } +table-previous = + element table:previous { + attribute table:id { \string }?, + table-change-track-table-cell + } +common-table-change-attlist = + attribute table:id { \string } + & attribute table:acceptance-state { + "accepted" | "rejected" | "pending" + }? + & attribute table:rejecting-change-id { \string }? +style-handout-master = + element style:handout-master { + common-presentation-header-footer-attlist, + style-handout-master-attlist, + shape* + } +style-handout-master-attlist = + attribute presentation:presentation-page-layout-name { styleNameRef }? + & attribute style:page-layout-name { styleNameRef } + & attribute draw:style-name { styleNameRef }? +draw-layer-set = element draw:layer-set { draw-layer* } +draw-layer = + element draw:layer { draw-layer-attlist, svg-title?, svg-desc? } +draw-layer-attlist = + attribute draw:name { \string } + & attribute draw:protected { boolean }? + & attribute draw:display { "always" | "screen" | "printer" | "none" }? +draw-page = + element draw:page { + common-presentation-header-footer-attlist, + draw-page-attlist, + svg-title?, + svg-desc?, + draw-layer-set?, + office-forms?, + shape*, + (presentation-animations | animation-element)?, + presentation-notes? + } +draw-page-attlist = + attribute draw:name { \string }? + & attribute draw:style-name { styleNameRef }? + & attribute draw:master-page-name { styleNameRef } + & attribute presentation:presentation-page-layout-name { + styleNameRef + }? + & (xml-id, + attribute draw:id { NCName }?)? + & attribute draw:nav-order { IDREFS }? +common-presentation-header-footer-attlist = + attribute presentation:use-header-name { \string }? + & attribute presentation:use-footer-name { \string }? + & attribute presentation:use-date-time-name { \string }? +shape = shape-instance | draw-a +shape-instance = + draw-rect + | draw-line + | draw-polyline + | draw-polygon + | draw-regular-polygon + | draw-path + | draw-circle + | draw-ellipse + | draw-g + | draw-page-thumbnail + | draw-frame + | draw-measure + | draw-caption + | draw-connector + | draw-control + | dr3d-scene + | draw-custom-shape +draw-rect = + element draw:rect { + draw-rect-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-rect-attlist = + attribute draw:corner-radius { nonNegativeLength }? + | (attribute svg:rx { nonNegativeLength }?, + attribute svg:ry { nonNegativeLength }?) +draw-line = + element draw:line { + draw-line-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-line-attlist = + attribute svg:x1 { coordinate } + & attribute svg:y1 { coordinate } + & attribute svg:x2 { coordinate } + & attribute svg:y2 { coordinate } +draw-polyline = + element draw:polyline { + common-draw-points-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-viewbox-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +common-draw-points-attlist = attribute draw:points { points } +draw-polygon = + element draw:polygon { + common-draw-points-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-viewbox-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-regular-polygon = + element draw:regular-polygon { + draw-regular-polygon-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-regular-polygon-attlist = + (attribute draw:concave { "false" } + | (attribute draw:concave { "true" }, + draw-regular-polygon-sharpness-attlist)) + & attribute draw:corners { positiveInteger } +draw-regular-polygon-sharpness-attlist = + attribute draw:sharpness { percent } +draw-path = + element draw:path { + common-draw-path-data-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-viewbox-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +common-draw-path-data-attlist = attribute svg:d { pathData } +draw-circle = + element draw:circle { + ((draw-circle-attlist, common-draw-circle-ellipse-pos-attlist) + | (common-draw-position-attlist, common-draw-size-attlist)), + common-draw-circle-ellipse-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +common-draw-circle-ellipse-pos-attlist = + attribute svg:cx { coordinate }, + attribute svg:cy { coordinate } +draw-circle-attlist = attribute svg:r { length } +common-draw-circle-ellipse-attlist = + attribute draw:kind { "full" | "section" | "cut" | "arc" }? + & attribute draw:start-angle { angle }? + & attribute draw:end-angle { angle }? +draw-ellipse = + element draw:ellipse { + ((draw-ellipse-attlist, common-draw-circle-ellipse-pos-attlist) + | (common-draw-position-attlist, common-draw-size-attlist)), + common-draw-circle-ellipse-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-ellipse-attlist = + attribute svg:rx { length }, + attribute svg:ry { length } +draw-connector = + element draw:connector { + draw-connector-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + common-draw-viewbox-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-connector-attlist = + attribute draw:type { "standard" | "lines" | "line" | "curve" }? + & (attribute svg:x1 { coordinate }, + attribute svg:y1 { coordinate })? + & attribute draw:start-shape { IDREF }? + & attribute draw:start-glue-point { nonNegativeInteger }? + & (attribute svg:x2 { coordinate }, + attribute svg:y2 { coordinate })? + & attribute draw:end-shape { IDREF }? + & attribute draw:end-glue-point { nonNegativeInteger }? + & attribute draw:line-skew { + list { length, (length, length?)? } + }? + & attribute svg:d { pathData }? +draw-caption = + element draw:caption { + draw-caption-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-caption-attlist = + (attribute draw:caption-point-x { coordinate }, + attribute draw:caption-point-y { coordinate })? + & attribute draw:corner-radius { nonNegativeLength }? +draw-measure = + element draw:measure { + draw-measure-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text + } +draw-measure-attlist = + attribute svg:x1 { coordinate } + & attribute svg:y1 { coordinate } + & attribute svg:x2 { coordinate } + & attribute svg:y2 { coordinate } +draw-control = + element draw:control { + draw-control-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + draw-glue-point* + } +draw-control-attlist = attribute draw:control { IDREF } +draw-page-thumbnail = + element draw:page-thumbnail { + draw-page-thumbnail-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + presentation-shape-attlist, + common-draw-shape-with-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc? + } +draw-page-thumbnail-attlist = + attribute draw:page-number { positiveInteger }? +draw-g = + element draw:g { + draw-g-attlist, + common-draw-z-index-attlist, + common-draw-name-attlist, + common-draw-id-attlist, + common-draw-style-name-attlist, + common-text-spreadsheet-shape-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + shape* + } +draw-g-attlist = attribute svg:y { coordinate }? +common-draw-name-attlist = attribute draw:name { \string }? +common-draw-caption-id-attlist = attribute draw:caption-id { IDREF }? +common-draw-position-attlist = + attribute svg:x { coordinate }?, + attribute svg:y { coordinate }? +common-draw-size-attlist = + attribute svg:width { length }?, + attribute svg:height { length }? +common-draw-transform-attlist = attribute draw:transform { \string }? +common-draw-viewbox-attlist = + attribute svg:viewBox { + list { integer, integer, integer, integer } + } +common-draw-style-name-attlist = + (attribute draw:style-name { styleNameRef }?, + attribute draw:class-names { styleNameRefs }?) + | (attribute presentation:style-name { styleNameRef }?, + attribute presentation:class-names { styleNameRefs }?) +common-draw-text-style-name-attlist = + attribute draw:text-style-name { styleNameRef }? +common-draw-layer-name-attlist = attribute draw:layer { \string }? +common-draw-id-attlist = + (xml-id, + attribute draw:id { NCName }?)? +common-draw-z-index-attlist = + attribute draw:z-index { nonNegativeInteger }? +common-text-spreadsheet-shape-attlist = + attribute table:end-cell-address { cellAddress }? + & attribute table:end-x { coordinate }? + & attribute table:end-y { coordinate }? + & attribute table:table-background { boolean }? + & common-text-anchor-attlist +common-text-anchor-attlist = + attribute text:anchor-type { + "page" | "frame" | "paragraph" | "char" | "as-char" + }? + & attribute text:anchor-page-number { positiveInteger }? +draw-text = (text-p | text-list)* +common-draw-shape-with-styles-attlist = + common-draw-z-index-attlist, + common-draw-id-attlist, + common-draw-layer-name-attlist, + common-draw-style-name-attlist, + common-draw-transform-attlist, + common-draw-name-attlist, + common-text-spreadsheet-shape-attlist +common-draw-shape-with-text-and-styles-attlist = + common-draw-shape-with-styles-attlist, + common-draw-text-style-name-attlist +draw-glue-point = + element draw:glue-point { draw-glue-point-attlist, empty } +draw-glue-point-attlist = + attribute draw:id { nonNegativeInteger } + & attribute svg:x { distance | percent } + & attribute svg:y { distance | percent } + & attribute draw:align { + "top-left" + | "top" + | "top-right" + | "left" + | "center" + | "right" + | "bottom-left" + | "bottom-right" + }? + & attribute draw:escape-direction { + "auto" + | "left" + | "right" + | "up" + | "down" + | "horizontal" + | "vertical" + } +svg-title = element svg:title { text } +svg-desc = element svg:desc { text } +draw-frame = + element draw:frame { + common-draw-shape-with-text-and-styles-attlist, + common-draw-position-attlist, + common-draw-rel-size-attlist, + common-draw-caption-id-attlist, + presentation-shape-attlist, + draw-frame-attlist, + (draw-text-box + | draw-image + | draw-object + | draw-object-ole + | draw-applet + | draw-floating-frame + | draw-plugin + | table-table)*, + office-event-listeners?, + draw-glue-point*, + draw-image-map?, + svg-title?, + svg-desc?, + (draw-contour-polygon | draw-contour-path)? + } +common-draw-rel-size-attlist = + common-draw-size-attlist, + attribute style:rel-width { percent | "scale" | "scale-min" }?, + attribute style:rel-height { percent | "scale" | "scale-min" }? +draw-frame-attlist = attribute draw:copy-of { \string }? +draw-text-box = + element draw:text-box { draw-text-box-attlist, text-content* } +draw-text-box-attlist = + attribute draw:chain-next-name { \string }? + & attribute draw:corner-radius { nonNegativeLength }? + & attribute fo:min-height { length | percent }? + & attribute fo:min-width { length | percent }? + & attribute fo:max-height { length | percent }? + & attribute fo:max-width { length | percent }? + & (xml-id, + attribute text:id { NCName }?)? +draw-image = + element draw:image { + draw-image-attlist, + (common-draw-data-attlist | office-binary-data), + draw-text + } +common-draw-data-attlist = + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "embed" }?, + attribute xlink:actuate { "onLoad" }? +office-binary-data = element office:binary-data { base64Binary } +draw-image-attlist = + attribute draw:filter-name { \string }? + & xml-id? +draw-object = + element draw:object { + draw-object-attlist, + (common-draw-data-attlist | office-document | math-math) + } +draw-object-ole = + element draw:object-ole { + draw-object-ole-attlist, + (common-draw-data-attlist | office-binary-data) + } +draw-object-attlist = + attribute draw:notify-on-update-of-ranges { + cellRangeAddressList | \string + }? + & xml-id? +draw-object-ole-attlist = + attribute draw:class-id { \string }? + & xml-id? +draw-applet = + element draw:applet { + draw-applet-attlist, common-draw-data-attlist?, draw-param* + } +draw-applet-attlist = + attribute draw:code { \string }? + & attribute draw:object { \string }? + & attribute draw:archive { \string }? + & attribute draw:may-script { boolean }? + & xml-id? +draw-plugin = + element draw:plugin { + draw-plugin-attlist, common-draw-data-attlist, draw-param* + } +draw-plugin-attlist = + attribute draw:mime-type { \string }? + & xml-id? +draw-param = element draw:param { draw-param-attlist, empty } +draw-param-attlist = + attribute draw:name { \string }? + & attribute draw:value { \string }? +draw-floating-frame = + element draw:floating-frame { + draw-floating-frame-attlist, common-draw-data-attlist + } +draw-floating-frame-attlist = + attribute draw:frame-name { \string }? + & xml-id? +draw-contour-polygon = + element draw:contour-polygon { + common-contour-attlist, + common-draw-size-attlist, + common-draw-viewbox-attlist, + common-draw-points-attlist, + empty + } +draw-contour-path = + element draw:contour-path { + common-contour-attlist, + common-draw-size-attlist, + common-draw-viewbox-attlist, + common-draw-path-data-attlist, + empty + } +common-contour-attlist = attribute draw:recreate-on-edit { boolean } +draw-a = element draw:a { draw-a-attlist, shape-instance } +draw-a-attlist = + attribute xlink:type { "simple" } + & attribute xlink:href { anyIRI } + & attribute xlink:actuate { "onRequest" }? + & attribute office:target-frame-name { targetFrameName }? + & attribute xlink:show { "new" | "replace" }? + & attribute office:name { \string }? + & attribute office:title { \string }? + & attribute office:server-map { boolean }? + & xml-id? +draw-image-map = + element draw:image-map { + (draw-area-rectangle | draw-area-circle | draw-area-polygon)* + } +draw-area-rectangle = + element draw:area-rectangle { + common-draw-area-attlist, + attribute svg:x { coordinate }, + attribute svg:y { coordinate }, + attribute svg:width { length }, + attribute svg:height { length }, + svg-title?, + svg-desc?, + office-event-listeners? + } +draw-area-circle = + element draw:area-circle { + common-draw-area-attlist, + attribute svg:cx { coordinate }, + attribute svg:cy { coordinate }, + attribute svg:r { length }, + svg-title?, + svg-desc?, + office-event-listeners? + } +draw-area-polygon = + element draw:area-polygon { + common-draw-area-attlist, + attribute svg:x { coordinate }, + attribute svg:y { coordinate }, + attribute svg:width { length }, + attribute svg:height { length }, + common-draw-viewbox-attlist, + common-draw-points-attlist, + svg-title?, + svg-desc?, + office-event-listeners? + } +common-draw-area-attlist = + (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute office:target-frame-name { targetFrameName }?, + attribute xlink:show { "new" | "replace" }?)? + & attribute office:name { \string }? + & attribute draw:nohref { "nohref" }? +dr3d-scene = + element dr3d:scene { + dr3d-scene-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-style-name-attlist, + common-draw-z-index-attlist, + common-draw-id-attlist, + common-draw-layer-name-attlist, + common-text-spreadsheet-shape-attlist, + common-dr3d-transform-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + dr3d-light*, + shapes3d*, + draw-glue-point* + } +shapes3d = + dr3d-scene | dr3d-extrude | dr3d-sphere | dr3d-rotate | dr3d-cube +dr3d-scene-attlist = + attribute dr3d:vrp { vector3D }? + & attribute dr3d:vpn { vector3D }? + & attribute dr3d:vup { vector3D }? + & attribute dr3d:projection { "parallel" | "perspective" }? + & attribute dr3d:distance { length }? + & attribute dr3d:focal-length { length }? + & attribute dr3d:shadow-slant { angle }? + & attribute dr3d:shade-mode { + "flat" | "phong" | "gouraud" | "draft" + }? + & attribute dr3d:ambient-color { color }? + & attribute dr3d:lighting-mode { boolean }? +common-dr3d-transform-attlist = attribute dr3d:transform { \string }? +dr3d-light = element dr3d:light { dr3d-light-attlist, empty } +dr3d-light-attlist = + attribute dr3d:diffuse-color { color }? + & attribute dr3d:direction { vector3D } + & attribute dr3d:enabled { boolean }? + & attribute dr3d:specular { boolean }? +dr3d-cube = + element dr3d:cube { + dr3d-cube-attlist, + common-draw-z-index-attlist, + common-draw-id-attlist, + common-draw-layer-name-attlist, + common-draw-style-name-attlist, + common-dr3d-transform-attlist, + empty + } +dr3d-cube-attlist = + attribute dr3d:min-edge { vector3D }?, + attribute dr3d:max-edge { vector3D }? +dr3d-sphere = + element dr3d:sphere { + dr3d-sphere-attlist, + common-draw-z-index-attlist, + common-draw-id-attlist, + common-draw-layer-name-attlist, + common-draw-style-name-attlist, + common-dr3d-transform-attlist, + empty + } +dr3d-sphere-attlist = + attribute dr3d:center { vector3D }? + & attribute dr3d:size { vector3D }? +dr3d-extrude = + element dr3d:extrude { + common-draw-path-data-attlist, + common-draw-viewbox-attlist, + common-draw-id-attlist, + common-draw-z-index-attlist, + common-draw-layer-name-attlist, + common-draw-style-name-attlist, + common-dr3d-transform-attlist, + empty + } +dr3d-rotate = + element dr3d:rotate { + common-draw-viewbox-attlist, + common-draw-path-data-attlist, + common-draw-z-index-attlist, + common-draw-id-attlist, + common-draw-layer-name-attlist, + common-draw-style-name-attlist, + common-dr3d-transform-attlist, + empty + } +draw-custom-shape = + element draw:custom-shape { + draw-custom-shape-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + common-draw-caption-id-attlist, + svg-title?, + svg-desc?, + office-event-listeners?, + draw-glue-point*, + draw-text, + draw-enhanced-geometry? + } +draw-custom-shape-attlist = + attribute draw:engine { namespacedToken }? + & attribute draw:data { \string }? +draw-enhanced-geometry = + element draw:enhanced-geometry { + draw-enhanced-geometry-attlist, draw-equation*, draw-handle* + } +draw-enhanced-geometry-attlist = + attribute draw:type { custom-shape-type }? + & attribute svg:viewBox { + list { integer, integer, integer, integer } + }? + & attribute draw:mirror-vertical { boolean }? + & attribute draw:mirror-horizontal { boolean }? + & attribute draw:text-rotate-angle { angle }? + & attribute draw:extrusion-allowed { boolean }? + & attribute draw:text-path-allowed { boolean }? + & attribute draw:concentric-gradient-fill-allowed { boolean }? + & attribute draw:extrusion { boolean }? + & attribute draw:extrusion-brightness { zeroToHundredPercent }? + & attribute draw:extrusion-depth { + list { length, double } + }? + & attribute draw:extrusion-diffusion { percent }? + & attribute draw:extrusion-number-of-line-segments { integer }? + & attribute draw:extrusion-light-face { boolean }? + & attribute draw:extrusion-first-light-harsh { boolean }? + & attribute draw:extrusion-second-light-harsh { boolean }? + & attribute draw:extrusion-first-light-level { zeroToHundredPercent }? + & attribute draw:extrusion-second-light-level { + zeroToHundredPercent + }? + & attribute draw:extrusion-first-light-direction { vector3D }? + & attribute draw:extrusion-second-light-direction { vector3D }? + & attribute draw:extrusion-metal { boolean }? + & attribute dr3d:shade-mode { + "flat" | "phong" | "gouraud" | "draft" + }? + & attribute draw:extrusion-rotation-angle { + list { angle, angle } + }? + & attribute draw:extrusion-rotation-center { vector3D }? + & attribute draw:extrusion-shininess { zeroToHundredPercent }? + & attribute draw:extrusion-skew { + list { double, angle } + }? + & attribute draw:extrusion-specularity { zeroToHundredPercent }? + & attribute dr3d:projection { "parallel" | "perspective" }? + & attribute draw:extrusion-viewpoint { point3D }? + & attribute draw:extrusion-origin { + list { extrusionOrigin, extrusionOrigin } + }? + & attribute draw:extrusion-color { boolean }? + & attribute draw:enhanced-path { \string }? + & attribute draw:path-stretchpoint-x { double }? + & attribute draw:path-stretchpoint-y { double }? + & attribute draw:text-areas { \string }? + & attribute draw:glue-points { \string }? + & attribute draw:glue-point-type { + "none" | "segments" | "rectangle" + }? + & attribute draw:glue-point-leaving-directions { \string }? + & attribute draw:text-path { boolean }? + & attribute draw:text-path-mode { "normal" | "path" | "shape" }? + & attribute draw:text-path-scale { "path" | "shape" }? + & attribute draw:text-path-same-letter-heights { boolean }? + & attribute draw:modifiers { \string }? +custom-shape-type = "non-primitive" | \string +point3D = + xsd:string { + pattern = + "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))){2}[ ]*\)" + } +extrusionOrigin = + xsd:double { minInclusive = "-0.5" maxInclusive = "0.5" } +draw-equation = element draw:equation { draw-equation-attlist, empty } +draw-equation-attlist = + attribute draw:name { \string }? + & attribute draw:formula { \string }? +draw-handle = element draw:handle { draw-handle-attlist, empty } +draw-handle-attlist = + attribute draw:handle-mirror-vertical { boolean }? + & attribute draw:handle-mirror-horizontal { boolean }? + & attribute draw:handle-switched { boolean }? + & attribute draw:handle-position { \string } + & attribute draw:handle-range-x-minimum { \string }? + & attribute draw:handle-range-x-maximum { \string }? + & attribute draw:handle-range-y-minimum { \string }? + & attribute draw:handle-range-y-maximum { \string }? + & attribute draw:handle-polar { \string }? + & attribute draw:handle-radius-range-minimum { \string }? + & attribute draw:handle-radius-range-maximum { \string }? +presentation-shape-attlist = + attribute presentation:class { presentation-classes }? + & attribute presentation:placeholder { boolean }? + & attribute presentation:user-transformed { boolean }? +presentation-classes = + "title" + | "outline" + | "subtitle" + | "text" + | "graphic" + | "object" + | "chart" + | "table" + | "orgchart" + | "page" + | "notes" + | "handout" + | "header" + | "footer" + | "date-time" + | "page-number" +presentation-animations = + element presentation:animations { + (presentation-animation-elements | presentation-animation-group)* + } +presentation-animation-elements = + presentation-show-shape + | presentation-show-text + | presentation-hide-shape + | presentation-hide-text + | presentation-dim + | presentation-play +presentation-sound = + element presentation:sound { + presentation-sound-attlist, + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:actuate { "onRequest" }?, + attribute xlink:show { "new" | "replace" }?, + empty + } +presentation-sound-attlist = + attribute presentation:play-full { boolean }? + & xml-id? +presentation-show-shape = + element presentation:show-shape { + common-presentation-effect-attlist, presentation-sound? + } +common-presentation-effect-attlist = + attribute draw:shape-id { IDREF } + & attribute presentation:effect { presentationEffects }? + & attribute presentation:direction { presentationEffectDirections }? + & attribute presentation:speed { presentationSpeeds }? + & attribute presentation:delay { duration }? + & attribute presentation:start-scale { percent }? + & attribute presentation:path-id { \string }? +presentationEffects = + "none" + | "fade" + | "move" + | "stripes" + | "open" + | "close" + | "dissolve" + | "wavyline" + | "random" + | "lines" + | "laser" + | "appear" + | "hide" + | "move-short" + | "checkerboard" + | "rotate" + | "stretch" +presentationEffectDirections = + "none" + | "from-left" + | "from-top" + | "from-right" + | "from-bottom" + | "from-center" + | "from-upper-left" + | "from-upper-right" + | "from-lower-left" + | "from-lower-right" + | "to-left" + | "to-top" + | "to-right" + | "to-bottom" + | "to-upper-left" + | "to-upper-right" + | "to-lower-right" + | "to-lower-left" + | "path" + | "spiral-inward-left" + | "spiral-inward-right" + | "spiral-outward-left" + | "spiral-outward-right" + | "vertical" + | "horizontal" + | "to-center" + | "clockwise" + | "counter-clockwise" +presentationSpeeds = "slow" | "medium" | "fast" +presentation-show-text = + element presentation:show-text { + common-presentation-effect-attlist, presentation-sound? + } +presentation-hide-shape = + element presentation:hide-shape { + common-presentation-effect-attlist, presentation-sound? + } +presentation-hide-text = + element presentation:hide-text { + common-presentation-effect-attlist, presentation-sound? + } +presentation-dim = + element presentation:dim { + presentation-dim-attlist, presentation-sound? + } +presentation-dim-attlist = + attribute draw:shape-id { IDREF } + & attribute draw:color { color } +presentation-play = + element presentation:play { presentation-play-attlist, empty } +presentation-play-attlist = + attribute draw:shape-id { IDREF }, + attribute presentation:speed { presentationSpeeds }? +presentation-animation-group = + element presentation:animation-group { + presentation-animation-elements* + } +common-anim-attlist = + attribute presentation:node-type { + "default" + | "on-click" + | "with-previous" + | "after-previous" + | "timing-root" + | "main-sequence" + | "interactive-sequence" + }? + & attribute presentation:preset-id { \string }? + & attribute presentation:preset-sub-type { \string }? + & attribute presentation:preset-class { + "custom" + | "entrance" + | "exit" + | "emphasis" + | "motion-path" + | "ole-action" + | "media-call" + }? + & attribute presentation:master-element { IDREF }? + & attribute presentation:group-id { \string }? + & (xml-id, + attribute anim:id { NCName }?)? +presentation-event-listener = + element presentation:event-listener { + presentation-event-listener-attlist, presentation-sound? + } +presentation-event-listener-attlist = + attribute script:event-name { \string } + & attribute presentation:action { + "none" + | "previous-page" + | "next-page" + | "first-page" + | "last-page" + | "hide" + | "stop" + | "execute" + | "show" + | "verb" + | "fade-out" + | "sound" + | "last-visited-page" + } + & attribute presentation:effect { presentationEffects }? + & attribute presentation:direction { presentationEffectDirections }? + & attribute presentation:speed { presentationSpeeds }? + & attribute presentation:start-scale { percent }? + & (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "embed" }?, + attribute xlink:actuate { "onRequest" }?)? + & attribute presentation:verb { nonNegativeInteger }? +presentation-decls = presentation-decl* +presentation-decl = + element presentation:header-decl { + presentation-header-decl-attlist, text + } + | element presentation:footer-decl { + presentation-footer-decl-attlist, text + } + | element presentation:date-time-decl { + presentation-date-time-decl-attlist, text + } +presentation-header-decl-attlist = + attribute presentation:name { \string } +presentation-footer-decl-attlist = + attribute presentation:name { \string } +presentation-date-time-decl-attlist = + attribute presentation:name { \string } + & attribute presentation:source { "fixed" | "current-date" } + & attribute style:data-style-name { styleNameRef }? +presentation-settings = + element presentation:settings { + presentation-settings-attlist, presentation-show* + }? +presentation-settings-attlist = + attribute presentation:start-page { \string }? + & attribute presentation:show { \string }? + & attribute presentation:full-screen { boolean }? + & attribute presentation:endless { boolean }? + & attribute presentation:pause { duration }? + & attribute presentation:show-logo { boolean }? + & attribute presentation:force-manual { boolean }? + & attribute presentation:mouse-visible { boolean }? + & attribute presentation:mouse-as-pen { boolean }? + & attribute presentation:start-with-navigator { boolean }? + & attribute presentation:animations { "enabled" | "disabled" }? + & attribute presentation:transition-on-click { + "enabled" | "disabled" + }? + & attribute presentation:stay-on-top { boolean }? + & attribute presentation:show-end-of-presentation-slide { boolean }? +presentation-show = + element presentation:show { presentation-show-attlist, empty } +presentation-show-attlist = + attribute presentation:name { \string } + & attribute presentation:pages { \string } +chart-chart = + element chart:chart { + chart-chart-attlist, + chart-title?, + chart-subtitle?, + chart-footer?, + chart-legend?, + chart-plot-area, + table-table? + } +chart-chart-attlist = + attribute chart:class { namespacedToken } + & common-draw-size-attlist + & attribute chart:column-mapping { \string }? + & attribute chart:row-mapping { \string }? + & attribute chart:style-name { styleNameRef }? + & (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI })? + & xml-id? +chart-title = element chart:title { chart-title-attlist, text-p? } +chart-title-attlist = + attribute table:cell-range { cellRangeAddressList }? + & common-draw-position-attlist + & attribute chart:style-name { styleNameRef }? +chart-subtitle = element chart:subtitle { chart-title-attlist, text-p? } +chart-footer = element chart:footer { chart-title-attlist, text-p? } +chart-legend = element chart:legend { chart-legend-attlist, text-p? } +chart-legend-attlist = + ((attribute chart:legend-position { + "start" | "end" | "top" | "bottom" + }, + attribute chart:legend-align { "start" | "center" | "end" }?) + | attribute chart:legend-position { + "top-start" | "bottom-start" | "top-end" | "bottom-end" + } + | empty) + & common-draw-position-attlist + & (attribute style:legend-expansion { "wide" | "high" | "balanced" } + | (attribute style:legend-expansion { "custom" }, + attribute style:legend-expansion-aspect-ratio { double }) + | empty) + & attribute chart:style-name { styleNameRef }? +chart-plot-area = + element chart:plot-area { + chart-plot-area-attlist, + dr3d-light*, + chart-axis*, + chart-series*, + chart-stock-gain-marker?, + chart-stock-loss-marker?, + chart-stock-range-line?, + chart-wall?, + chart-floor? + } +chart-plot-area-attlist = + common-draw-position-attlist + & common-draw-size-attlist + & attribute chart:style-name { styleNameRef }? + & attribute table:cell-range-address { cellRangeAddressList }? + & attribute chart:data-source-has-labels { + "none" | "row" | "column" | "both" + }? + & dr3d-scene-attlist + & common-dr3d-transform-attlist + & xml-id? +chart-wall = element chart:wall { chart-wall-attlist, empty } +chart-wall-attlist = + attribute svg:width { length }? + & attribute chart:style-name { styleNameRef }? +chart-floor = element chart:floor { chart-floor-attlist, empty } +chart-floor-attlist = + attribute svg:width { length }? + & attribute chart:style-name { styleNameRef }? +chart-axis = + element chart:axis { + chart-axis-attlist, chart-title?, chart-categories?, chart-grid* + } +chart-axis-attlist = + attribute chart:dimension { chart-dimension } + & attribute chart:name { \string }? + & attribute chart:style-name { styleNameRef }? +chart-dimension = "x" | "y" | "z" +chart-categories = + element chart:categories { + attribute table:cell-range-address { cellRangeAddressList }? + } +chart-grid = element chart:grid { chart-grid-attlist } +chart-grid-attlist = + attribute chart:class { "major" | "minor" }? + & attribute chart:style-name { styleNameRef }? +chart-series = + element chart:series { + chart-series-attlist, + chart-domain*, + chart-mean-value?, + chart-regression-curve*, + chart-error-indicator*, + chart-data-point*, + chart-data-label? + } +chart-series-attlist = + attribute chart:values-cell-range-address { cellRangeAddressList }? + & attribute chart:label-cell-address { cellRangeAddressList }? + & attribute chart:class { namespacedToken }? + & attribute chart:attached-axis { \string }? + & attribute chart:style-name { styleNameRef }? + & xml-id? +chart-domain = + element chart:domain { + attribute table:cell-range-address { cellRangeAddressList }? + } +chart-data-point = + element chart:data-point { + chart-data-point-attlist, chart-data-label? + } +chart-data-point-attlist = + attribute chart:repeated { positiveInteger }? + & attribute chart:style-name { styleNameRef }? + & xml-id? +chart-data-label = + element chart:data-label { chart-data-label-attlist, text-p? } +chart-data-label-attlist = + common-draw-position-attlist + & attribute chart:style-name { styleNameRef }? +chart-mean-value = + element chart:mean-value { chart-mean-value-attlist, empty } +chart-mean-value-attlist = attribute chart:style-name { styleNameRef }? +chart-error-indicator = + element chart:error-indicator { chart-error-indicator-attlist, empty } +chart-error-indicator-attlist = + attribute chart:style-name { styleNameRef }? + & attribute chart:dimension { chart-dimension } +chart-regression-curve = + element chart:regression-curve { + chart-regression-curve-attlist, chart-equation? + } +chart-regression-curve-attlist = + attribute chart:style-name { styleNameRef }? +chart-equation = + element chart:equation { chart-equation-attlist, text-p? } +chart-equation-attlist = + attribute chart:automatic-content { boolean }? + & attribute chart:display-r-square { boolean }? + & attribute chart:display-equation { boolean }? + & common-draw-position-attlist + & attribute chart:style-name { styleNameRef }? +chart-stock-gain-marker = + element chart:stock-gain-marker { common-stock-marker-attlist } +chart-stock-loss-marker = + element chart:stock-loss-marker { common-stock-marker-attlist } +chart-stock-range-line = + element chart:stock-range-line { common-stock-marker-attlist } +common-stock-marker-attlist = + attribute chart:style-name { styleNameRef }? +office-database = + element office:database { + db-data-source, + db-forms?, + db-reports?, + db-queries?, + db-table-presentations?, + db-schema-definition? + } +db-data-source = + element db:data-source { + db-data-source-attlist, + db-connection-data, + db-driver-settings?, + db-application-connection-settings? + } +db-data-source-attlist = empty +db-connection-data = + element db:connection-data { + db-connection-data-attlist, + (db-database-description | db-connection-resource), + db-login? + } +db-connection-data-attlist = empty +db-database-description = + element db:database-description { + db-database-description-attlist, + (db-file-based-database | db-server-database) + } +db-database-description-attlist = empty +db-file-based-database = + element db:file-based-database { db-file-based-database-attlist } +db-file-based-database-attlist = + attribute xlink:type { "simple" } + & attribute xlink:href { anyIRI } + & attribute db:media-type { \string } + & attribute db:extension { \string }? +db-server-database = + element db:server-database { db-server-database-attlist, empty } +db-server-database-attlist = + attribute db:type { namespacedToken } + & (db-host-and-port | db-local-socket-name) + & attribute db:database-name { \string }? +db-host-and-port = + attribute db:hostname { \string }, + attribute db:port { positiveInteger }? +db-local-socket-name = attribute db:local-socket { \string }? +db-connection-resource = + element db:connection-resource { + db-connection-resource-attlist, empty + } +db-connection-resource-attlist = + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "none" }?, + attribute xlink:actuate { "onRequest" }? +db-login = element db:login { db-login-attlist, empty } +db-login-attlist = + (attribute db:user-name { \string } + | attribute db:use-system-user { boolean })? + & attribute db:is-password-required { boolean }? + & attribute db:login-timeout { positiveInteger }? +db-driver-settings = + element db:driver-settings { + db-driver-settings-attlist, + db-auto-increment?, + db-delimiter?, + db-character-set?, + db-table-settings? + } +db-driver-settings-attlist = + db-show-deleted + & attribute db:system-driver-settings { \string }? + & attribute db:base-dn { \string }? + & db-is-first-row-header-line + & attribute db:parameter-name-substitution { boolean }? +db-show-deleted = attribute db:show-deleted { boolean }? +db-is-first-row-header-line = + attribute db:is-first-row-header-line { boolean }? +db-auto-increment = + element db:auto-increment { db-auto-increment-attlist, empty } +db-auto-increment-attlist = + attribute db:additional-column-statement { \string }? + & attribute db:row-retrieving-statement { \string }? +db-delimiter = element db:delimiter { db-delimiter-attlist, empty } +db-delimiter-attlist = + attribute db:field { \string }? + & attribute db:string { \string }? + & attribute db:decimal { \string }? + & attribute db:thousand { \string }? +db-character-set = + element db:character-set { db-character-set-attlist, empty } +db-character-set-attlist = attribute db:encoding { textEncoding }? +db-table-settings = element db:table-settings { db-table-setting* } +db-table-setting = + element db:table-setting { + db-table-setting-attlist, db-delimiter?, db-character-set?, empty + } +db-table-setting-attlist = db-is-first-row-header-line, db-show-deleted +db-application-connection-settings = + element db:application-connection-settings { + db-application-connection-settings-attlist, + db-table-filter?, + db-table-type-filter?, + db-data-source-settings? + } +db-application-connection-settings-attlist = + attribute db:is-table-name-length-limited { boolean }? + & attribute db:enable-sql92-check { boolean }? + & attribute db:append-table-alias-name { boolean }? + & attribute db:ignore-driver-privileges { boolean }? + & attribute db:boolean-comparison-mode { + "equal-integer" + | "is-boolean" + | "equal-boolean" + | "equal-use-only-zero" + }? + & attribute db:use-catalog { boolean }? + & attribute db:max-row-count { integer }? + & attribute db:suppress-version-columns { boolean }? +db-table-filter = + element db:table-filter { + db-table-filter-attlist, + db-table-include-filter?, + db-table-exclude-filter? + } +db-table-filter-attlist = empty +db-table-include-filter = + element db:table-include-filter { + db-table-include-filter-attlist, db-table-filter-pattern+ + } +db-table-include-filter-attlist = empty +db-table-exclude-filter = + element db:table-exclude-filter { + db-table-exclude-filter-attlist, db-table-filter-pattern+ + } +db-table-exclude-filter-attlist = empty +db-table-filter-pattern = + element db:table-filter-pattern { + db-table-filter-pattern-attlist, \string + } +db-table-filter-pattern-attlist = empty +db-table-type-filter = + element db:table-type-filter { + db-table-type-filter-attlist, db-table-type* + } +db-table-type-filter-attlist = empty +db-table-type = element db:table-type { db-table-type-attlist, \string } +db-table-type-attlist = empty +db-data-source-settings = + element db:data-source-settings { + db-data-source-settings-attlist, db-data-source-setting+ + } +db-data-source-settings-attlist = empty +db-data-source-setting = + element db:data-source-setting { + db-data-source-setting-attlist, db-data-source-setting-value+ + } +db-data-source-setting-attlist = + attribute db:data-source-setting-is-list { boolean }? + & attribute db:data-source-setting-name { \string } + & attribute db:data-source-setting-type { + db-data-source-setting-types + } +db-data-source-setting-types = + "boolean" | "short" | "int" | "long" | "double" | "string" +db-data-source-setting-value = + element db:data-source-setting-value { + db-data-source-setting-value-attlist, \string + } +db-data-source-setting-value-attlist = empty +db-forms = + element db:forms { + db-forms-attlist, (db-component | db-component-collection)* + } +db-forms-attlist = empty +db-reports = + element db:reports { + db-reports-attlist, (db-component | db-component-collection)* + } +db-reports-attlist = empty +db-component-collection = + element db:component-collection { + db-component-collection-attlist, + common-db-object-name, + common-db-object-title, + common-db-object-description, + (db-component | db-component-collection)* + } +db-component-collection-attlist = empty +db-component = + element db:component { + db-component-attlist, + common-db-object-name, + common-db-object-title, + common-db-object-description, + (office-document | math-math)? + } +db-component-attlist = + (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "none" }?, + attribute xlink:actuate { "onRequest" }?)? + & attribute db:as-template { boolean }? +db-queries = + element db:queries { + db-queries-attlist, (db-query | db-query-collection)* + } +db-queries-attlist = empty +db-query-collection = + element db:query-collection { + db-query-collection-attlist, + common-db-object-name, + common-db-object-title, + common-db-object-description, + (db-query | db-query-collection)* + } +db-query-collection-attlist = empty +db-query = + element db:query { + db-query-attlist, + common-db-object-name, + common-db-object-title, + common-db-object-description, + common-db-table-style-name, + db-order-statement?, + db-filter-statement?, + db-columns?, + db-update-table? + } +db-query-attlist = + attribute db:command { \string } + & attribute db:escape-processing { boolean }? +db-order-statement = + element db:order-statement { db-command, db-apply-command, empty } +db-filter-statement = + element db:filter-statement { db-command, db-apply-command, empty } +db-update-table = + element db:update-table { common-db-table-name-attlist } +db-table-presentations = + element db:table-representations { + db-table-presentations-attlist, db-table-presentation* + } +db-table-presentations-attlist = empty +db-table-presentation = + element db:table-representation { + db-table-presentation-attlist, + common-db-table-name-attlist, + common-db-object-title, + common-db-object-description, + common-db-table-style-name, + db-order-statement?, + db-filter-statement?, + db-columns? + } +db-table-presentation-attlist = empty +db-columns = element db:columns { db-columns-attlist, db-column+ } +db-columns-attlist = empty +db-column = + element db:column { + db-column-attlist, + common-db-object-name, + common-db-object-title, + common-db-object-description, + common-db-default-value + } +db-column-attlist = + attribute db:visible { boolean }? + & attribute db:style-name { styleNameRef }? + & attribute db:default-cell-style-name { styleNameRef }? +db-command = attribute db:command { \string } +db-apply-command = attribute db:apply-command { boolean }? +common-db-table-name-attlist = + attribute db:name { \string } + & attribute db:catalog-name { \string }? + & attribute db:schema-name { \string }? +common-db-object-name = attribute db:name { \string } +common-db-object-title = attribute db:title { \string }? +common-db-object-description = attribute db:description { \string }? +common-db-table-style-name = + attribute db:style-name { styleNameRef }? + & attribute db:default-row-style-name { styleNameRef }? +common-db-default-value = common-value-and-type-attlist? +db-schema-definition = + element db:schema-definition { + db-schema-definition-attlist, db-table-definitions + } +db-schema-definition-attlist = empty +db-table-definitions = + element db:table-definitions { + db-table-definitions-attlist, db-table-definition* + } +db-table-definitions-attlist = empty +db-table-definition = + element db:table-definition { + common-db-table-name-attlist, + db-table-definition-attlist, + db-column-definitions, + db-keys?, + db-indices? + } +db-table-definition-attlist = attribute db:type { \string }? +db-column-definitions = + element db:column-definitions { + db-column-definitions-attlist, db-column-definition+ + } +db-column-definitions-attlist = empty +db-column-definition = + element db:column-definition { + db-column-definition-attlist, common-db-default-value + } +db-column-definition-attlist = + attribute db:name { \string } + & attribute db:data-type { db-data-types }? + & attribute db:type-name { \string }? + & attribute db:precision { positiveInteger }? + & attribute db:scale { positiveInteger }? + & attribute db:is-nullable { "no-nulls" | "nullable" }? + & attribute db:is-empty-allowed { boolean }? + & attribute db:is-autoincrement { boolean }? +db-data-types = + "bit" + | "boolean" + | "tinyint" + | "smallint" + | "integer" + | "bigint" + | "float" + | "real" + | "double" + | "numeric" + | "decimal" + | "char" + | "varchar" + | "longvarchar" + | "date" + | "time" + | "timestmp" + | "binary" + | "varbinary" + | "longvarbinary" + | "sqlnull" + | "other" + | "object" + | "distinct" + | "struct" + | "array" + | "blob" + | "clob" + | "ref" +db-keys = element db:keys { db-keys-attlist, db-key+ } +db-keys-attlist = empty +db-key = element db:key { db-key-attlist, db-key-columns+ } +db-key-attlist = + attribute db:name { \string }? + & attribute db:type { "primary" | "unique" | "foreign" } + & attribute db:referenced-table-name { \string }? + & attribute db:update-rule { + "cascade" | "restrict" | "set-null" | "no-action" | "set-default" + }? + & attribute db:delete-rule { + "cascade" | "restrict" | "set-null" | "no-action" | "set-default" + }? +db-key-columns = + element db:key-columns { db-key-columns-attlist, db-key-column+ } +db-key-columns-attlist = empty +db-key-column = element db:key-column { db-key-column-attlist, empty } +db-key-column-attlist = + attribute db:name { \string }? + & attribute db:related-column-name { \string }? +db-indices = element db:indices { db-indices-attlist, db-index+ } +db-indices-attlist = empty +db-index = element db:index { db-index-attlist, db-index-columns+ } +db-index-attlist = + attribute db:name { \string } + & attribute db:catalog-name { \string }? + & attribute db:is-unique { boolean }? + & attribute db:is-clustered { boolean }? +db-index-columns = element db:index-columns { db-index-column+ } +db-index-column = + element db:index-column { db-index-column-attlist, empty } +db-index-column-attlist = + attribute db:name { \string } + & attribute db:is-ascending { boolean }? +office-forms = + element office:forms { + office-forms-attlist, (form-form | xforms-model)* + }? +office-forms-attlist = + attribute form:automatic-focus { boolean }? + & attribute form:apply-design-mode { boolean }? +form-form = + element form:form { + common-form-control-attlist, + form-form-attlist, + form-properties?, + office-event-listeners?, + (controls | form-form)*, + form-connection-resource? + } +form-form-attlist = + (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:actuate { "onRequest" }?)? + & attribute office:target-frame { targetFrameName }? + & attribute form:method { "get" | "post" | \string }? + & attribute form:enctype { \string }? + & attribute form:allow-deletes { boolean }? + & attribute form:allow-inserts { boolean }? + & attribute form:allow-updates { boolean }? + & attribute form:apply-filter { boolean }? + & attribute form:command-type { "table" | "query" | "command" }? + & attribute form:command { \string }? + & attribute form:datasource { anyIRI | \string }? + & attribute form:master-fields { \string }? + & attribute form:detail-fields { \string }? + & attribute form:escape-processing { boolean }? + & attribute form:filter { \string }? + & attribute form:ignore-result { boolean }? + & attribute form:navigation-mode { navigation }? + & attribute form:order { \string }? + & attribute form:tab-cycle { tab-cycles }? +navigation = "none" | "current" | "parent" +tab-cycles = "records" | "current" | "page" +form-connection-resource = + element form:connection-resource { + attribute xlink:href { anyIRI }, + empty + } +xforms-model = element xforms:model { anyAttListOrElements } +column-controls = + element form:text { form-text-attlist, common-form-control-content } + | element form:textarea { + form-textarea-attlist, common-form-control-content, text-p* + } + | element form:formatted-text { + form-formatted-text-attlist, common-form-control-content + } + | element form:number { + form-number-attlist, + common-numeric-control-attlist, + common-form-control-content, + common-linked-cell, + common-spin-button, + common-repeat, + common-delay-for-repeat + } + | element form:date { + form-date-attlist, + common-numeric-control-attlist, + common-form-control-content, + common-linked-cell, + common-spin-button, + common-repeat, + common-delay-for-repeat + } + | element form:time { + form-time-attlist, + common-numeric-control-attlist, + common-form-control-content, + common-linked-cell, + common-spin-button, + common-repeat, + common-delay-for-repeat + } + | element form:combobox { + form-combobox-attlist, common-form-control-content, form-item* + } + | element form:listbox { + form-listbox-attlist, common-form-control-content, form-option* + } + | element form:checkbox { + form-checkbox-attlist, common-form-control-content + } +controls = + column-controls + | element form:password { + form-password-attlist, common-form-control-content + } + | element form:file { form-file-attlist, common-form-control-content } + | element form:fixed-text { + form-fixed-text-attlist, common-form-control-content + } + | element form:button { + form-button-attlist, common-form-control-content + } + | element form:image { + form-image-attlist, common-form-control-content + } + | element form:radio { + form-radio-attlist, common-form-control-content + } + | element form:frame { + form-frame-attlist, common-form-control-content + } + | element form:image-frame { + form-image-frame-attlist, common-form-control-content + } + | element form:hidden { + form-hidden-attlist, common-form-control-content + } + | element form:grid { + form-grid-attlist, common-form-control-content, form-column* + } + | element form:value-range { + form-value-range-attlist, common-form-control-content + } + | element form:generic-control { + form-generic-control-attlist, common-form-control-content + } +form-text-attlist = + form-control-attlist, + common-current-value-attlist, + common-disabled-attlist, + common-maxlength-attlist, + common-printable-attlist, + common-readonly-attlist, + common-tab-attlist, + common-title-attlist, + common-value-attlist, + common-convert-empty-attlist, + common-data-field-attlist, + common-linked-cell +form-control-attlist = + common-form-control-attlist, + common-control-id-attlist, + xforms-bind-attlist +common-form-control-content = form-properties?, office-event-listeners? +form-textarea-attlist = + form-control-attlist, + common-current-value-attlist, + common-disabled-attlist, + common-maxlength-attlist, + common-printable-attlist, + common-readonly-attlist, + common-tab-attlist, + common-title-attlist, + common-value-attlist, + common-convert-empty-attlist, + common-data-field-attlist, + common-linked-cell +form-password-attlist = + form-control-attlist + & common-disabled-attlist + & common-maxlength-attlist + & common-printable-attlist + & common-tab-attlist + & common-title-attlist + & common-value-attlist + & common-convert-empty-attlist + & common-linked-cell + & attribute form:echo-char { character }? +form-file-attlist = + form-control-attlist, + common-current-value-attlist, + common-disabled-attlist, + common-maxlength-attlist, + common-printable-attlist, + common-readonly-attlist, + common-tab-attlist, + common-title-attlist, + common-value-attlist, + common-linked-cell +form-formatted-text-attlist = + form-control-attlist + & common-current-value-attlist + & common-disabled-attlist + & common-maxlength-attlist + & common-printable-attlist + & common-readonly-attlist + & common-tab-attlist + & common-title-attlist + & common-value-attlist + & common-convert-empty-attlist + & common-data-field-attlist + & common-linked-cell + & common-spin-button + & common-repeat + & common-delay-for-repeat + & attribute form:max-value { \string }? + & attribute form:min-value { \string }? + & attribute form:validation { boolean }? +common-numeric-control-attlist = + form-control-attlist, + common-disabled-attlist, + common-maxlength-attlist, + common-printable-attlist, + common-readonly-attlist, + common-tab-attlist, + common-title-attlist, + common-convert-empty-attlist, + common-data-field-attlist +form-number-attlist = + attribute form:value { double }? + & attribute form:current-value { double }? + & attribute form:min-value { double }? + & attribute form:max-value { double }? +form-date-attlist = + attribute form:value { date }? + & attribute form:current-value { date }? + & attribute form:min-value { date }? + & attribute form:max-value { date }? +form-time-attlist = + attribute form:value { time }? + & attribute form:current-value { time }? + & attribute form:min-value { time }? + & attribute form:max-value { time }? +form-fixed-text-attlist = + form-control-attlist + & for + & common-disabled-attlist + & label + & common-printable-attlist + & common-title-attlist + & attribute form:multi-line { boolean }? +form-combobox-attlist = + form-control-attlist + & common-current-value-attlist + & common-disabled-attlist + & dropdown + & common-maxlength-attlist + & common-printable-attlist + & common-readonly-attlist + & size + & common-tab-attlist + & common-title-attlist + & common-value-attlist + & common-convert-empty-attlist + & common-data-field-attlist + & list-source + & list-source-type + & common-linked-cell + & common-source-cell-range + & attribute form:auto-complete { boolean }? +form-item = element form:item { form-item-attlist, text } +form-item-attlist = label +form-listbox-attlist = + form-control-attlist + & common-disabled-attlist + & dropdown + & common-printable-attlist + & size + & common-tab-attlist + & common-title-attlist + & bound-column + & common-data-field-attlist + & list-source + & list-source-type + & common-linked-cell + & list-linkage-type + & common-source-cell-range + & attribute form:multiple { boolean }? + & attribute form:xforms-list-source { \string }? +list-linkage-type = + attribute form:list-linkage-type { + "selection" | "selection-indices" + }? +form-option = element form:option { form-option-attlist, text } +form-option-attlist = + current-selected, selected, label, common-value-attlist +form-button-attlist = + form-control-attlist + & button-type + & common-disabled-attlist + & label + & image-data + & common-printable-attlist + & common-tab-attlist + & target-frame + & target-location + & common-title-attlist + & common-value-attlist + & common-form-relative-image-position-attlist + & common-repeat + & common-delay-for-repeat + & attribute form:default-button { boolean }? + & attribute form:toggle { boolean }? + & attribute form:focus-on-click { boolean }? + & attribute form:xforms-submission { \string }? +form-image-attlist = + form-control-attlist, + button-type, + common-disabled-attlist, + image-data, + common-printable-attlist, + common-tab-attlist, + target-frame, + target-location, + common-title-attlist, + common-value-attlist +form-checkbox-attlist = + form-control-attlist + & common-disabled-attlist + & label + & common-printable-attlist + & common-tab-attlist + & common-title-attlist + & common-value-attlist + & common-data-field-attlist + & common-form-visual-effect-attlist + & common-form-relative-image-position-attlist + & common-linked-cell + & attribute form:current-state { states }? + & attribute form:is-tristate { boolean }? + & attribute form:state { states }? +states = "unchecked" | "checked" | "unknown" +form-radio-attlist = + form-control-attlist, + current-selected, + common-disabled-attlist, + label, + common-printable-attlist, + selected, + common-tab-attlist, + common-title-attlist, + common-value-attlist, + common-data-field-attlist, + common-form-visual-effect-attlist, + common-form-relative-image-position-attlist, + common-linked-cell +form-frame-attlist = + form-control-attlist, + common-disabled-attlist, + for, + label, + common-printable-attlist, + common-title-attlist +form-image-frame-attlist = + form-control-attlist, + common-disabled-attlist, + image-data, + common-printable-attlist, + common-readonly-attlist, + common-title-attlist, + common-data-field-attlist +form-hidden-attlist = form-control-attlist, common-value-attlist +form-grid-attlist = + form-control-attlist, + common-disabled-attlist, + common-printable-attlist, + common-tab-attlist, + common-title-attlist +form-column = + element form:column { form-column-attlist, column-controls+ } +form-column-attlist = + common-form-control-attlist, label, text-style-name +text-style-name = attribute form:text-style-name { styleNameRef }? +form-value-range-attlist = + form-control-attlist + & common-disabled-attlist + & common-printable-attlist + & common-tab-attlist + & common-title-attlist + & common-value-attlist + & common-linked-cell + & common-repeat + & common-delay-for-repeat + & attribute form:max-value { integer }? + & attribute form:min-value { integer }? + & attribute form:step-size { positiveInteger }? + & attribute form:page-step-size { positiveInteger }? + & attribute form:orientation { "horizontal" | "vertical" }? +form-generic-control-attlist = form-control-attlist +common-form-control-attlist = + attribute form:name { \string }? + & attribute form:control-implementation { namespacedToken }? +xforms-bind-attlist = attribute xforms:bind { \string }? +types = "submit" | "reset" | "push" | "url" +button-type = attribute form:button-type { types }? +common-control-id-attlist = + xml-id, + attribute form:id { NCName }? +current-selected = attribute form:current-selected { boolean }? +common-value-attlist = attribute form:value { \string }? +common-current-value-attlist = attribute form:current-value { \string }? +common-disabled-attlist = attribute form:disabled { boolean }? +dropdown = attribute form:dropdown { boolean }? +for = attribute form:for { \string }? +image-data = attribute form:image-data { anyIRI }? +label = attribute form:label { \string }? +common-maxlength-attlist = + attribute form:max-length { nonNegativeInteger }? +common-printable-attlist = attribute form:printable { boolean }? +common-readonly-attlist = attribute form:readonly { boolean }? +selected = attribute form:selected { boolean }? +size = attribute form:size { nonNegativeInteger }? +common-tab-attlist = + attribute form:tab-index { nonNegativeInteger }? + & attribute form:tab-stop { boolean }? +target-frame = attribute office:target-frame { targetFrameName }? +target-location = attribute xlink:href { anyIRI }? +common-title-attlist = attribute form:title { \string }? +common-form-visual-effect-attlist = + attribute form:visual-effect { "flat" | "3d" }? +common-form-relative-image-position-attlist = + attribute form:image-position { "center" }? + | (attribute form:image-position { + "start" | "end" | "top" | "bottom" + }, + attribute form:image-align { "start" | "center" | "end" }?) +bound-column = attribute form:bound-column { \string }? +common-convert-empty-attlist = + attribute form:convert-empty-to-null { boolean }? +common-data-field-attlist = attribute form:data-field { \string }? +list-source = attribute form:list-source { \string }? +list-source-type = + attribute form:list-source-type { + "table" + | "query" + | "sql" + | "sql-pass-through" + | "value-list" + | "table-fields" + }? +common-linked-cell = + attribute form:linked-cell { cellAddress | \string }? +common-source-cell-range = + attribute form:source-cell-range { cellRangeAddress | \string }? +common-spin-button = attribute form:spin-button { boolean }? +common-repeat = attribute form:repeat { boolean }? +common-delay-for-repeat = attribute form:delay-for-repeat { duration }? +form-properties = element form:properties { form-property+ } +form-property = + element form:property { + form-property-name, form-property-value-and-type-attlist + } + | element form:list-property { + form-property-name, form-property-type-and-value-list + } +form-property-name = attribute form:property-name { \string } +form-property-value-and-type-attlist = + common-value-and-type-attlist + | attribute office:value-type { "void" } +form-property-type-and-value-list = + (attribute office:value-type { "float" }, + element form:list-value { + attribute office:value { double } + }*) + | (attribute office:value-type { "percentage" }, + element form:list-value { + attribute office:value { double } + }*) + | (attribute office:value-type { "currency" }, + element form:list-value { + attribute office:value { double }, + attribute office:currency { \string }? + }*) + | (attribute office:value-type { "date" }, + element form:list-value { + attribute office:date-value { dateOrDateTime } + }*) + | (attribute office:value-type { "time" }, + element form:list-value { + attribute office:time-value { duration } + }*) + | (attribute office:value-type { "boolean" }, + element form:list-value { + attribute office:boolean-value { boolean } + }*) + | (attribute office:value-type { "string" }, + element form:list-value { + attribute office:string-value { \string } + }*) + | attribute office:value-type { "void" } +office-annotation = + element office:annotation { + office-annotation-attlist, + draw-caption-attlist, + common-draw-position-attlist, + common-draw-size-attlist, + common-draw-shape-with-text-and-styles-attlist, + dc-creator?, + dc-date?, + meta-date-string?, + (text-p | text-list)* + } +office-annotation-end = + element office:annotation-end { office-annotation-end-attlist } +office-annotation-attlist = + attribute office:display { boolean }? + & common-office-annotation-name-attlist? +office-annotation-end-attlist = common-office-annotation-name-attlist +common-office-annotation-name-attlist = + attribute office:name { \string } +meta-date-string = element meta:date-string { \string } +common-num-format-prefix-suffix-attlist = + attribute style:num-prefix { \string }?, + attribute style:num-suffix { \string }? +common-num-format-attlist = + attribute style:num-format { "1" | "i" | "I" | \string | empty } + | (attribute style:num-format { "a" | "A" }, + style-num-letter-sync-attlist) + | empty +style-num-letter-sync-attlist = + attribute style:num-letter-sync { boolean }? +office-change-info = + element office:change-info { dc-creator, dc-date, text-p* } +office-event-listeners = + element office:event-listeners { + (script-event-listener | presentation-event-listener)* + } +script-event-listener = + element script:event-listener { script-event-listener-attlist, empty } +script-event-listener-attlist = + attribute script:event-name { \string } + & attribute script:language { \string } + & (attribute script:macro-name { \string } + | (attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:actuate { "onRequest" }?)) +math-math = element math:math { mathMarkup } +[ + dc:description [ + "To avoid inclusion of the complete MathML schema, anything is allowed within a math:math top-level element" + ] +] +mathMarkup = + (attribute * { text } + | text + | element * { mathMarkup })* +text-dde-connection-decl = + element text:dde-connection-decl { + text-dde-connection-decl-attlist, common-dde-connection-decl-attlist + } +text-dde-connection-decl-attlist = attribute office:name { \string } +common-dde-connection-decl-attlist = + attribute office:dde-application { \string } + & attribute office:dde-topic { \string } + & attribute office:dde-item { \string } + & attribute office:automatic-update { boolean }? +table-dde-link = + element table:dde-link { office-dde-source, table-table } +office-dde-source = + element office:dde-source { + office-dde-source-attlist, common-dde-connection-decl-attlist + } +office-dde-source-attlist = + attribute office:name { \string }? + & attribute office:conversion-mode { + "into-default-style-data-style" + | "into-english-number" + | "keep-text" + }? +animation-element = + element anim:animate { + common-anim-target-attlist, + common-anim-named-target-attlist, + common-anim-values-attlist, + common-anim-spline-mode-attlist, + common-spline-anim-value-attlist, + common-timing-attlist, + common-anim-add-accum-attlist + } + | element anim:set { + common-anim-target-attlist, + common-anim-named-target-attlist, + common-anim-set-values-attlist, + common-timing-attlist, + common-anim-add-accum-attlist + } + | element anim:animateMotion { + anim-animate-motion-attlist, + common-anim-target-attlist, + common-anim-named-target-attlist, + common-anim-add-accum-attlist, + common-anim-values-attlist, + common-timing-attlist, + common-spline-anim-value-attlist + } + | element anim:animateColor { + common-anim-target-attlist, + common-anim-named-target-attlist, + common-anim-add-accum-attlist, + common-anim-values-attlist, + common-anim-spline-mode-attlist, + common-spline-anim-value-attlist, + anim-animate-color-attlist, + common-timing-attlist + } + | element anim:animateTransform { + common-anim-target-attlist, + common-anim-named-target-attlist, + common-anim-add-accum-attlist, + common-anim-values-attlist, + anim-animate-transform-attlist, + common-timing-attlist + } + | element anim:transitionFilter { + common-anim-target-attlist, + common-anim-add-accum-attlist, + common-anim-values-attlist, + common-anim-spline-mode-attlist, + anim-transition-filter-attlist, + common-timing-attlist + } + | element anim:par { + common-anim-attlist, + common-timing-attlist, + common-endsync-timing-attlist, + animation-element* + } + | element anim:seq { + common-anim-attlist, + common-endsync-timing-attlist, + common-timing-attlist, + animation-element* + } + | element anim:iterate { + common-anim-attlist, + anim-iterate-attlist, + common-timing-attlist, + common-endsync-timing-attlist, + animation-element* + } + | element anim:audio { + common-anim-attlist, + anim-audio-attlist, + common-basic-timing-attlist + } + | element anim:command { + common-anim-attlist, + anim-command-attlist, + common-begin-end-timing-attlist, + common-anim-target-attlist, + element anim:param { + attribute anim:name { \string }, + attribute anim:value { \string } + }* + } +anim-animate-motion-attlist = + attribute svg:path { pathData }? + & attribute svg:origin { \string }? + & attribute smil:calcMode { + "discrete" | "linear" | "paced" | "spline" + }? +anim-animate-color-attlist = + attribute anim:color-interpolation { "rgb" | "hsl" }? + & attribute anim:color-interpolation-direction { + "clockwise" | "counter-clockwise" + }? +anim-animate-transform-attlist = + attribute svg:type { + "translate" | "scale" | "rotate" | "skewX" | "skewY" + } +anim-transition-filter-attlist = + attribute smil:type { \string } + & attribute smil:subtype { \string }? + & attribute smil:direction { "forward" | "reverse" }? + & attribute smil:fadeColor { color }? + & attribute smil:mode { "in" | "out" }? +common-anim-target-attlist = + attribute smil:targetElement { IDREF }? + & attribute anim:sub-item { \string }? +common-anim-named-target-attlist = + attribute smil:attributeName { \string } +common-anim-values-attlist = + attribute smil:values { \string }? + & attribute anim:formula { \string }? + & common-anim-set-values-attlist + & attribute smil:from { \string }? + & attribute smil:by { \string }? +common-anim-spline-mode-attlist = + attribute smil:calcMode { + "discrete" | "linear" | "paced" | "spline" + }? +common-spline-anim-value-attlist = + attribute smil:keyTimes { \string }? + & attribute smil:keySplines { \string }? +common-anim-add-accum-attlist = + attribute smil:accumulate { "none" | "sum" }? + & attribute smil:additive { "replace" | "sum" }? +common-anim-set-values-attlist = attribute smil:to { \string }? +common-begin-end-timing-attlist = + attribute smil:begin { \string }? + & attribute smil:end { \string }? +common-dur-timing-attlist = attribute smil:dur { \string }? +common-endsync-timing-attlist = + attribute smil:endsync { "first" | "last" | "all" | "media" | IDREF }? +common-repeat-timing-attlist = + attribute smil:repeatDur { \string }?, + attribute smil:repeatCount { nonNegativeDecimal | "indefinite" }? +nonNegativeDecimal = xsd:decimal { minInclusive = "0.0" } +common-fill-timing-attlist = + attribute smil:fill { + "remove" | "freeze" | "hold" | "auto" | "default" | "transition" + }? +common-fill-default-attlist = + attribute smil:fillDefault { + "remove" | "freeze" | "hold" | "transition" | "auto" | "inherit" + }? +common-restart-timing-attlist = + attribute smil:restart { + "never" | "always" | "whenNotActive" | "default" + }? +common-restart-default-attlist = + attribute smil:restartDefault { + "never" | "always" | "whenNotActive" | "inherit" + }? +common-time-manip-attlist = + attribute smil:accelerate { zeroToOneDecimal }? + & attribute smil:decelerate { zeroToOneDecimal }? + & attribute smil:autoReverse { boolean }? +zeroToOneDecimal = xsd:decimal { minInclusive = "0" maxInclusive = "1" } +common-basic-timing-attlist = + common-begin-end-timing-attlist, + common-dur-timing-attlist, + common-repeat-timing-attlist, + common-restart-timing-attlist, + common-restart-default-attlist, + common-fill-timing-attlist, + common-fill-default-attlist +common-timing-attlist = + common-basic-timing-attlist, common-time-manip-attlist +anim-iterate-attlist = + common-anim-target-attlist + & attribute anim:iterate-type { \string }? + & attribute anim:iterate-interval { duration }? +anim-audio-attlist = + attribute xlink:href { anyIRI }? + & attribute anim:audio-level { double }? +anim-command-attlist = attribute anim:command { \string } +style-style = + element style:style { + style-style-attlist, style-style-content, style-map* + } +common-in-content-meta-attlist = + attribute xhtml:about { URIorSafeCURIE }, + attribute xhtml:property { CURIEs }, + common-meta-literal-attlist +common-meta-literal-attlist = + attribute xhtml:datatype { CURIE }?, + attribute xhtml:content { \string }? +xml-id = attribute xml:id { ID } +style-style-attlist = + attribute style:name { styleName } + & attribute style:display-name { \string }? + & attribute style:parent-style-name { styleNameRef }? + & attribute style:next-style-name { styleNameRef }? + & attribute style:list-level { positiveInteger | empty }? + & attribute style:list-style-name { styleName | empty }? + & attribute style:master-page-name { styleNameRef }? + & attribute style:auto-update { boolean }? + & attribute style:data-style-name { styleNameRef }? + & attribute style:percentage-data-style-name { styleNameRef }? + & attribute style:class { \string }? + & attribute style:default-outline-level { positiveInteger | empty }? +style-map = element style:map { style-map-attlist, empty } +style-map-attlist = + attribute style:condition { \string } + & attribute style:apply-style-name { styleNameRef } + & attribute style:base-cell-address { cellAddress }? +style-default-style = + element style:default-style { style-style-content } +style-page-layout = + element style:page-layout { + style-page-layout-attlist, style-page-layout-content + } +style-page-layout-content = + style-page-layout-properties?, + style-header-style?, + style-footer-style? +style-page-layout-attlist = + attribute style:name { styleName } + & attribute style:page-usage { + "all" | "left" | "right" | "mirrored" + }? +style-header-style = + element style:header-style { style-header-footer-properties? } +style-footer-style = + element style:footer-style { style-header-footer-properties? } +style-default-page-layout = + element style:default-page-layout { style-page-layout-content } +style-master-page = + element style:master-page { + style-master-page-attlist, + (style-header, style-header-left?)?, + (style-footer, style-footer-left?)?, + draw-layer-set?, + office-forms?, + shape*, + animation-element?, + presentation-notes? + } +style-master-page-attlist = + attribute style:name { styleName } + & attribute style:display-name { \string }? + & attribute style:page-layout-name { styleNameRef } + & attribute draw:style-name { styleNameRef }? + & attribute style:next-style-name { styleNameRef }? +style-header = + element style:header { + common-style-header-footer-attlist, header-footer-content + } +style-footer = + element style:footer { + common-style-header-footer-attlist, header-footer-content + } +style-header-left = + element style:header-left { + common-style-header-footer-attlist, header-footer-content + } +style-footer-left = + element style:footer-left { + common-style-header-footer-attlist, header-footer-content + } +header-footer-content = + (text-tracked-changes, + text-decls, + (text-h + | text-p + | text-list + | table-table + | text-section + | text-table-of-content + | text-illustration-index + | text-table-index + | text-object-index + | text-user-index + | text-alphabetical-index + | text-bibliography + | text-index-title + | change-marks)*) + | (style-region-left?, style-region-center?, style-region-right?) +common-style-header-footer-attlist = + attribute style:display { boolean }? +style-region-left = element style:region-left { region-content } +style-region-center = element style:region-center { region-content } +style-region-right = element style:region-right { region-content } +region-content = text-p* +presentation-notes = + element presentation:notes { + common-presentation-header-footer-attlist, + presentation-notes-attlist, + office-forms, + shape* + } +presentation-notes-attlist = + attribute style:page-layout-name { styleNameRef }? + & attribute draw:style-name { styleNameRef }? +table-table-template = + element table:table-template { + table-table-template-attlist, + table-first-row?, + table-last-row?, + table-first-column?, + table-last-column?, + table-body, + table-even-rows?, + table-odd-rows?, + table-even-columns?, + table-odd-columns?, + table-background? + } +table-table-template-attlist = + attribute table:name { \string } + & attribute table:first-row-start-column { rowOrCol } + & attribute table:first-row-end-column { rowOrCol } + & attribute table:last-row-start-column { rowOrCol } + & attribute table:last-row-end-column { rowOrCol } +rowOrCol = "row" | "column" +table-first-row = + element table:first-row { common-table-template-attlist, empty } +table-last-row = + element table:last-row { common-table-template-attlist, empty } +table-first-column = + element table:first-column { common-table-template-attlist, empty } +table-last-column = + element table:last-column { common-table-template-attlist, empty } +table-body = element table:body { common-table-template-attlist, empty } +table-even-rows = + element table:even-rows { common-table-template-attlist, empty } +table-odd-rows = + element table:odd-rows { common-table-template-attlist, empty } +table-even-columns = + element table:even-columns { common-table-template-attlist, empty } +table-odd-columns = + element table:odd-columns { common-table-template-attlist, empty } +common-table-template-attlist = + attribute table:style-name { styleNameRef }, + attribute table:paragraph-style-name { styleNameRef }? +table-background = + element table:background { table-background-attlist, empty } +table-background-attlist = attribute table:style-name { styleNameRef } +style-font-face = + element style:font-face { + style-font-face-attlist, svg-font-face-src?, svg-definition-src? + } +style-font-face-attlist = + attribute svg:font-family { \string }? + & attribute svg:font-style { fontStyle }? + & attribute svg:font-variant { fontVariant }? + & attribute svg:font-weight { fontWeight }? + & attribute svg:font-stretch { + "normal" + | "ultra-condensed" + | "extra-condensed" + | "condensed" + | "semi-condensed" + | "semi-expanded" + | "expanded" + | "extra-expanded" + | "ultra-expanded" + }? + & attribute svg:font-size { positiveLength }? + & attribute svg:unicode-range { \string }? + & attribute svg:units-per-em { integer }? + & attribute svg:panose-1 { \string }? + & attribute svg:stemv { integer }? + & attribute svg:stemh { integer }? + & attribute svg:slope { integer }? + & attribute svg:cap-height { integer }? + & attribute svg:x-height { integer }? + & attribute svg:accent-height { integer }? + & attribute svg:ascent { integer }? + & attribute svg:descent { integer }? + & attribute svg:widths { \string }? + & attribute svg:bbox { \string }? + & attribute svg:ideographic { integer }? + & attribute svg:alphabetic { integer }? + & attribute svg:mathematical { integer }? + & attribute svg:hanging { integer }? + & attribute svg:v-ideographic { integer }? + & attribute svg:v-alphabetic { integer }? + & attribute svg:v-mathematical { integer }? + & attribute svg:v-hanging { integer }? + & attribute svg:underline-position { integer }? + & attribute svg:underline-thickness { integer }? + & attribute svg:strikethrough-position { integer }? + & attribute svg:strikethrough-thickness { integer }? + & attribute svg:overline-position { integer }? + & attribute svg:overline-thickness { integer }? + & attribute style:name { \string } + & attribute style:font-adornments { \string }? + & attribute style:font-family-generic { fontFamilyGeneric }? + & attribute style:font-pitch { fontPitch }? + & attribute style:font-charset { textEncoding }? +svg-font-face-src = + element svg:font-face-src { + (svg-font-face-uri | svg-font-face-name)+ + } +svg-font-face-uri = + element svg:font-face-uri { + common-svg-font-face-xlink-attlist, svg-font-face-format* + } +svg-font-face-format = + element svg:font-face-format { + attribute svg:string { \string }?, + empty + } +svg-font-face-name = + element svg:font-face-name { + attribute svg:name { \string }?, + empty + } +svg-definition-src = + element svg:definition-src { + common-svg-font-face-xlink-attlist, empty + } +common-svg-font-face-xlink-attlist = + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:actuate { "onRequest" }? +number-number-style = + element number:number-style { + common-data-style-attlist, + style-text-properties?, + number-text?, + (any-number, number-text?)?, + style-map* + } +any-number = number-number | number-scientific-number | number-fraction +number-number = + element number:number { + number-number-attlist, + common-decimal-places-attlist, + common-number-attlist, + number-embedded-text* + } +number-number-attlist = + attribute number:decimal-replacement { \string }? + & attribute number:display-factor { double }? +number-embedded-text = + element number:embedded-text { number-embedded-text-attlist, text } +number-embedded-text-attlist = attribute number:position { integer } +number-scientific-number = + element number:scientific-number { + number-scientific-number-attlist, + common-decimal-places-attlist, + common-number-attlist, + empty + } +number-scientific-number-attlist = + attribute number:min-exponent-digits { integer }? +number-fraction = + element number:fraction { + number-fraction-attlist, common-number-attlist, empty + } +number-fraction-attlist = + attribute number:min-numerator-digits { integer }? + & attribute number:min-denominator-digits { integer }? + & attribute number:denominator-value { integer }? +number-currency-style = + element number:currency-style { + common-data-style-attlist, + common-auto-reorder-attlist, + style-text-properties?, + number-text?, + ((number-and-text, currency-symbol-and-text?) + | (currency-symbol-and-text, number-and-text?))?, + style-map* + } +currency-symbol-and-text = number-currency-symbol, number-text? +number-and-text = number-number, number-text? +number-currency-symbol = + element number:currency-symbol { + number-currency-symbol-attlist, text + } +number-currency-symbol-attlist = + attribute number:language { languageCode }?, + attribute number:country { countryCode }?, + attribute number:script { scriptCode }?, + attribute number:rfc-language-tag { language }? +number-percentage-style = + element number:percentage-style { + common-data-style-attlist, + style-text-properties?, + number-text?, + number-and-text?, + style-map* + } +number-date-style = + element number:date-style { + common-data-style-attlist, + common-auto-reorder-attlist, + common-format-source-attlist, + style-text-properties?, + number-text?, + (any-date, number-text?)+, + style-map* + } +any-date = + number-day + | number-month + | number-year + | number-era + | number-day-of-week + | number-week-of-year + | number-quarter + | number-hours + | number-am-pm + | number-minutes + | number-seconds +number-day = + element number:day { + number-day-attlist, common-calendar-attlist, empty + } +number-day-attlist = attribute number:style { "short" | "long" }? +number-month = + element number:month { + number-month-attlist, common-calendar-attlist, empty + } +number-month-attlist = + attribute number:textual { boolean }? + & attribute number:possessive-form { boolean }? + & attribute number:style { "short" | "long" }? +number-year = + element number:year { + number-year-attlist, common-calendar-attlist, empty + } +number-year-attlist = attribute number:style { "short" | "long" }? +number-era = + element number:era { + number-era-attlist, common-calendar-attlist, empty + } +number-era-attlist = attribute number:style { "short" | "long" }? +number-day-of-week = + element number:day-of-week { + number-day-of-week-attlist, common-calendar-attlist, empty + } +number-day-of-week-attlist = + attribute number:style { "short" | "long" }? +number-week-of-year = + element number:week-of-year { common-calendar-attlist, empty } +number-quarter = + element number:quarter { + number-quarter-attlist, common-calendar-attlist, empty + } +number-quarter-attlist = attribute number:style { "short" | "long" }? +number-time-style = + element number:time-style { + number-time-style-attlist, + common-data-style-attlist, + common-format-source-attlist, + style-text-properties?, + number-text?, + (any-time, number-text?)+, + style-map* + } +any-time = number-hours | number-am-pm | number-minutes | number-seconds +number-time-style-attlist = + attribute number:truncate-on-overflow { boolean }? +number-hours = element number:hours { number-hours-attlist, empty } +number-hours-attlist = attribute number:style { "short" | "long" }? +number-minutes = + element number:minutes { number-minutes-attlist, empty } +number-minutes-attlist = attribute number:style { "short" | "long" }? +number-seconds = + element number:seconds { number-seconds-attlist, empty } +number-seconds-attlist = + attribute number:style { "short" | "long" }? + & attribute number:decimal-places { integer }? +number-am-pm = element number:am-pm { empty } +number-boolean-style = + element number:boolean-style { + common-data-style-attlist, + style-text-properties?, + number-text?, + (number-boolean, number-text?)?, + style-map* + } +number-boolean = element number:boolean { empty } +number-text-style = + element number:text-style { + common-data-style-attlist, + style-text-properties?, + number-text?, + (number-text-content, number-text?)*, + style-map* + } +number-text = element number:text { text } +number-text-content = element number:text-content { empty } +common-data-style-attlist = + attribute style:name { styleName } + & attribute style:display-name { \string }? + & attribute number:language { languageCode }? + & attribute number:country { countryCode }? + & attribute number:script { scriptCode }? + & attribute number:rfc-language-tag { language }? + & attribute number:title { \string }? + & attribute style:volatile { boolean }? + & attribute number:transliteration-format { \string }? + & attribute number:transliteration-language { countryCode }? + & attribute number:transliteration-country { countryCode }? + & attribute number:transliteration-style { + "short" | "medium" | "long" + }? +common-auto-reorder-attlist = + attribute number:automatic-order { boolean }? +common-format-source-attlist = + attribute number:format-source { "fixed" | "language" }? +common-decimal-places-attlist = + attribute number:decimal-places { integer }? +common-number-attlist = + attribute number:min-integer-digits { integer }? + & attribute number:grouping { boolean }? +common-calendar-attlist = + attribute number:calendar { + "gregorian" + | "gengou" + | "ROC" + | "hanja_yoil" + | "hanja" + | "hijri" + | "jewish" + | "buddhist" + | \string + }? +style-style-content = + (attribute style:family { "text" }, + style-text-properties?) + | (attribute style:family { "paragraph" }, + style-paragraph-properties?, + style-text-properties?) + | (attribute style:family { "section" }, + style-section-properties?) + | (attribute style:family { "ruby" }, + style-ruby-properties?) + | (attribute style:family { "table" }, + style-table-properties?) + | (attribute style:family { "table-column" }, + style-table-column-properties?) + | (attribute style:family { "table-row" }, + style-table-row-properties?) + | (attribute style:family { "table-cell" }, + style-table-cell-properties?, + style-paragraph-properties?, + style-text-properties?) + | (attribute style:family { "graphic" | "presentation" }, + style-graphic-properties?, + style-paragraph-properties?, + style-text-properties?) + | (attribute style:family { "drawing-page" }, + style-drawing-page-properties?) + | (attribute style:family { "chart" }, + style-chart-properties?, + style-graphic-properties?, + style-paragraph-properties?, + style-text-properties?) +text-linenumbering-configuration = + element text:linenumbering-configuration { + text-linenumbering-configuration-attlist, + text-linenumbering-separator? + } +text-linenumbering-configuration-attlist = + attribute text:number-lines { boolean }? + & common-num-format-attlist? + & attribute text:style-name { styleNameRef }? + & attribute text:increment { nonNegativeInteger }? + & attribute text:number-position { + "left" | "right" | "inner" | "outer" + }? + & attribute text:offset { nonNegativeLength }? + & attribute text:count-empty-lines { boolean }? + & attribute text:count-in-text-boxes { boolean }? + & attribute text:restart-on-page { boolean }? +text-linenumbering-separator = + element text:linenumbering-separator { + attribute text:increment { nonNegativeInteger }?, + text + } +text-notes-configuration = + element text:notes-configuration { text-notes-configuration-content } +text-notes-configuration-content = + text-note-class + & attribute text:citation-style-name { styleNameRef }? + & attribute text:citation-body-style-name { styleNameRef }? + & attribute text:default-style-name { styleNameRef }? + & attribute text:master-page-name { styleNameRef }? + & attribute text:start-value { nonNegativeInteger }? + & common-num-format-prefix-suffix-attlist + & common-num-format-attlist? + & attribute text:start-numbering-at { + "document" | "chapter" | "page" + }? + & attribute text:footnotes-position { + "text" | "page" | "section" | "document" + }? + & element text:note-continuation-notice-forward { text }? + & element text:note-continuation-notice-backward { text }? +text-bibliography-configuration = + element text:bibliography-configuration { + text-bibliography-configuration-attlist, text-sort-key* + } +text-bibliography-configuration-attlist = + attribute text:prefix { \string }? + & attribute text:suffix { \string }? + & attribute text:numbered-entries { boolean }? + & attribute text:sort-by-position { boolean }? + & attribute fo:language { languageCode }? + & attribute fo:country { countryCode }? + & attribute fo:script { scriptCode }? + & attribute style:rfc-language-tag { language }? + & attribute text:sort-algorithm { \string }? +text-sort-key = element text:sort-key { text-sort-key-attlist, empty } +text-sort-key-attlist = + attribute text:key { + "address" + | "annote" + | "author" + | "bibliography-type" + | "booktitle" + | "chapter" + | "custom1" + | "custom2" + | "custom3" + | "custom4" + | "custom5" + | "edition" + | "editor" + | "howpublished" + | "identifier" + | "institution" + | "isbn" + | "issn" + | "journal" + | "month" + | "note" + | "number" + | "organizations" + | "pages" + | "publisher" + | "report-type" + | "school" + | "series" + | "title" + | "url" + | "volume" + | "year" + }, + attribute text:sort-ascending { boolean }? +text-list-style = + element text:list-style { + text-list-style-attr, text-list-style-content* + } +text-list-style-attr = + attribute style:name { styleName } + & attribute style:display-name { \string }? + & attribute text:consecutive-numbering { boolean }? +text-list-style-content = + element text:list-level-style-number { + text-list-level-style-attr, + text-list-level-style-number-attr, + style-list-level-properties?, + style-text-properties? + } + | element text:list-level-style-bullet { + text-list-level-style-attr, + text-list-level-style-bullet-attr, + style-list-level-properties?, + style-text-properties? + } + | element text:list-level-style-image { + text-list-level-style-attr, + text-list-level-style-image-attr, + style-list-level-properties? + } +text-list-level-style-number-attr = + attribute text:style-name { styleNameRef }? + & common-num-format-attlist + & common-num-format-prefix-suffix-attlist + & attribute text:display-levels { positiveInteger }? + & attribute text:start-value { positiveInteger }? +text-list-level-style-bullet-attr = + attribute text:style-name { styleNameRef }? + & attribute text:bullet-char { character } + & common-num-format-prefix-suffix-attlist + & attribute text:bullet-relative-size { percent }? +text-list-level-style-image-attr = + common-draw-data-attlist | office-binary-data +text-list-level-style-attr = attribute text:level { positiveInteger } +text-outline-style = + element text:outline-style { + text-outline-style-attr, text-outline-level-style+ + } +text-outline-style-attr = attribute style:name { styleName } +text-outline-level-style = + element text:outline-level-style { + text-outline-level-style-attlist, + style-list-level-properties?, + style-text-properties? + } +text-outline-level-style-attlist = + attribute text:level { positiveInteger } + & attribute text:style-name { styleNameRef }? + & common-num-format-attlist + & common-num-format-prefix-suffix-attlist + & attribute text:display-levels { positiveInteger }? + & attribute text:start-value { positiveInteger }? +style-graphic-properties = + element style:graphic-properties { + style-graphic-properties-content-strict + } +style-graphic-properties-content-strict = + style-graphic-properties-attlist, + style-graphic-fill-properties-attlist, + style-graphic-properties-elements +style-drawing-page-properties = + element style:drawing-page-properties { + style-drawing-page-properties-content-strict + } +style-drawing-page-properties-content-strict = + style-graphic-fill-properties-attlist, + style-drawing-page-properties-attlist, + style-drawing-page-properties-elements +draw-gradient = + element draw:gradient { + common-draw-gradient-attlist, draw-gradient-attlist, empty + } +common-draw-gradient-attlist = + attribute draw:name { styleName }? + & attribute draw:display-name { \string }? + & attribute draw:style { gradient-style } + & attribute draw:cx { percent }? + & attribute draw:cy { percent }? + & attribute draw:angle { angle }? + & attribute draw:border { percent }? +gradient-style = + "linear" | "axial" | "radial" | "ellipsoid" | "square" | "rectangular" +draw-gradient-attlist = + attribute draw:start-color { color }? + & attribute draw:end-color { color }? + & attribute draw:start-intensity { zeroToHundredPercent }? + & attribute draw:end-intensity { zeroToHundredPercent }? +svg-linearGradient = + element svg:linearGradient { + common-svg-gradient-attlist, + attribute svg:x1 { coordinate | percent }?, + attribute svg:y1 { coordinate | percent }?, + attribute svg:x2 { coordinate | percent }?, + attribute svg:y2 { coordinate | percent }?, + svg-stop* + } +svg-radialGradient = + element svg:radialGradient { + common-svg-gradient-attlist, + attribute svg:cx { coordinate | percent }?, + attribute svg:cy { coordinate | percent }?, + attribute svg:r { coordinate | percent }?, + attribute svg:fx { coordinate | percent }?, + attribute svg:fy { coordinate | percent }?, + svg-stop* + } +svg-stop = + element svg:stop { + attribute svg:offset { double | percent }, + attribute svg:stop-color { color }?, + attribute svg:stop-opacity { double }? + } +common-svg-gradient-attlist = + attribute svg:gradientUnits { "objectBoundingBox" }? + & attribute svg:gradientTransform { \string }? + & attribute svg:spreadMethod { "pad" | "reflect" | "repeat" }? + & attribute draw:name { styleName } + & attribute draw:display-name { \string }? +draw-hatch = element draw:hatch { draw-hatch-attlist, empty } +draw-hatch-attlist = + attribute draw:name { styleName } + & attribute draw:display-name { \string }? + & attribute draw:style { "single" | "double" | "triple" } + & attribute draw:color { color }? + & attribute draw:distance { length }? + & attribute draw:rotation { angle }? +draw-fill-image = + element draw:fill-image { + draw-fill-image-attlist, + attribute xlink:type { "simple" }, + attribute xlink:href { anyIRI }, + attribute xlink:show { "embed" }?, + attribute xlink:actuate { "onLoad" }?, + empty + } +draw-fill-image-attlist = + attribute draw:name { styleName } + & attribute draw:display-name { \string }? + & attribute svg:width { length }? + & attribute svg:height { length }? +draw-opacity = + element draw:opacity { + common-draw-gradient-attlist, draw-opacity-attlist, empty + } +draw-opacity-attlist = + attribute draw:start { zeroToHundredPercent }?, + attribute draw:end { zeroToHundredPercent }? +draw-marker = + element draw:marker { + draw-marker-attlist, + common-draw-viewbox-attlist, + common-draw-path-data-attlist, + empty + } +draw-marker-attlist = + attribute draw:name { styleName } + & attribute draw:display-name { \string }? +draw-stroke-dash = + element draw:stroke-dash { draw-stroke-dash-attlist, empty } +draw-stroke-dash-attlist = + attribute draw:name { styleName } + & attribute draw:display-name { \string }? + & attribute draw:style { "rect" | "round" }? + & attribute draw:dots1 { integer }? + & attribute draw:dots1-length { length | percent }? + & attribute draw:dots2 { integer }? + & attribute draw:dots2-length { length | percent }? + & attribute draw:distance { length | percent }? +style-presentation-page-layout = + element style:presentation-page-layout { + attribute style:name { styleName }, + attribute style:display-name { \string }?, + presentation-placeholder* + } +presentation-placeholder = + element presentation:placeholder { + attribute presentation:object { presentation-classes }, + attribute svg:x { coordinate | percent }, + attribute svg:y { coordinate | percent }, + attribute svg:width { length | percent }, + attribute svg:height { length | percent }, + empty + } +style-page-layout-properties = + element style:page-layout-properties { + style-page-layout-properties-content-strict + } +style-page-layout-properties-content-strict = + style-page-layout-properties-attlist, + style-page-layout-properties-elements +style-page-layout-properties-attlist = + attribute fo:page-width { length }? + & attribute fo:page-height { length }? + & common-num-format-attlist? + & common-num-format-prefix-suffix-attlist + & attribute style:paper-tray-name { "default" | \string }? + & attribute style:print-orientation { "portrait" | "landscape" }? + & common-horizontal-margin-attlist + & common-vertical-margin-attlist + & common-margin-attlist + & common-border-attlist + & common-border-line-width-attlist + & common-padding-attlist + & common-shadow-attlist + & common-background-color-attlist + & attribute style:register-truth-ref-style-name { styleNameRef }? + & attribute style:print { + list { + ("headers" + | "grid" + | "annotations" + | "objects" + | "charts" + | "drawings" + | "formulas" + | "zero-values")* + } + }? + & attribute style:print-page-order { "ttb" | "ltr" }? + & attribute style:first-page-number { positiveInteger | "continue" }? + & attribute style:scale-to { percent }? + & attribute style:scale-to-pages { positiveInteger }? + & attribute style:table-centering { + "horizontal" | "vertical" | "both" | "none" + }? + & attribute style:footnote-max-height { length }? + & common-writing-mode-attlist + & attribute style:layout-grid-mode { "none" | "line" | "both" }? + & attribute style:layout-grid-standard-mode { boolean }? + & attribute style:layout-grid-base-height { length }? + & attribute style:layout-grid-ruby-height { length }? + & attribute style:layout-grid-lines { positiveInteger }? + & attribute style:layout-grid-base-width { length }? + & attribute style:layout-grid-color { color }? + & attribute style:layout-grid-ruby-below { boolean }? + & attribute style:layout-grid-print { boolean }? + & attribute style:layout-grid-display { boolean }? + & attribute style:layout-grid-snap-to { boolean }? +style-page-layout-properties-elements = + style-background-image & style-columns & style-footnote-sep +style-footnote-sep = + element style:footnote-sep { style-footnote-sep-attlist, empty }? +style-footnote-sep-attlist = + attribute style:width { length }?, + attribute style:rel-width { percent }?, + attribute style:color { color }?, + attribute style:line-style { lineStyle }?, + attribute style:adjustment { "left" | "center" | "right" }?, + attribute style:distance-before-sep { length }?, + attribute style:distance-after-sep { length }? +style-header-footer-properties = + element style:header-footer-properties { + style-header-footer-properties-content-strict + } +style-header-footer-properties-content-strict = + style-header-footer-properties-attlist, + style-header-footer-properties-elements +style-header-footer-properties-attlist = + attribute svg:height { length }? + & attribute fo:min-height { length }? + & common-horizontal-margin-attlist + & common-vertical-margin-attlist + & common-margin-attlist + & common-border-attlist + & common-border-line-width-attlist + & common-padding-attlist + & common-background-color-attlist + & common-shadow-attlist + & attribute style:dynamic-spacing { boolean }? +style-header-footer-properties-elements = style-background-image +style-text-properties = + element style:text-properties { style-text-properties-content-strict } +style-text-properties-content-strict = + style-text-properties-attlist, style-text-properties-elements +style-text-properties-elements = empty +style-text-properties-attlist = + attribute fo:font-variant { fontVariant }? + & attribute fo:text-transform { + "none" | "lowercase" | "uppercase" | "capitalize" + }? + & attribute fo:color { color }? + & attribute style:use-window-font-color { boolean }? + & attribute style:text-outline { boolean }? + & attribute style:text-line-through-type { lineType }? + & attribute style:text-line-through-style { lineStyle }? + & attribute style:text-line-through-width { lineWidth }? + & attribute style:text-line-through-color { "font-color" | color }? + & attribute style:text-line-through-text { \string }? + & attribute style:text-line-through-text-style { styleNameRef }? + & attribute style:text-position { + list { (percent | "super" | "sub"), percent? } + }? + & attribute style:font-name { \string }? + & attribute style:font-name-asian { \string }? + & attribute style:font-name-complex { \string }? + & attribute fo:font-family { \string }? + & attribute style:font-family-asian { \string }? + & attribute style:font-family-complex { \string }? + & attribute style:font-family-generic { fontFamilyGeneric }? + & attribute style:font-family-generic-asian { fontFamilyGeneric }? + & attribute style:font-family-generic-complex { fontFamilyGeneric }? + & attribute style:font-style-name { \string }? + & attribute style:font-style-name-asian { \string }? + & attribute style:font-style-name-complex { \string }? + & attribute style:font-pitch { fontPitch }? + & attribute style:font-pitch-asian { fontPitch }? + & attribute style:font-pitch-complex { fontPitch }? + & attribute style:font-charset { textEncoding }? + & attribute style:font-charset-asian { textEncoding }? + & attribute style:font-charset-complex { textEncoding }? + & attribute fo:font-size { positiveLength | percent }? + & attribute style:font-size-asian { positiveLength | percent }? + & attribute style:font-size-complex { positiveLength | percent }? + & attribute style:font-size-rel { length }? + & attribute style:font-size-rel-asian { length }? + & attribute style:font-size-rel-complex { length }? + & attribute style:script-type { + "latin" | "asian" | "complex" | "ignore" + }? + & attribute fo:letter-spacing { length | "normal" }? + & attribute fo:language { languageCode }? + & attribute style:language-asian { languageCode }? + & attribute style:language-complex { languageCode }? + & attribute fo:country { countryCode }? + & attribute style:country-asian { countryCode }? + & attribute style:country-complex { countryCode }? + & attribute fo:script { scriptCode }? + & attribute style:script-asian { scriptCode }? + & attribute style:script-complex { scriptCode }? + & attribute style:rfc-language-tag { language }? + & attribute style:rfc-language-tag-asian { language }? + & attribute style:rfc-language-tag-complex { language }? + & attribute fo:font-style { fontStyle }? + & attribute style:font-style-asian { fontStyle }? + & attribute style:font-style-complex { fontStyle }? + & attribute style:font-relief { "none" | "embossed" | "engraved" }? + & attribute fo:text-shadow { shadowType }? + & attribute style:text-underline-type { lineType }? + & attribute style:text-underline-style { lineStyle }? + & attribute style:text-underline-width { lineWidth }? + & attribute style:text-underline-color { "font-color" | color }? + & attribute style:text-overline-type { lineType }? + & attribute style:text-overline-style { lineStyle }? + & attribute style:text-overline-width { lineWidth }? + & attribute style:text-overline-color { "font-color" | color }? + & attribute style:text-overline-mode { lineMode }? + & attribute fo:font-weight { fontWeight }? + & attribute style:font-weight-asian { fontWeight }? + & attribute style:font-weight-complex { fontWeight }? + & attribute style:text-underline-mode { lineMode }? + & attribute style:text-line-through-mode { lineMode }? + & attribute style:letter-kerning { boolean }? + & attribute style:text-blinking { boolean }? + & common-background-color-attlist + & attribute style:text-combine { "none" | "letters" | "lines" }? + & attribute style:text-combine-start-char { character }? + & attribute style:text-combine-end-char { character }? + & attribute style:text-emphasize { + "none" + | list { + ("none" | "accent" | "dot" | "circle" | "disc"), + ("above" | "below") + } + }? + & attribute style:text-scale { percent }? + & attribute style:text-rotation-angle { angle }? + & attribute style:text-rotation-scale { "fixed" | "line-height" }? + & attribute fo:hyphenate { boolean }? + & attribute fo:hyphenation-remain-char-count { positiveInteger }? + & attribute fo:hyphenation-push-char-count { positiveInteger }? + & (attribute text:display { "true" } + | attribute text:display { "none" } + | (attribute text:display { "condition" }, + attribute text:condition { "none" }) + | empty) +fontVariant = "normal" | "small-caps" +fontFamilyGeneric = + "roman" | "swiss" | "modern" | "decorative" | "script" | "system" +fontPitch = "fixed" | "variable" +textEncoding = xsd:string { pattern = "[A-Za-z][A-Za-z0-9._\-]*" } +fontStyle = "normal" | "italic" | "oblique" +shadowType = "none" | \string +lineType = "none" | "single" | "double" +lineStyle = + "none" + | "solid" + | "dotted" + | "dash" + | "long-dash" + | "dot-dash" + | "dot-dot-dash" + | "wave" +lineWidth = + "auto" + | "normal" + | "bold" + | "thin" + | "medium" + | "thick" + | positiveInteger + | percent + | positiveLength +fontWeight = + "normal" + | "bold" + | "100" + | "200" + | "300" + | "400" + | "500" + | "600" + | "700" + | "800" + | "900" +lineMode = "continuous" | "skip-white-space" +style-paragraph-properties = + element style:paragraph-properties { + style-paragraph-properties-content-strict + } +style-paragraph-properties-content-strict = + style-paragraph-properties-attlist, + style-paragraph-properties-elements +style-paragraph-properties-attlist = + attribute fo:line-height { "normal" | nonNegativeLength | percent }? + & attribute style:line-height-at-least { nonNegativeLength }? + & attribute style:line-spacing { length }? + & attribute style:font-independent-line-spacing { boolean }? + & common-text-align + & attribute fo:text-align-last { "start" | "center" | "justify" }? + & attribute style:justify-single-word { boolean }? + & attribute fo:keep-together { "auto" | "always" }? + & attribute fo:widows { nonNegativeInteger }? + & attribute fo:orphans { nonNegativeInteger }? + & attribute style:tab-stop-distance { nonNegativeLength }? + & attribute fo:hyphenation-keep { "auto" | "page" }? + & attribute fo:hyphenation-ladder-count { + "no-limit" | positiveInteger + }? + & attribute style:register-true { boolean }? + & common-horizontal-margin-attlist + & attribute fo:text-indent { length | percent }? + & attribute style:auto-text-indent { boolean }? + & common-vertical-margin-attlist + & common-margin-attlist + & common-break-attlist + & common-background-color-attlist + & common-border-attlist + & common-border-line-width-attlist + & attribute style:join-border { boolean }? + & common-padding-attlist + & common-shadow-attlist + & common-keep-with-next-attlist + & attribute text:number-lines { boolean }? + & attribute text:line-number { nonNegativeInteger }? + & attribute style:text-autospace { "none" | "ideograph-alpha" }? + & attribute style:punctuation-wrap { "simple" | "hanging" }? + & attribute style:line-break { "normal" | "strict" }? + & attribute style:vertical-align { + "top" | "middle" | "bottom" | "auto" | "baseline" + }? + & common-writing-mode-attlist + & attribute style:writing-mode-automatic { boolean }? + & attribute style:snap-to-layout-grid { boolean }? + & common-page-number-attlist + & common-background-transparency-attlist +common-text-align = + attribute fo:text-align { + "start" | "end" | "left" | "right" | "center" | "justify" + }? +style-paragraph-properties-elements = + style-tab-stops & style-drop-cap & style-background-image +style-tab-stops = element style:tab-stops { style-tab-stop* }? +style-tab-stop = + element style:tab-stop { style-tab-stop-attlist, empty } +style-tab-stop-attlist = + attribute style:position { length } + & (attribute style:type { "left" | "center" | "right" }? + | (attribute style:type { "char" }, + style-tab-stop-char-attlist)) + & attribute style:leader-type { lineType }? + & attribute style:leader-style { lineStyle }? + & attribute style:leader-width { lineWidth }? + & attribute style:leader-color { "font-color" | color }? + & attribute style:leader-text { character }? + & attribute style:leader-text-style { styleNameRef }? +style-tab-stop-char-attlist = attribute style:char { character } +style-drop-cap = + element style:drop-cap { style-drop-cap-attlist, empty }? +style-drop-cap-attlist = + attribute style:length { "word" | positiveInteger }? + & attribute style:lines { positiveInteger }? + & attribute style:distance { length }? + & attribute style:style-name { styleNameRef }? +common-horizontal-margin-attlist = + attribute fo:margin-left { length | percent }?, + attribute fo:margin-right { length | percent }? +common-vertical-margin-attlist = + attribute fo:margin-top { nonNegativeLength | percent }?, + attribute fo:margin-bottom { nonNegativeLength | percent }? +common-margin-attlist = + attribute fo:margin { nonNegativeLength | percent }? +common-break-attlist = + attribute fo:break-before { "auto" | "column" | "page" }?, + attribute fo:break-after { "auto" | "column" | "page" }? +common-background-color-attlist = + attribute fo:background-color { "transparent" | color }? +style-background-image = + element style:background-image { + style-background-image-attlist, + (common-draw-data-attlist | office-binary-data | empty) + }? +style-background-image-attlist = + attribute style:repeat { "no-repeat" | "repeat" | "stretch" }? + & attribute style:position { + "left" + | "center" + | "right" + | "top" + | "bottom" + | list { horiBackPos, vertBackPos } + | list { vertBackPos, horiBackPos } + }? + & attribute style:filter-name { \string }? + & attribute draw:opacity { zeroToHundredPercent }? +horiBackPos = "left" | "center" | "right" +vertBackPos = "top" | "center" | "bottom" +common-border-attlist = + attribute fo:border { \string }?, + attribute fo:border-top { \string }?, + attribute fo:border-bottom { \string }?, + attribute fo:border-left { \string }?, + attribute fo:border-right { \string }? +common-border-line-width-attlist = + attribute style:border-line-width { borderWidths }?, + attribute style:border-line-width-top { borderWidths }?, + attribute style:border-line-width-bottom { borderWidths }?, + attribute style:border-line-width-left { borderWidths }?, + attribute style:border-line-width-right { borderWidths }? +borderWidths = list { positiveLength, positiveLength, positiveLength } +common-padding-attlist = + attribute fo:padding { nonNegativeLength }?, + attribute fo:padding-top { nonNegativeLength }?, + attribute fo:padding-bottom { nonNegativeLength }?, + attribute fo:padding-left { nonNegativeLength }?, + attribute fo:padding-right { nonNegativeLength }? +common-shadow-attlist = attribute style:shadow { shadowType }? +common-keep-with-next-attlist = + attribute fo:keep-with-next { "auto" | "always" }? +common-writing-mode-attlist = + attribute style:writing-mode { + "lr-tb" | "rl-tb" | "tb-rl" | "tb-lr" | "lr" | "rl" | "tb" | "page" + }? +common-page-number-attlist = + attribute style:page-number { positiveInteger | "auto" }? +common-background-transparency-attlist = + attribute style:background-transparency { zeroToHundredPercent }? +style-ruby-properties = + element style:ruby-properties { style-ruby-properties-content-strict } +style-ruby-properties-content-strict = + style-ruby-properties-attlist, style-ruby-properties-elements +style-ruby-properties-elements = empty +style-ruby-properties-attlist = + attribute style:ruby-position { "above" | "below" }? + & attribute style:ruby-align { + "left" + | "center" + | "right" + | "distribute-letter" + | "distribute-space" + }? +style-section-properties = + element style:section-properties { + style-section-properties-content-strict + } +style-section-properties-content-strict = + style-section-properties-attlist, style-section-properties-elements +style-section-properties-attlist = + common-background-color-attlist + & common-horizontal-margin-attlist + & attribute style:protect { boolean }? + & common-editable-attlist + & attribute text:dont-balance-text-columns { boolean }? + & common-writing-mode-attlist +style-section-properties-elements = + style-background-image & style-columns & text-notes-configuration* +style-columns = + element style:columns { + style-columns-attlist, style-column-sep?, style-column* + }? +style-columns-attlist = + attribute fo:column-count { positiveInteger } + & attribute fo:column-gap { length }? +style-column = element style:column { style-column-attlist } +style-column-attlist = + attribute style:rel-width { relativeLength } + & attribute fo:start-indent { length }? + & attribute fo:end-indent { length }? + & attribute fo:space-before { length }? + & attribute fo:space-after { length }? +style-column-sep = element style:column-sep { style-column-sep-attlist } +style-column-sep-attlist = + attribute style:style { + "none" | "solid" | "dotted" | "dashed" | "dot-dashed" + }? + & attribute style:width { length } + & attribute style:height { zeroToHundredPercent }? + & attribute style:vertical-align { "top" | "middle" | "bottom" }? + & attribute style:color { color }? +style-table-properties = + element style:table-properties { + style-table-properties-content-strict + } +style-table-properties-content-strict = + style-table-properties-attlist, style-table-properties-elements +style-table-properties-attlist = + attribute style:width { positiveLength }? + & attribute style:rel-width { percent }? + & attribute table:align { "left" | "center" | "right" | "margins" }? + & common-horizontal-margin-attlist + & common-vertical-margin-attlist + & common-margin-attlist + & common-page-number-attlist + & common-break-attlist + & common-background-color-attlist + & common-shadow-attlist + & common-keep-with-next-attlist + & attribute style:may-break-between-rows { boolean }? + & attribute table:border-model { "collapsing" | "separating" }? + & common-writing-mode-attlist + & attribute table:display { boolean }? +style-table-properties-elements = style-background-image +style-table-column-properties = + element style:table-column-properties { + style-table-column-properties-content-strict + } +style-table-column-properties-content-strict = + style-table-column-properties-attlist, + style-table-column-properties-elements +style-table-column-properties-elements = empty +style-table-column-properties-attlist = + attribute style:column-width { positiveLength }? + & attribute style:rel-column-width { relativeLength }? + & attribute style:use-optimal-column-width { boolean }? + & common-break-attlist +style-table-row-properties = + element style:table-row-properties { + style-table-row-properties-content-strict + } +style-table-row-properties-content-strict = + style-table-row-properties-attlist, + style-table-row-properties-elements +style-table-row-properties-attlist = + attribute style:row-height { positiveLength }? + & attribute style:min-row-height { nonNegativeLength }? + & attribute style:use-optimal-row-height { boolean }? + & common-background-color-attlist + & common-break-attlist + & attribute fo:keep-together { "auto" | "always" }? +style-table-row-properties-elements = style-background-image +style-table-cell-properties = + element style:table-cell-properties { + style-table-cell-properties-content-strict + } +style-table-cell-properties-content-strict = + style-table-cell-properties-attlist, + style-table-cell-properties-elements +style-table-cell-properties-attlist = + attribute style:vertical-align { + "top" | "middle" | "bottom" | "automatic" + }? + & attribute style:text-align-source { "fix" | "value-type" }? + & common-style-direction-attlist + & attribute style:glyph-orientation-vertical { + "auto" | "0" | "0deg" | "0rad" | "0grad" + }? + & common-writing-mode-attlist + & common-shadow-attlist + & common-background-color-attlist + & common-border-attlist + & attribute style:diagonal-tl-br { \string }? + & attribute style:diagonal-tl-br-widths { borderWidths }? + & attribute style:diagonal-bl-tr { \string }? + & attribute style:diagonal-bl-tr-widths { borderWidths }? + & common-border-line-width-attlist + & common-padding-attlist + & attribute fo:wrap-option { "no-wrap" | "wrap" }? + & common-rotation-angle-attlist + & attribute style:rotation-align { + "none" | "bottom" | "top" | "center" + }? + & attribute style:cell-protect { + "none" + | "hidden-and-protected" + | list { ("protected" | "formula-hidden")+ } + }? + & attribute style:print-content { boolean }? + & attribute style:decimal-places { nonNegativeInteger }? + & attribute style:repeat-content { boolean }? + & attribute style:shrink-to-fit { boolean }? +common-style-direction-attlist = + attribute style:direction { "ltr" | "ttb" }? +style-table-cell-properties-elements = style-background-image +common-rotation-angle-attlist = + attribute style:rotation-angle { angle }? +style-list-level-properties = + element style:list-level-properties { + style-list-level-properties-content-strict + } +style-list-level-properties-content-strict = + style-list-level-properties-attlist, + style-list-level-properties-elements +style-list-level-properties-attlist = + common-text-align + & attribute text:space-before { length }? + & attribute text:min-label-width { nonNegativeLength }? + & attribute text:min-label-distance { nonNegativeLength }? + & attribute style:font-name { \string }? + & attribute fo:width { positiveLength }? + & attribute fo:height { positiveLength }? + & common-vertical-rel-attlist + & common-vertical-pos-attlist + & attribute text:list-level-position-and-space-mode { + "label-width-and-position" | "label-alignment" + }? +style-list-level-properties-elements = style-list-level-label-alignment +style-list-level-label-alignment = + element style:list-level-label-alignment { + style-list-level-label-alignment-attlist, empty + }? +style-list-level-label-alignment-attlist = + attribute text:label-followed-by { "listtab" | "space" | "nothing" } + & attribute text:list-tab-stop-position { length }? + & attribute fo:text-indent { length }? + & attribute fo:margin-left { length }? +style-graphic-properties-attlist = + attribute draw:stroke { "none" | "dash" | "solid" }? + & attribute draw:stroke-dash { styleNameRef }? + & attribute draw:stroke-dash-names { styleNameRefs }? + & attribute svg:stroke-width { length }? + & attribute svg:stroke-color { color }? + & attribute draw:marker-start { styleNameRef }? + & attribute draw:marker-end { styleNameRef }? + & attribute draw:marker-start-width { length }? + & attribute draw:marker-end-width { length }? + & attribute draw:marker-start-center { boolean }? + & attribute draw:marker-end-center { boolean }? + & attribute svg:stroke-opacity { + xsd:double { minInclusive = "0" maxInclusive = "1" } + | zeroToHundredPercent + }? + & attribute draw:stroke-linejoin { + "miter" | "round" | "bevel" | "middle" | "none" + }? + & attribute svg:stroke-linecap { "butt" | "square" | "round" }? + & attribute draw:symbol-color { color }? + & attribute text:animation { + "none" | "scroll" | "alternate" | "slide" + }? + & attribute text:animation-direction { + "left" | "right" | "up" | "down" + }? + & attribute text:animation-start-inside { boolean }? + & attribute text:animation-stop-inside { boolean }? + & attribute text:animation-repeat { nonNegativeInteger }? + & attribute text:animation-delay { duration }? + & attribute text:animation-steps { length }? + & attribute draw:auto-grow-width { boolean }? + & attribute draw:auto-grow-height { boolean }? + & attribute draw:fit-to-size { boolean }? + & attribute draw:fit-to-contour { boolean }? + & attribute draw:textarea-vertical-align { + "top" | "middle" | "bottom" | "justify" + }? + & attribute draw:textarea-horizontal-align { + "left" | "center" | "right" | "justify" + }? + & attribute fo:wrap-option { "no-wrap" | "wrap" }? + & attribute style:shrink-to-fit { boolean }? + & attribute draw:color-mode { + "greyscale" | "mono" | "watermark" | "standard" + }? + & attribute draw:color-inversion { boolean }? + & attribute draw:luminance { zeroToHundredPercent }? + & attribute draw:contrast { percent }? + & attribute draw:gamma { percent }? + & attribute draw:red { signedZeroToHundredPercent }? + & attribute draw:green { signedZeroToHundredPercent }? + & attribute draw:blue { signedZeroToHundredPercent }? + & attribute draw:image-opacity { zeroToHundredPercent }? + & attribute draw:shadow { "visible" | "hidden" }? + & attribute draw:shadow-offset-x { length }? + & attribute draw:shadow-offset-y { length }? + & attribute draw:shadow-color { color }? + & attribute draw:shadow-opacity { zeroToHundredPercent }? + & attribute draw:start-line-spacing-horizontal { distance }? + & attribute draw:start-line-spacing-vertical { distance }? + & attribute draw:end-line-spacing-horizontal { distance }? + & attribute draw:end-line-spacing-vertical { distance }? + & attribute draw:line-distance { distance }? + & attribute draw:guide-overhang { length }? + & attribute draw:guide-distance { distance }? + & attribute draw:start-guide { length }? + & attribute draw:end-guide { length }? + & attribute draw:placing { "below" | "above" }? + & attribute draw:parallel { boolean }? + & attribute draw:measure-align { + "automatic" | "left-outside" | "inside" | "right-outside" + }? + & attribute draw:measure-vertical-align { + "automatic" | "above" | "below" | "center" + }? + & attribute draw:unit { + "automatic" + | "mm" + | "cm" + | "m" + | "km" + | "pt" + | "pc" + | "inch" + | "ft" + | "mi" + }? + & attribute draw:show-unit { boolean }? + & attribute draw:decimal-places { nonNegativeInteger }? + & attribute draw:caption-type { + "straight-line" | "angled-line" | "angled-connector-line" + }? + & attribute draw:caption-angle-type { "fixed" | "free" }? + & attribute draw:caption-angle { angle }? + & attribute draw:caption-gap { distance }? + & attribute draw:caption-escape-direction { + "horizontal" | "vertical" | "auto" + }? + & attribute draw:caption-escape { length | percent }? + & attribute draw:caption-line-length { length }? + & attribute draw:caption-fit-line-length { boolean }? + & attribute dr3d:horizontal-segments { nonNegativeInteger }? + & attribute dr3d:vertical-segments { nonNegativeInteger }? + & attribute dr3d:edge-rounding { percent }? + & attribute dr3d:edge-rounding-mode { "correct" | "attractive" }? + & attribute dr3d:back-scale { percent }? + & attribute dr3d:depth { length }? + & attribute dr3d:backface-culling { "enabled" | "disabled" }? + & attribute dr3d:end-angle { angle }? + & attribute dr3d:close-front { boolean }? + & attribute dr3d:close-back { boolean }? + & attribute dr3d:lighting-mode { "standard" | "double-sided" }? + & attribute dr3d:normals-kind { "object" | "flat" | "sphere" }? + & attribute dr3d:normals-direction { "normal" | "inverse" }? + & attribute dr3d:texture-generation-mode-x { + "object" | "parallel" | "sphere" + }? + & attribute dr3d:texture-generation-mode-y { + "object" | "parallel" | "sphere" + }? + & attribute dr3d:texture-kind { "luminance" | "intensity" | "color" }? + & attribute dr3d:texture-filter { "enabled" | "disabled" }? + & attribute dr3d:texture-mode { "replace" | "modulate" | "blend" }? + & attribute dr3d:ambient-color { color }? + & attribute dr3d:emissive-color { color }? + & attribute dr3d:specular-color { color }? + & attribute dr3d:diffuse-color { color }? + & attribute dr3d:shininess { percent }? + & attribute dr3d:shadow { "visible" | "hidden" }? + & common-draw-rel-size-attlist + & attribute fo:min-width { length | percent }? + & attribute fo:min-height { length | percent }? + & attribute fo:max-height { length | percent }? + & attribute fo:max-width { length | percent }? + & common-horizontal-margin-attlist + & common-vertical-margin-attlist + & common-margin-attlist + & attribute style:print-content { boolean }? + & attribute style:protect { + "none" + | list { ("content" | "position" | "size")+ } + }? + & attribute style:horizontal-pos { + "left" + | "center" + | "right" + | "from-left" + | "inside" + | "outside" + | "from-inside" + }? + & attribute svg:x { coordinate }? + & attribute style:horizontal-rel { + "page" + | "page-content" + | "page-start-margin" + | "page-end-margin" + | "frame" + | "frame-content" + | "frame-start-margin" + | "frame-end-margin" + | "paragraph" + | "paragraph-content" + | "paragraph-start-margin" + | "paragraph-end-margin" + | "char" + }? + & common-vertical-pos-attlist + & common-vertical-rel-attlist + & common-text-anchor-attlist + & common-border-attlist + & common-border-line-width-attlist + & common-padding-attlist + & common-shadow-attlist + & common-background-color-attlist + & common-background-transparency-attlist + & common-editable-attlist + & attribute style:wrap { + "none" + | "left" + | "right" + | "parallel" + | "dynamic" + | "run-through" + | "biggest" + }? + & attribute style:wrap-dynamic-threshold { nonNegativeLength }? + & attribute style:number-wrapped-paragraphs { + "no-limit" | positiveInteger + }? + & attribute style:wrap-contour { boolean }? + & attribute style:wrap-contour-mode { "full" | "outside" }? + & attribute style:run-through { "foreground" | "background" }? + & attribute style:flow-with-text { boolean }? + & attribute style:overflow-behavior { + "clip" | "auto-create-new-frame" + }? + & attribute style:mirror { + "none" + | "vertical" + | horizontal-mirror + | list { "vertical", horizontal-mirror } + | list { horizontal-mirror, "vertical" } + }? + & attribute fo:clip { "auto" | clipShape }? + & attribute draw:wrap-influence-on-position { + "iterative" | "once-concurrent" | "once-successive" + }? + & common-writing-mode-attlist + & attribute draw:frame-display-scrollbar { boolean }? + & attribute draw:frame-display-border { boolean }? + & attribute draw:frame-margin-horizontal { nonNegativePixelLength }? + & attribute draw:frame-margin-vertical { nonNegativePixelLength }? + & attribute draw:visible-area-left { nonNegativeLength }? + & attribute draw:visible-area-top { nonNegativeLength }? + & attribute draw:visible-area-width { positiveLength }? + & attribute draw:visible-area-height { positiveLength }? + & attribute draw:draw-aspect { + "content" | "thumbnail" | "icon" | "print-view" + }? + & attribute draw:ole-draw-aspect { nonNegativeInteger }? +style-graphic-fill-properties-attlist = + attribute draw:fill { + "none" | "solid" | "bitmap" | "gradient" | "hatch" + }? + & attribute draw:fill-color { color }? + & attribute draw:secondary-fill-color { color }? + & attribute draw:fill-gradient-name { styleNameRef }? + & attribute draw:gradient-step-count { nonNegativeInteger }? + & attribute draw:fill-hatch-name { styleNameRef }? + & attribute draw:fill-hatch-solid { boolean }? + & attribute draw:fill-image-name { styleNameRef }? + & attribute style:repeat { "no-repeat" | "repeat" | "stretch" }? + & attribute draw:fill-image-width { length | percent }? + & attribute draw:fill-image-height { length | percent }? + & attribute draw:fill-image-ref-point-x { percent }? + & attribute draw:fill-image-ref-point-y { percent }? + & attribute draw:fill-image-ref-point { + "top-left" + | "top" + | "top-right" + | "left" + | "center" + | "right" + | "bottom-left" + | "bottom" + | "bottom-right" + }? + & attribute draw:tile-repeat-offset { + list { zeroToHundredPercent, ("horizontal" | "vertical") } + }? + & attribute draw:opacity { zeroToHundredPercent }? + & attribute draw:opacity-name { styleNameRef }? + & attribute svg:fill-rule { "nonzero" | "evenodd" }? +style-graphic-properties-elements = + text-list-style? & style-background-image & style-columns +common-vertical-pos-attlist = + attribute style:vertical-pos { + "top" | "middle" | "bottom" | "from-top" | "below" + }?, + attribute svg:y { coordinate }? +common-vertical-rel-attlist = + attribute style:vertical-rel { + "page" + | "page-content" + | "frame" + | "frame-content" + | "paragraph" + | "paragraph-content" + | "char" + | "line" + | "baseline" + | "text" + }? +common-editable-attlist = attribute style:editable { boolean }? +horizontal-mirror = + "horizontal" | "horizontal-on-odd" | "horizontal-on-even" +clipShape = + xsd:string { + pattern = + "rect\([ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)))|(auto))([ ]*,[ ]*((-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc))))|(auto)){3}[ ]*\)" + } +nonNegativePixelLength = + xsd:string { pattern = "([0-9]+(\.[0-9]*)?|\.[0-9]+)(px)" } +style-chart-properties = + element style:chart-properties { + style-chart-properties-content-strict + } +style-chart-properties-content-strict = + style-chart-properties-attlist, style-chart-properties-elements +style-chart-properties-elements = empty +style-chart-properties-attlist = + attribute chart:scale-text { boolean }? + & attribute chart:three-dimensional { boolean }? + & attribute chart:deep { boolean }? + & attribute chart:right-angled-axes { boolean }? + & (attribute chart:symbol-type { "none" } + | attribute chart:symbol-type { "automatic" } + | (attribute chart:symbol-type { "named-symbol" }, + attribute chart:symbol-name { + "square" + | "diamond" + | "arrow-down" + | "arrow-up" + | "arrow-right" + | "arrow-left" + | "bow-tie" + | "hourglass" + | "circle" + | "star" + | "x" + | "plus" + | "asterisk" + | "horizontal-bar" + | "vertical-bar" + }) + | (attribute chart:symbol-type { "image" }, + element chart:symbol-image { + attribute xlink:href { anyIRI } + }) + | empty) + & attribute chart:symbol-width { nonNegativeLength }? + & attribute chart:symbol-height { nonNegativeLength }? + & attribute chart:sort-by-x-values { boolean }? + & attribute chart:vertical { boolean }? + & attribute chart:connect-bars { boolean }? + & attribute chart:gap-width { integer }? + & attribute chart:overlap { integer }? + & attribute chart:group-bars-per-axis { boolean }? + & attribute chart:japanese-candle-stick { boolean }? + & attribute chart:interpolation { + "none" | "cubic-spline" | "b-spline" + }? + & attribute chart:spline-order { positiveInteger }? + & attribute chart:spline-resolution { positiveInteger }? + & attribute chart:pie-offset { nonNegativeInteger }? + & attribute chart:angle-offset { angle }? + & attribute chart:hole-size { percent }? + & attribute chart:lines { boolean }? + & attribute chart:solid-type { + "cuboid" | "cylinder" | "cone" | "pyramid" + }? + & attribute chart:stacked { boolean }? + & attribute chart:percentage { boolean }? + & attribute chart:treat-empty-cells { + "use-zero" | "leave-gap" | "ignore" + }? + & attribute chart:link-data-style-to-source { boolean }? + & attribute chart:logarithmic { boolean }? + & attribute chart:maximum { double }? + & attribute chart:minimum { double }? + & attribute chart:origin { double }? + & attribute chart:interval-major { double }? + & attribute chart:interval-minor-divisor { positiveInteger }? + & attribute chart:tick-marks-major-inner { boolean }? + & attribute chart:tick-marks-major-outer { boolean }? + & attribute chart:tick-marks-minor-inner { boolean }? + & attribute chart:tick-marks-minor-outer { boolean }? + & attribute chart:reverse-direction { boolean }? + & attribute chart:display-label { boolean }? + & attribute chart:text-overlap { boolean }? + & attribute text:line-break { boolean }? + & attribute chart:label-arrangement { + "side-by-side" | "stagger-even" | "stagger-odd" + }? + & common-style-direction-attlist + & common-rotation-angle-attlist + & attribute chart:data-label-number { + "none" | "value" | "percentage" | "value-and-percentage" + }? + & attribute chart:data-label-text { boolean }? + & attribute chart:data-label-symbol { boolean }? + & element chart:label-separator { text-p }? + & attribute chart:label-position { labelPositions }? + & attribute chart:label-position-negative { labelPositions }? + & attribute chart:visible { boolean }? + & attribute chart:auto-position { boolean }? + & attribute chart:auto-size { boolean }? + & attribute chart:mean-value { boolean }? + & attribute chart:error-category { + "none" + | "variance" + | "standard-deviation" + | "percentage" + | "error-margin" + | "constant" + | "standard-error" + | "cell-range" + }? + & attribute chart:error-percentage { double }? + & attribute chart:error-margin { double }? + & attribute chart:error-lower-limit { double }? + & attribute chart:error-upper-limit { double }? + & attribute chart:error-upper-indicator { boolean }? + & attribute chart:error-lower-indicator { boolean }? + & attribute chart:error-lower-range { cellRangeAddressList }? + & attribute chart:error-upper-range { cellRangeAddressList }? + & attribute chart:series-source { "columns" | "rows" }? + & attribute chart:regression-type { + "none" | "linear" | "logarithmic" | "exponential" | "power" + }? + & attribute chart:axis-position { "start" | "end" | double }? + & attribute chart:axis-label-position { + "near-axis" + | "near-axis-other-side" + | "outside-start" + | "outside-end" + }? + & attribute chart:tick-mark-position { + "at-labels" | "at-axis" | "at-labels-and-axis" + }? + & attribute chart:include-hidden-cells { boolean }? +labelPositions = + "avoid-overlap" + | "center" + | "top" + | "top-right" + | "right" + | "bottom-right" + | "bottom" + | "bottom-left" + | "left" + | "top-left" + | "inside" + | "outside" + | "near-origin" +style-drawing-page-properties-attlist = + attribute presentation:transition-type { + "manual" | "automatic" | "semi-automatic" + }? + & attribute presentation:transition-style { + "none" + | "fade-from-left" + | "fade-from-top" + | "fade-from-right" + | "fade-from-bottom" + | "fade-from-upperleft" + | "fade-from-upperright" + | "fade-from-lowerleft" + | "fade-from-lowerright" + | "move-from-left" + | "move-from-top" + | "move-from-right" + | "move-from-bottom" + | "move-from-upperleft" + | "move-from-upperright" + | "move-from-lowerleft" + | "move-from-lowerright" + | "uncover-to-left" + | "uncover-to-top" + | "uncover-to-right" + | "uncover-to-bottom" + | "uncover-to-upperleft" + | "uncover-to-upperright" + | "uncover-to-lowerleft" + | "uncover-to-lowerright" + | "fade-to-center" + | "fade-from-center" + | "vertical-stripes" + | "horizontal-stripes" + | "clockwise" + | "counterclockwise" + | "open-vertical" + | "open-horizontal" + | "close-vertical" + | "close-horizontal" + | "wavyline-from-left" + | "wavyline-from-top" + | "wavyline-from-right" + | "wavyline-from-bottom" + | "spiralin-left" + | "spiralin-right" + | "spiralout-left" + | "spiralout-right" + | "roll-from-top" + | "roll-from-left" + | "roll-from-right" + | "roll-from-bottom" + | "stretch-from-left" + | "stretch-from-top" + | "stretch-from-right" + | "stretch-from-bottom" + | "vertical-lines" + | "horizontal-lines" + | "dissolve" + | "random" + | "vertical-checkerboard" + | "horizontal-checkerboard" + | "interlocking-horizontal-left" + | "interlocking-horizontal-right" + | "interlocking-vertical-top" + | "interlocking-vertical-bottom" + | "fly-away" + | "open" + | "close" + | "melt" + }? + & attribute presentation:transition-speed { presentationSpeeds }? + & attribute smil:type { \string }? + & attribute smil:subtype { \string }? + & attribute smil:direction { "forward" | "reverse" }? + & attribute smil:fadeColor { color }? + & attribute presentation:duration { duration }? + & attribute presentation:visibility { "visible" | "hidden" }? + & attribute draw:background-size { "full" | "border" }? + & attribute presentation:background-objects-visible { boolean }? + & attribute presentation:background-visible { boolean }? + & attribute presentation:display-header { boolean }? + & attribute presentation:display-footer { boolean }? + & attribute presentation:display-page-number { boolean }? + & attribute presentation:display-date-time { boolean }? +style-drawing-page-properties-elements = presentation-sound? +\string = xsd:string +date = xsd:date +time = xsd:time +dateTime = xsd:dateTime +duration = xsd:duration +integer = xsd:integer +nonNegativeInteger = xsd:nonNegativeInteger +positiveInteger = xsd:positiveInteger +double = xsd:double +anyURI = xsd:anyURI +base64Binary = xsd:base64Binary +ID = xsd:ID +IDREF = xsd:IDREF +IDREFS = xsd:IDREFS +NCName = xsd:NCName +boolean = "true" | "false" +dateOrDateTime = xsd:date | xsd:dateTime +timeOrDateTime = xsd:time | xsd:dateTime +language = xsd:language +countryCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" } +languageCode = xsd:token { pattern = "[A-Za-z]{1,8}" } +scriptCode = xsd:token { pattern = "[A-Za-z0-9]{1,8}" } +character = xsd:string { length = "1" } +length = + xsd:string { + pattern = + "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))" + } +nonNegativeLength = + xsd:string { + pattern = + "([0-9]+(\.[0-9]*)?|\.[0-9]+)((cm)|(mm)|(in)|(pt)|(pc)|(px))" + } +positiveLength = + xsd:string { + pattern = + "([0-9]*[1-9][0-9]*(\.[0-9]*)?|0+\.[0-9]*[1-9][0-9]*|\.[0-9]*[1-9][0-9]*)((cm)|(mm)|(in)|(pt)|(pc)|(px))" + } +percent = xsd:string { pattern = "-?([0-9]+(\.[0-9]*)?|\.[0-9]+)%" } +zeroToHundredPercent = + xsd:string { + pattern = "([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%" + } +signedZeroToHundredPercent = + xsd:string { + pattern = "-?([0-9]?[0-9](\.[0-9]*)?|100(\.0*)?|\.[0-9]+)%" + } +relativeLength = xsd:string { pattern = "[0-9]+\*" } +coordinate = length +distance = length +color = xsd:string { pattern = "#[0-9a-fA-F]{6}" } +angle = xsd:string +CURIE = + xsd:string { pattern = "(([\i-[:]][\c-[:]]*)?:)?.+" minLength = "1" } +CURIEs = list { CURIE+ } +SafeCURIE = + xsd:string { + pattern = "\[(([\i-[:]][\c-[:]]*)?:)?.+\]" + minLength = "3" + } +URIorSafeCURIE = anyURI | SafeCURIE +styleName = xsd:NCName +styleNameRef = xsd:NCName | empty +styleNameRefs = list { xsd:NCName* } +variableName = xsd:string +targetFrameName = "_self" | "_blank" | "_parent" | "_top" | \string +valueType = + "float" + | "time" + | "date" + | "percentage" + | "currency" + | "boolean" + | "string" +points = + xsd:string { pattern = "-?[0-9]+,-?[0-9]+([ ]+-?[0-9]+,-?[0-9]+)*" } +pathData = xsd:string +vector3D = + xsd:string { + pattern = + "\([ ]*-?([0-9]+(\.[0-9]*)?|\.[0-9]+)([ ]+-?([0-9]+(\.[0-9]*)?|\.[0-9]+)){2}[ ]*\)" + } +namespacedToken = xsd:QName { pattern = "[^:]+:[^:]+" } +anyIRI = + xsd:anyURI + >> dc:description [ + "An IRI-reference as defined in [RFC3987]. See ODF 1.2 Part 1 section 18.3." + ] +anyAttListOrElements = + attribute * { text }*, + anyElements +anyElements = + element * { + mixed { anyAttListOrElements } + }* diff --git a/lisp/org/ob-C.el b/lisp/org/ob-C.el index 77cfd53785..2bdda68d58 100644 --- a/lisp/org/ob-C.el +++ b/lisp/org/ob-C.el @@ -1,8 +1,9 @@ -;;; ob-C.el --- org-babel functions for C and similar languages +;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte +;; Thierry Banel ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org @@ -23,37 +24,57 @@ ;;; Commentary: -;; Org-Babel support for evaluating C code. +;; Org-Babel support for evaluating C, C++, D code. ;; ;; very limited implementation: ;; - currently only support :results output ;; - not much in the way of error feedback ;;; Code: -(eval-when-compile - (require 'cl)) -(require 'ob) + (require 'cc-mode) +(require 'ob) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) +(add-to-list 'org-babel-tangle-lang-exts '("D" . "d")) (defvar org-babel-default-header-args:C '()) -(defvar org-babel-C-compiler "gcc" - "Command used to compile a C source code file into an -executable.") - -(defvar org-babel-C++-compiler "g++" - "Command used to compile a C++ source code file into an -executable.") +(defcustom org-babel-C-compiler "gcc" + "Command used to compile a C source code file into an executable. +May be either a command in the path, like gcc +or an absolute path name, like /usr/local/bin/gcc +parameter may be used, like gcc -v" + :group 'org-babel + :version "24.3" + :type 'string) + +(defcustom org-babel-C++-compiler "g++" + "Command used to compile a C++ source code file into an executable. +May be either a command in the path, like g++ +or an absolute path name, like /usr/local/bin/g++ +parameter may be used, like g++ -v" + :group 'org-babel + :version "24.3" + :type 'string) + +(defcustom org-babel-D-compiler "rdmd" + "Command used to compile and execute a D source code file. +May be either a command in the path, like rdmd +or an absolute path name, like /usr/local/bin/rdmd +parameter may be used, like rdmd --chatty" + :group 'org-babel + :version "24.3" + :type 'string) (defvar org-babel-c-variant nil - "Internal variable used to hold which type of C (e.g. C or C++) + "Internal variable used to hold which type of C (e.g. C or C++ or D) is currently being evaluated.") (defun org-babel-execute:cpp (body params) @@ -61,88 +82,189 @@ is currently being evaluated.") This function calls `org-babel-execute:C++'." (org-babel-execute:C++ body params)) +(defun org-babel-expand-body:cpp (body params) + "Expand a block of C++ code with org-babel according to its +header arguments." + (org-babel-expand-body:C++ body params)) + (defun org-babel-execute:C++ (body params) "Execute a block of C++ code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) (defun org-babel-expand-body:C++ (body params) - "Expand a block of C++ code with org-babel according to it's -header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) + "Expand a block of C++ code with org-babel according to its +header arguments." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand-C++ body params))) + +(defun org-babel-execute:D (body params) + "Execute a block of D code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'd)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:D (body params) + "Expand a block of D code with org-babel according to its +header arguments." + (let ((org-babel-c-variant 'd)) (org-babel-C-expand-D body params))) (defun org-babel-execute:C (body params) "Execute a block of C code with org-babel. This function is called by `org-babel-execute-src-block'." (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) -(defun org-babel-expand-body:c (body params) - "Expand a block of C code with org-babel according to it's -header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) +(defun org-babel-expand-body:C (body params) + "Expand a block of C code with org-babel according to its +header arguments." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand-C body params))) (defun org-babel-C-execute (body params) "This function should only be called by `org-babel-execute:C' -or `org-babel-execute:C++'." +or `org-babel-execute:C++' or `org-babel-execute:D'." (let* ((tmp-src-file (org-babel-temp-file "C-src-" - (cond - ((equal org-babel-c-variant 'c) ".c") - ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) - (cmdline (cdr (assoc :cmdline params))) - (flags (cdr (assoc :flags params))) - (full-body (org-babel-C-expand body params)) - (compile - (progn - (with-temp-file tmp-src-file (insert full-body)) - (org-babel-eval - (format "%s -o %s %s %s" - (cond - ((equal org-babel-c-variant 'c) org-babel-C-compiler) - ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler)) - (org-babel-process-file-name tmp-bin-file) - (mapconcat 'identity - (if (listp flags) flags (list flags)) " ") - (org-babel-process-file-name tmp-src-file)) "")))) + (pcase org-babel-c-variant + (`c ".c") (`cpp ".cpp") (`d ".d")))) + (tmp-bin-file ;not used for D + (org-babel-process-file-name + (org-babel-temp-file "C-bin-" org-babel-exeext))) + (cmdline (cdr (assq :cmdline params))) + (cmdline (if cmdline (concat " " cmdline) "")) + (flags (cdr (assq :flags params))) + (flags (mapconcat 'identity + (if (listp flags) flags (list flags)) " ")) + (libs (org-babel-read + (or (cdr (assq :libs params)) + (org-entry-get nil "libs" t)) + nil)) + (libs (mapconcat #'identity + (if (listp libs) libs (list libs)) + " ")) + (full-body + (pcase org-babel-c-variant + (`c (org-babel-C-expand-C body params)) + (`cpp (org-babel-C-expand-C++ body params)) + (`d (org-babel-C-expand-D body params))))) + (with-temp-file tmp-src-file (insert full-body)) + (pcase org-babel-c-variant + ((or `c `cpp) + (org-babel-eval + (format "%s -o %s %s %s %s" + (pcase org-babel-c-variant + (`c org-babel-C-compiler) + (`cpp org-babel-C++-compiler)) + tmp-bin-file + flags + (org-babel-process-file-name tmp-src-file) + libs) + "")) + (`d nil)) ;; no separate compilation for D (let ((results - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - )) - -(defun org-babel-C-expand (body params) + (org-babel-eval + (pcase org-babel-c-variant + ((or `c `cpp) + (concat tmp-bin-file cmdline)) + (`d + (format "%s %s %s %s" + org-babel-D-compiler + flags + (org-babel-process-file-name tmp-src-file) + cmdline))) + ""))) + (when results + (setq results (org-trim (org-remove-indentation results))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assq :result-params params)) + (org-babel-read results t) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) + (org-babel-pick-name + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))) + ))) + +(defun org-babel-C-expand-C++ (body params) "Expand a block of C or C++ code with org-babel according to -it's header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (includes (or (cdr (assoc :includes params)) - (org-babel-read (org-entry-get nil "includes" t)))) - (defines (org-babel-read - (or (cdr (assoc :defines params)) - (org-babel-read (org-entry-get nil "defines" t)))))) +its header arguments." + (org-babel-C-expand-C body params)) + +(defun org-babel-C-expand-C (body params) + "Expand a block of C or C++ code with org-babel according to +its header arguments." + (let ((vars (org-babel--get-vars params)) + (colnames (cdr (assq :colname-names params))) + (main-p (not (string= (cdr (assq :main params)) "no"))) + (includes (org-babel-read + (or (cdr (assq :includes params)) + (org-entry-get nil "includes" t)) + nil)) + (defines (org-babel-read + (or (cdr (assq :defines params)) + (org-entry-get nil "defines" t)) + nil))) + (when (stringp includes) + (setq includes (split-string includes))) + (when (stringp defines) + (let ((y nil) + (result (list t))) + (dolist (x (split-string defines)) + (if (null y) + (setq y x) + (nconc result (list (concat y " " x))) + (setq y nil))) + (setq defines (cdr result)))) (mapconcat 'identity (list ;; includes (mapconcat (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") + includes "\n") ;; defines (mapconcat (lambda (inc) (format "#define %s" inc)) (if (listp defines) defines (list defines)) "\n") ;; variables (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; table sizes + (mapconcat 'org-babel-C-table-sizes-to-C vars "\n") + ;; tables headers utility + (when colnames + (org-babel-C-utility-header-to-C)) + ;; tables headers + (mapconcat 'org-babel-C-header-to-C colnames "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n"))) + +(defun org-babel-C-expand-D (body params) + "Expand a block of D code with org-babel according to +its header arguments." + (let ((vars (org-babel--get-vars params)) + (colnames (cdr (assq :colname-names params))) + (main-p (not (string= (cdr (assq :main params)) "no"))) + (imports (or (cdr (assq :imports params)) + (org-babel-read (org-entry-get nil "imports" t))))) + (when (stringp imports) + (setq imports (split-string imports))) + (setq imports (append imports '("std.stdio" "std.conv"))) + (mapconcat 'identity + (list + "module mmm;" + ;; imports + (mapconcat + (lambda (inc) (format "import %s;" inc)) + imports "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; table sizes + (mapconcat 'org-babel-C-table-sizes-to-C vars "\n") + ;; tables headers utility + (when colnames + (org-babel-C-utility-header-to-C)) + ;; tables headers + (mapconcat 'org-babel-C-header-to-C colnames "\n") ;; body (if main-p (org-babel-C-ensure-main-wrap body) @@ -154,12 +276,12 @@ it's header arguments." body (format "int main() {\n%s\nreturn 0;\n}\n" body))) -(defun org-babel-prep-session:C (session params) +(defun org-babel-prep-session:C (_session _params) "This function does nothing as C is a compiled language with no support for sessions" (error "C is a compiled language -- no support for sessions")) -(defun org-babel-load-session:C (session body params) +(defun org-babel-load-session:C (_session _body _params) "This function does nothing as C is a compiled language with no support for sessions" (error "C is a compiled language -- no support for sessions")) @@ -177,58 +299,79 @@ support for sessions" "Determine the type of VAL. Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type. FORMAT can be either a format string or a function which is called with VAL." + (let* ((basetype (org-babel-C-val-to-base-type val)) + (type + (pcase basetype + (`integerp '("int" "%d")) + (`floatp '("double" "%f")) + (`stringp + (list + (if (eq org-babel-c-variant 'd) "string" "const char*") + "\"%s\"")) + (_ (error "unknown type %S" basetype))))) + (cond + ((integerp val) type) ;; an integer declared in the #+begin_src line + ((floatp val) type) ;; a numeric declared in the #+begin_src line + ((and (listp val) (listp (car val))) ;; a table + `(,(car type) + (lambda (val) + (cons + (format "[%d][%d]" (length val) (length (car val))) + (concat + (if (eq org-babel-c-variant 'd) "[\n" "{\n") + (mapconcat + (lambda (v) + (concat + (if (eq org-babel-c-variant 'd) " [" " {") + (mapconcat (lambda (w) (format ,(cadr type) w)) v ",") + (if (eq org-babel-c-variant 'd) "]" "}"))) + val + ",\n") + (if (eq org-babel-c-variant 'd) "\n]" "\n}")))))) + ((or (listp val) (vectorp val)) ;; a list declared in the #+begin_src line + `(,(car type) + (lambda (val) + (cons + (format "[%d]" (length val)) + (concat + (if (eq org-babel-c-variant 'd) "[" "{") + (mapconcat (lambda (v) (format ,(cadr type) v)) val ",") + (if (eq org-babel-c-variant 'd) "]" "}")))))) + (t ;; treat unknown types as string + type)))) + +(defun org-babel-C-val-to-base-type (val) + "Determine the base type of VAL which may be +`integerp' if all base values are integers +`floatp' if all base values are either floating points or integers +`stringp' otherwise." (cond - ((integerp val) '("int" "%d")) - ((floatp val) '("double" "%f")) + ((integerp val) 'integerp) + ((floatp val) 'floatp) ((or (listp val) (vectorp val)) - (lexical-let ((type (org-babel-C-val-to-C-list-type val))) - (list (car type) - (lambda (val) - (cons - (format "[%d]%s" - (length val) - (car (org-babel-C-format-val type (elt val 0)))) - (concat "{ " - (mapconcat (lambda (v) - (cdr (org-babel-C-format-val type v))) - val - ", ") - " }")))))) - (t ;; treat unknown types as string - '("char" (lambda (val) - (let ((s (format "%s" val))) ;; convert to string for unknown types - (cons (format "[%d]" (1+ (length s))) - (concat "\"" s "\"")))))))) - -(defun org-babel-C-val-to-C-list-type (val) - "Determine the C array type of a VAL." - (let (type) - (mapc - #'(lambda (i) - (let* ((tmp-type (org-babel-C-val-to-C-type i)) - (type-name (car type)) - (tmp-type-name (car tmp-type))) - (when (and type (not (string= type-name tmp-type-name))) - (if (and (member type-name '("int" "double" "int32_t")) - (member tmp-type-name '("int" "double" "int32_t"))) - (setq tmp-type '("double" "" "%f")) - (error "Only homogeneous lists are supported by C. You can not mix %s and %s" - type-name - tmp-type-name))) - (setq type tmp-type))) - val) - type)) + (let ((type nil)) + (mapc (lambda (v) + (pcase (org-babel-C-val-to-base-type v) + (`stringp (setq type 'stringp)) + (`floatp + (if (or (not type) (eq type 'integerp)) + (setq type 'floatp))) + (`integerp + (unless type (setq type 'integerp))))) + val) + type)) + (t 'stringp))) (defun org-babel-C-var-to-C (pair) "Convert an elisp val into a string of C code specifying a var of the same value." ;; TODO list support (let ((var (car pair)) - (val (cdr pair))) + (val (cdr pair))) (when (symbolp val) (setq val (symbol-name val)) (when (= (length val) 1) - (setq val (string-to-char val)))) + (setq val (string-to-char val)))) (let* ((type-data (org-babel-C-val-to-C-type val)) (type (car type-data)) (formated (org-babel-C-format-val type-data val)) @@ -240,6 +383,66 @@ of the same value." suffix data)))) +(defun org-babel-C-table-sizes-to-C (pair) + "Create constants of table dimensions, if PAIR is a table." + (when (listp (cdr pair)) + (cond + ((listp (cadr pair)) ;; a table + (concat + (format "const int %s_rows = %d;" (car pair) (length (cdr pair))) + "\n" + (format "const int %s_cols = %d;" (car pair) (length (cadr pair))))) + (t ;; a list declared in the #+begin_src line + (format "const int %s_cols = %d;" (car pair) (length (cdr pair))))))) + +(defun org-babel-C-utility-header-to-C () + "Generate a utility function to convert a column name +into a column number." + (pcase org-babel-c-variant + ((or `c `cpp) + "int get_column_num (int nbcols, const char** header, const char* column) +{ + int c; + for (c=0; c. + +;;; Commentary: + +;; Org-Babel support for evaluating J code. +;; +;; Session interaction depends on `j-console' from package `j-mode' +;; (available in MELPA). + +;;; Code: + +(require 'ob) + +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function j-console-ensure-session "ext:j-console" ()) + +(defcustom org-babel-J-command "jconsole" + "Command to call J." + :group 'org-babel + :version "26.1" + :package-version '(Org . "9.0") + :type 'string) + +(defun org-babel-expand-body:J (body _params &optional _processed-params) + "Expand BODY according to PARAMS, return the expanded body. +PROCESSED-PARAMS isn't used yet." + (org-babel-J-interleave-echos-except-functions body)) + +(defun org-babel-J-interleave-echos (body) + "Interleave echo',' between each source line of BODY." + (mapconcat #'identity (split-string body "\n") "\necho','\n")) + +(defun org-babel-J-interleave-echos-except-functions (body) + "Interleave echo',' between source lines of BODY that aren't functions." + (if (obj-string-match-m "\\(?:^\\|\n\\)[^\n]*\\(?:0\\|1\\|2\\|3\\|4\\|dyad\\) : 0\n.*\n)\\(?:\n\\|$\\)" body) + (let ((s1 (substring body 0 (match-beginning 0))) + (s2 (match-string 0 body)) + (s3 (substring body (match-end 0)))) + (concat + (if (string= s1 "") + "" + (concat (org-babel-J-interleave-echos s1) + "\necho','\n")) + s2 + "\necho','\n" + (org-babel-J-interleave-echos-except-functions s3))) + (org-babel-J-interleave-echos body))) + +(defalias 'org-babel-execute:j 'org-babel-execute:J) + +(defun org-babel-execute:J (body params) + "Execute a block of J code BODY. +PARAMS are given by org-babel. +This function is called by `org-babel-execute-src-block'" + (message "executing J source code block") + (let* ((processed-params (org-babel-process-params params)) + (sessionp (cdr (assq :session params))) + (full-body (org-babel-expand-body:J + body params processed-params)) + (tmp-script-file (org-babel-temp-file "J-src"))) + (org-babel-j-initiate-session sessionp) + (org-babel-J-strip-whitespace + (if (string= sessionp "none") + (progn + (with-temp-file tmp-script-file + (insert full-body)) + (org-babel-eval (format "%s < %s" org-babel-J-command tmp-script-file) "")) + (org-babel-J-eval-string full-body))))) + +(defun org-babel-J-eval-string (str) + "Sends STR to the `j-console-cmd' session and exectues it." + (let ((session (j-console-ensure-session))) + (with-current-buffer (process-buffer session) + (goto-char (point-max)) + (insert (format "\n%s\n" str)) + (let ((beg (point))) + (comint-send-input) + (sit-for .1) + (buffer-substring-no-properties + beg (point-max)))))) + +(defun org-babel-J-strip-whitespace (str) + "Remove whitespace from jconsole output STR." + (mapconcat + #'identity + (delete "" (mapcar + #'org-babel-J-print-block + (split-string str "^ *,\n" t))) + "\n\n")) + +(defun obj-get-string-alignment (str) + "Return a number to describe STR alignment. +STR represents a table. +Positive/negative/zero result means right/left/undetermined. +Don't trust first line." + (let* ((str (org-trim str)) + (lines (split-string str "\n" t)) + n1 n2) + (cond ((<= (length lines) 1) + 0) + ((= (length lines) 2) + ;; numbers are right-aligned + (if (and + (numberp (read (car lines))) + (numberp (read (cadr lines))) + (setq n1 (obj-match-second-space-right (nth 0 lines))) + (setq n2 (obj-match-second-space-right (nth 1 lines)))) + n2 + 0)) + ((not (obj-match-second-space-left (nth 0 lines))) + 0) + ((and + (setq n1 (obj-match-second-space-left (nth 1 lines))) + (setq n2 (obj-match-second-space-left (nth 2 lines))) + (= n1 n2)) + n1) + ((and + (setq n1 (obj-match-second-space-right (nth 1 lines))) + (setq n2 (obj-match-second-space-right (nth 2 lines))) + (= n1 n2)) + (- n1)) + (t 0)))) + +(defun org-babel-J-print-block (x) + "Prettify jconsole output X." + (let* ((x (org-trim x)) + (a (obj-get-string-alignment x)) + (lines (split-string x "\n" t)) + b) + (cond ((< a 0) + (setq b (obj-match-second-space-right (nth 0 lines))) + (concat (make-string (+ a b) ? ) x)) + ((> a 0) + (setq b (obj-match-second-space-left (nth 0 lines))) + (concat (make-string (- a b) ? ) x)) + (t x)))) + +(defun obj-match-second-space-left (s) + "Return position of leftmost space in second space block of S or nil." + (and (string-match "^ *[^ ]+\\( \\)" s) + (match-beginning 1))) + +(defun obj-match-second-space-right (s) + "Return position of rightmost space in second space block of S or nil." + (and (string-match "^ *[^ ]+ *\\( \\)[^ ]" s) + (match-beginning 1))) + +(defun obj-string-match-m (regexp string &optional start) + "Call (string-match REGEXP STRING START). +REGEXP is modified so that .* matches newlines as well." + (string-match + (replace-regexp-in-string "\\.\\*" "[\0-\377[:nonascii:]]*" regexp) + string + start)) + +(defun org-babel-j-initiate-session (&optional session) + "Initiate a J session. +SESSION is a parameter given by org-babel." + (unless (string= session "none") + (require 'j-console) + (j-console-ensure-session))) + +(provide 'ob-J) + +;;; ob-J.el ends here diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 51d342702c..3accade49f 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -1,4 +1,4 @@ -;;; ob-R.el --- org-babel functions for R code evaluation +;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -27,16 +27,17 @@ ;; Org-Babel support for evaluating R code ;;; Code: + +(require 'cl-lib) (require 'ob) -(eval-when-compile (require 'cl)) (declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) (declare-function ess-make-buffer-current "ext:ess-inf" ()) (declare-function ess-eval-buffer "ext:ess-inf" (vis)) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-remove-if-not "org" (predicate seq)) +(declare-function ess-wait-for-process "ext:ess-inf" + (&optional proc sec-prompt wait force-redisplay)) (defconst org-babel-header-args:R '((width . :any) @@ -60,12 +61,25 @@ (useDingbats . :any) (horizontal . :any) (results . ((file list vector table scalar verbatim) - (raw org html latex code pp wrap) - (replace silent append prepend) + (raw html latex org code pp drawer) + (replace silent none append prepend) (output value graphics)))) "R-specific header arguments.") +(defconst ob-R-safe-header-args + (append org-babel-safe-header-args + '(:width :height :bg :units :pointsize :antialias :quality + :compression :res :type :family :title :fonts + :version :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + "Header args which are safe for R babel blocks. + +See `org-babel-safe-header-args' for documentation of the format of +this variable.") + (defvar org-babel-default-header-args:R '()) +(put 'org-babel-default-header-args:R 'safe-local-variable + (org-babel-header-args-safe-fn ob-R-safe-header-args)) (defcustom org-babel-R-command "R --slave --no-save" "Name of command to use for executing R code." @@ -73,56 +87,103 @@ :version "24.1" :type 'string) -(defvar ess-local-process-name) ; dynamically scoped +(defvar ess-current-process-name) ; dynamically scoped +(defvar ess-local-process-name) ; dynamically scoped (defun org-babel-edit-prep:R (info) - (let ((session (cdr (assoc :session (nth 2 info))))) - (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) - (save-match-data (org-babel-R-initiate-session session nil))))) - -(defun org-babel-expand-body:R (body params &optional graphics-file) + (let ((session (cdr (assq :session (nth 2 info))))) + (when (and session + (string-prefix-p "*" session) + (string-suffix-p "*" session)) + (org-babel-R-initiate-session session nil)))) + +;; The usage of utils::read.table() ensures that the command +;; read.table() can be found even in circumstances when the utils +;; package is not in the search path from R. +(defconst ob-R-transfer-variable-table-with-header + "%s <- local({ + con <- textConnection( + %S + ) + res <- utils::read.table( + con, + header = %s, + row.names = %s, + sep = \"\\t\", + as.is = TRUE + ) + close(con) + res + })" + "R code used to transfer a table defined as a variable from org to R. + +This function is used when the table contains a header.") + +(defconst ob-R-transfer-variable-table-without-header + "%s <- local({ + con <- textConnection( + %S + ) + res <- utils::read.table( + con, + header = %s, + row.names = %s, + sep = \"\\t\", + as.is = TRUE, + fill = TRUE, + col.names = paste(\"V\", seq_len(%d), sep =\"\") + ) + close(con) + res + })" + "R code used to transfer a table defined as a variable from org to R. + +This function is used when the table does not contain a header.") + +(defun org-babel-expand-body:R (body params &optional _graphics-file) "Expand BODY according to PARAMS, return the expanded body." - (let ((graphics-file - (or graphics-file (org-babel-R-graphical-output-file params)))) - (mapconcat - #'identity - (let ((inside - (append - (when (cdr (assoc :prologue params)) - (list (cdr (assoc :prologue params)))) - (org-babel-variable-assignments:R params) - (list body) - (when (cdr (assoc :epilogue params)) - (list (cdr (assoc :epilogue params))))))) - (if graphics-file - (append - (list (org-babel-R-construct-graphics-device-call - graphics-file params)) - inside - (list "dev.off()")) - inside)) - "\n"))) + (mapconcat 'identity + (append + (when (cdr (assq :prologue params)) + (list (cdr (assq :prologue params)))) + (org-babel-variable-assignments:R params) + (list body) + (when (cdr (assq :epilogue params)) + (list (cdr (assq :epilogue params))))) + "\n")) (defun org-babel-execute:R (body params) "Execute a block of R code. This function is called by `org-babel-execute-src-block'." (save-excursion - (let* ((result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (session (org-babel-R-initiate-session - (cdr (assoc :session params)) params)) - (colnames-p (cdr (assoc :colnames params))) - (rownames-p (cdr (assoc :rownames params))) - (graphics-file (org-babel-R-graphical-output-file params)) - (full-body (org-babel-expand-body:R body params graphics-file)) + (cdr (assq :session params)) params)) + (colnames-p (cdr (assq :colnames params))) + (rownames-p (cdr (assq :rownames params))) + (graphics-file (and (member "graphics" (assq :result-params params)) + (org-babel-graphical-output-file params))) + (full-body + (let ((inside + (list (org-babel-expand-body:R body params graphics-file)))) + (mapconcat 'identity + (if graphics-file + (append + (list (org-babel-R-construct-graphics-device-call + graphics-file params)) + inside + (list "},error=function(e){plot(x=-1:1, y=-1:1, type='n', xlab='', ylab='', axes=FALSE); text(x=0, y=0, labels=e$message, col='red'); paste('ERROR', e$message, sep=' : ')}); dev.off()")) + inside) + "\n"))) (result (org-babel-R-evaluate session full-body result-type result-params (or (equal "yes" colnames-p) (org-babel-pick-name - (cdr (assoc :colname-names params)) colnames-p)) + (cdr (assq :colname-names params)) colnames-p)) (or (equal "yes" rownames-p) (org-babel-pick-name - (cdr (assoc :rowname-names params)) rownames-p))))) + (cdr (assq :rowname-names params)) rownames-p))))) (if graphics-file nil result)))) (defun org-babel-prep-session:R (session params) @@ -148,21 +209,21 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-variable-assignments:R (params) "Return list of R statements assigning the block's variables." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapcar (lambda (pair) (org-babel-R-assign-elisp (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) + (equal "yes" (cdr (assq :colnames params))) + (equal "yes" (cdr (assq :rownames params))))) (mapcar (lambda (i) (cons (car (nth i vars)) (org-babel-reassemble-table (cdr (nth i vars)) - (cdr (nth i (cdr (assoc :colname-names params)))) - (cdr (nth i (cdr (assoc :rowname-names params))))))) - (org-number-sequence 0 (1- (length vars))))))) + (cdr (nth i (cdr (assq :colname-names params)))) + (cdr (nth i (cdr (assq :rowname-names params))))))) + (number-sequence 0 (1- (length vars))))))) (defun org-babel-R-quote-tsv-field (s) "Quote field S for export to R." @@ -173,35 +234,25 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value))) + (let* ((lengths (mapcar 'length (cl-remove-if-not 'sequencep value))) (max (if lengths (apply 'max lengths) 0)) - (min (if lengths (apply 'min lengths) 0)) - (transition-file (org-babel-temp-file "R-import-"))) + (min (if lengths (apply 'min lengths) 0))) ;; Ensure VALUE has an orgtbl structure (depth of at least 2). (unless (listp (car value)) (setq value (list value))) - (with-temp-file transition-file - (insert - (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)) - "\n")) - (let ((file (org-babel-process-file-name transition-file 'noquote)) + (let ((file (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field))) (header (if (or (eq (nth 1 value) 'hline) colnames-p) "TRUE" "FALSE")) (row-names (if rownames-p "1" "NULL"))) (if (= max min) - (format "%s <- read.table(\"%s\", - header=%s, - row.names=%s, - sep=\"\\t\", - as.is=TRUE)" name file header row-names) - (format "%s <- read.table(\"%s\", - header=%s, - row.names=%s, - sep=\"\\t\", - as.is=TRUE, - fill=TRUE, - col.names = paste(\"V\", seq_len(%d), sep =\"\"))" + (format ob-R-transfer-variable-table-with-header + name file header row-names) + (format ob-R-transfer-variable-table-without-header name file header row-names max)))) - (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) + (cond ((integerp value) (format "%s <- %s" name (concat (number-to-string value) "L"))) + ((floatp value) (format "%s <- %s" name value)) + ((stringp value) (format "%s <- %S" name (org-no-properties value))) + (t (format "%s <- %S" name (prin1-to-string value)))))) + (defvar ess-ask-for-ess-directory) ; dynamically scoped (defun org-babel-R-initiate-session (session params) @@ -209,8 +260,9 @@ This function is called by `org-babel-execute-src-block'." (unless (string= session "none") (let ((session (or session "*R*")) (ess-ask-for-ess-directory - (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) - (not (cdr (assoc :dir params)))))) + (and (boundp 'ess-ask-for-ess-directory) + ess-ask-for-ess-directory + (not (cdr (assq :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion @@ -218,6 +270,10 @@ This function is called by `org-babel-execute-src-block'." ;; Session buffer exists, but with dead process (set-buffer session)) (require 'ess) (R) + (let ((R-proc (get-process (or ess-local-process-name + ess-current-process-name)))) + (while (process-get R-proc 'callbacks) + (ess-wait-for-process R-proc))) (rename-buffer (if (bufferp session) (buffer-name session) @@ -234,11 +290,6 @@ current code buffer." (process-name (get-buffer-process session))) (ess-make-buffer-current)) -(defun org-babel-R-graphical-output-file (params) - "Name of file to which R should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - (defvar org-babel-R-graphics-devices '((:bmp "bmp" "filename") (:jpg "jpeg" "filename") @@ -265,8 +316,7 @@ Each member of this list is a list with three members: :type :family :title :fonts :version :paper :encoding :pagecentre :colormodel :useDingbats :horizontal)) - (device (and (string-match ".+\\.\\([^.]+\\)" out-file) - (match-string 1 out-file))) + (device (file-name-extension out-file)) (device-info (or (assq (intern (concat ":" device)) org-babel-R-graphics-devices) (assq :png org-babel-R-graphics-devices))) @@ -280,14 +330,43 @@ Each member of this list is a list with three members: (substring (symbol-name (car pair)) 1) (cdr pair)) "")) params "")) - (format "%s(%s=\"%s\"%s%s%s)" + (format "%s(%s=\"%s\"%s%s%s); tryCatch({" device filearg out-file args (if extra-args "," "") (or extra-args "")))) -(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") -(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") - -(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")") +(defconst org-babel-R-eoe-indicator "'org_babel_R_eoe'") +(defconst org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") + +(defconst org-babel-R-write-object-command "{ + function(object,transfer.file) { + object + invisible( + if ( + inherits( + try( + { + tfile<-tempfile() + write.table(object, file=tfile, sep=\"\\t\", + na=\"nil\",row.names=%s,col.names=%s, + quote=FALSE) + file.rename(tfile,transfer.file) + }, + silent=TRUE), + \"try-error\")) + { + if(!file.exists(transfer.file)) + file.create(transfer.file) + } + ) + } +}(object=%s,transfer.file=\"%s\")" + "A template for an R command to evaluate a block of code and write the result to a file. + +Has four %s escapes to be filled in: +1. Row names, \"TRUE\" or \"FALSE\" +2. Column names, \"TRUE\" or \"FALSE\" +3. The code to be run (must be an expression, not a statement) +4. The name of the file to write to") (defun org-babel-R-evaluate (session body result-type result-params column-names-p row-names-p) @@ -299,12 +378,12 @@ Each member of this list is a list with three members: body result-type result-params column-names-p row-names-p))) (defun org-babel-R-evaluate-external-process - (body result-type result-params column-names-p row-names-p) + (body result-type result-params column-names-p row-names-p) "Evaluate BODY in external R process. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (let ((tmp-file (org-babel-temp-file "R-"))) (org-babel-eval org-babel-R-command @@ -319,7 +398,7 @@ last statement in BODY, as elisp." (org-babel-result-cond result-params (with-temp-buffer (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-chomp (buffer-string) "\n")) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output (org-babel-eval org-babel-R-command body)))) @@ -327,12 +406,12 @@ last statement in BODY, as elisp." (defvar ess-eval-visibly-p) (defun org-babel-R-evaluate-session - (session body result-type result-params column-names-p row-names-p) + (session body result-type result-params column-names-p row-names-p) "Evaluate BODY in SESSION. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." - (case result-type + (cl-case result-type (value (with-temp-buffer (insert (org-babel-chomp body)) @@ -353,12 +432,12 @@ last statement in BODY, as elisp." (org-babel-result-cond result-params (with-temp-buffer (insert-file-contents tmp-file) - (buffer-string)) + (org-babel-chomp (buffer-string) "\n")) (org-babel-import-elisp-from-file tmp-file '(16))) column-names-p))) (output (mapconcat - #'org-babel-chomp + 'org-babel-chomp (butlast (delq nil (mapcar @@ -366,11 +445,12 @@ last statement in BODY, as elisp." (mapcar (lambda (line) ;; cleanup extra prompts left in output (if (string-match - "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + "^\\([>+.]\\([ ][>.+]\\)*[ ]\\)" + (car (split-string line "\n"))) (substring line (match-end 1)) line)) (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat #'org-babel-chomp + (insert (mapconcat 'org-babel-chomp (list body org-babel-R-eoe-indicator) "\n")) (inferior-ess-send-input)))))) "\n")))) diff --git a/lisp/org/ob-abc.el b/lisp/org/ob-abc.el new file mode 100644 index 0000000000..0ce503d3b0 --- /dev/null +++ b/lisp/org/ob-abc.el @@ -0,0 +1,92 @@ +;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. + +;; Author: William Waites +;; Keywords: literate programming, music +;; Homepage: http://www.tardis.ed.ac.uk/wwaites +;; Version: 0.01 + +;;; License: + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; This file adds support to Org Babel for music in ABC notation. +;;; It requires that the abcm2ps program is installed. +;;; See http://moinejf.free.fr/ + +(require 'ob) + +;; optionally define a file extension for this language +(add-to-list 'org-babel-tangle-lang-exts '("abc" . "abc")) + +;; optionally declare default header arguments for this language +(defvar org-babel-default-header-args:abc + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating an ABC source block.") + +(defun org-babel-expand-body:abc (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (org-babel--get-vars params))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:abc (body params) + "Execute a block of ABC code with org-babel. This function is + called by `org-babel-execute-src-block'" + (message "executing Abc source code block") + (let* ((cmdline (cdr (assq :cmdline params))) + (out-file (let ((file (cdr (assq :file params)))) + (if file (replace-regexp-in-string "\.pdf$" ".ps" file) + (error "abc code block requires :file header argument")))) + (in-file (org-babel-temp-file "abc-")) + (render (concat "abcm2ps" " " cmdline + " -O " (org-babel-process-file-name out-file) + " " (org-babel-process-file-name in-file)))) + (with-temp-file in-file (insert (org-babel-expand-body:abc body params))) + (org-babel-eval render "") + ;;; handle where abcm2ps changes the file name (to support multiple files + (when (or (string= (file-name-extension out-file) "eps") + (string= (file-name-extension out-file) "svg")) + (rename-file (concat + (file-name-sans-extension out-file) "001." + (file-name-extension out-file)) + out-file t)) + ;;; if we were asked for a pdf... + (when (string= (file-name-extension (cdr (assq :file params))) "pdf") + (org-babel-eval (concat "ps2pdf" " " out-file " " (cdr (assq :file params))) "")) + ;;; indicate that the file has been written + nil)) + +;; This function should be used to assign any variables in params in +;; the context of the session environment. +(defun org-babel-prep-session:abc (_session _params) + "Return an error because abc does not support sessions." + (error "ABC does not support sessions")) + +(provide 'ob-abc) +;;; ob-abc.el ends here diff --git a/lisp/org/ob-asymptote.el b/lisp/org/ob-asymptote.el index e3b73c19ac..1dbf48427f 100644 --- a/lisp/org/ob-asymptote.el +++ b/lisp/org/ob-asymptote.el @@ -1,4 +1,4 @@ -;;; ob-asymptote.el --- org-babel functions for asymptote evaluation +;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -43,11 +43,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) -(declare-function org-combine-plists "org" (&rest plists)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) @@ -59,13 +54,10 @@ (defun org-babel-execute:asymptote (body params) "Execute a block of Asymptote code. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (format (or (and out-file - (string-match ".+\\.\\(.+\\)" out-file) - (match-string 1 out-file)) + (let* ((out-file (cdr (assq :file params))) + (format (or (file-name-extension out-file) "pdf")) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "asymptote-")) (cmd (concat "asy " @@ -83,7 +75,7 @@ This function is called by `org-babel-execute-src-block'." (message cmd) (shell-command cmd) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:asymptote (session params) +(defun org-babel-prep-session:asymptote (_session _params) "Return an error if the :session header argument is set. Asymptote does not support sessions" (error "Asymptote does not support sessions")) @@ -91,7 +83,7 @@ Asymptote does not support sessions" (defun org-babel-variable-assignments:asymptote (params) "Return list of asymptote statements assigning the block's variables." (mapcar #'org-babel-asymptote-var-to-asymptote - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-asymptote-var-to-asymptote (pair) "Convert an elisp value into an Asymptote variable. @@ -128,21 +120,17 @@ a variable of the same value." DATA is a list. Return type as a symbol. -The type is `string' if any element in DATA is -a string. Otherwise, it is either `real', if some elements are -floats, or `int'." - (let* ((type 'int) - find-type ; for byte-compiler - (find-type - (function - (lambda (row) - (catch 'exit - (mapc (lambda (el) - (cond ((listp el) (funcall find-type el)) - ((stringp el) (throw 'exit (setq type 'string))) - ((floatp el) (setq type 'real)))) - row)))))) - (funcall find-type data) type)) +The type is `string' if any element in DATA is a string. +Otherwise, it is either `real', if some elements are floats, or +`int'." + (letrec ((type 'int) + (find-type + (lambda (row) + (dolist (e row type) + (cond ((listp e) (setq type (funcall find-type e))) + ((stringp e) (throw 'exit 'string)) + ((floatp e) (setq type 'real))))))) + (catch 'exit (funcall find-type data)) type)) (provide 'ob-asymptote) diff --git a/lisp/org/ob-awk.el b/lisp/org/ob-awk.el index c2ac5cac3b..2db4eeae94 100644 --- a/lisp/org/ob-awk.el +++ b/lisp/org/ob-awk.el @@ -1,4 +1,4 @@ -;;; ob-awk.el --- org-babel functions for awk evaluation +;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -27,17 +27,15 @@ ;; ;; - :in-file takes a path to a file of data to be processed by awk ;; -;; - :stdin takes an Org-mode data or code block reference, the value -;; of which will be passed to the awk process through STDIN +;; - :stdin takes an Org data or code block reference, the value of +;; which will be passed to the awk process through STDIN ;;; Code: (require 'ob) (require 'org-compat) -(eval-when-compile (require 'cl)) (declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) +(declare-function orgtbl-to-generic "org-table" (table params)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk")) @@ -45,34 +43,38 @@ (defvar org-babel-awk-command "awk" "Name of the awk executable command.") -(defun org-babel-expand-body:awk (body params) +(defun org-babel-expand-body:awk (body _params) "Expand BODY according to PARAMS, return the expanded body." - (dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) - (setf body (replace-regexp-in-string - (regexp-quote (format "$%s" (car pair))) (cdr pair) body))) body) (defun org-babel-execute:awk (body params) "Execute a block of Awk code with org-babel. This function is called by `org-babel-execute-src-block'" (message "executing Awk source code block") - (let* ((result-params (cdr (assoc :result-params params))) - (cmd-line (cdr (assoc :cmd-line params))) - (in-file (cdr (assoc :in-file params))) + (let* ((result-params (cdr (assq :result-params params))) + (cmd-line (cdr (assq :cmd-line params))) + (in-file (cdr (assq :in-file params))) (full-body (org-babel-expand-body:awk body params)) (code-file (let ((file (org-babel-temp-file "awk-"))) (with-temp-file file (insert full-body)) file)) - (stdin (let ((stdin (cdr (assoc :stdin params)))) + (stdin (let ((stdin (cdr (assq :stdin params)))) (when stdin (let ((tmp (org-babel-temp-file "awk-stdin-")) (res (org-babel-ref-resolve stdin))) (with-temp-file tmp (insert (org-babel-awk-var-to-awk res))) tmp)))) - (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command - "-f" code-file - cmd-line - in-file)) + (cmd (mapconcat #'identity + (append + (list org-babel-awk-command + "-f" code-file cmd-line) + (mapcar (lambda (pair) + (format "-v %s='%s'" + (car pair) + (org-babel-awk-var-to-awk + (cdr pair)))) + (org-babel--get-vars params)) + (list in-file)) " "))) (org-babel-reassemble-table (let ((results @@ -88,9 +90,9 @@ called by `org-babel-execute-src-block'" (with-temp-file tmp (insert results)) (org-babel-import-elisp-from-file tmp))))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defun org-babel-awk-var-to-awk (var &optional sep) "Return a printed value of VAR suitable for parsing with awk." @@ -102,11 +104,6 @@ called by `org-babel-execute-src-block'" (mapconcat echo-var var "\n")) (t (funcall echo-var var))))) -(defun org-babel-awk-table-or-string (results) - "If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - (provide 'ob-awk) diff --git a/lisp/org/ob-calc.el b/lisp/org/ob-calc.el index 6298bba522..d4b7260c57 100644 --- a/lisp/org/ob-calc.el +++ b/lisp/org/ob-calc.el @@ -1,4 +1,4 @@ -;;; ob-calc.el --- org-babel functions for calc code evaluation +;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -28,18 +28,18 @@ ;;; Code: (require 'ob) (require 'calc) -(unless (featurep 'xemacs) - (require 'calc-trail) - (require 'calc-store)) +(require 'calc-trail) +(require 'calc-store) (declare-function calc-store-into "calc-store" (&optional var)) (declare-function calc-recall "calc-store" (&optional var)) (declare-function math-evaluate-expr "calc-ext" (x)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-default-header-args:calc nil "Default arguments for evaluating an calc source block.") -(defun org-babel-expand-body:calc (body params) +(defun org-babel-expand-body:calc (body _params) "Expand BODY according to PARAMS, return the expanded body." body) (defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc @@ -48,7 +48,7 @@ "Execute a block of calc code with Babel." (unless (get-buffer "*Calculator*") (save-window-excursion (calc) (calc-quit))) - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (let* ((vars (org-babel--get-vars params)) (org--var-syms (mapcar #'car vars)) (var-names (mapcar #'symbol-name org--var-syms))) (mapc @@ -85,15 +85,17 @@ ;; parse line into calc objects (car (math-read-exprs line))))))))) )))))) - (mapcar #'org-babel-trim + (mapcar #'org-trim (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (save-excursion (with-current-buffer (get-buffer "*Calculator*") - (calc-eval (calc-top 1))))) + (prog1 + (calc-eval (calc-top 1)) + (calc-pop 1))))) (defun org-babel-calc-maybe-resolve-var (el) (if (consp el) - (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) + (if (and (eq 'var (car el)) (member (cadr el) org--var-syms)) (progn (calc-recall (cadr el)) (prog1 (calc-top 1) diff --git a/lisp/org/ob-clojure.el b/lisp/org/ob-clojure.el index b9af45adfe..39561572a5 100644 --- a/lisp/org/ob-clojure.el +++ b/lisp/org/ob-clojure.el @@ -1,9 +1,9 @@ -;;; ob-clojure.el --- org-babel functions for clojure evaluation +;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. -;; Author: Joel Boehland -;; Eric Schulte +;; Author: Joel Boehland, Eric Schulte, Oleh Krehel +;; ;; Keywords: literate programming, reproducible research ;; Homepage: http://orgmode.org @@ -24,21 +24,30 @@ ;;; Commentary: -;; Support for evaluating clojure code, relies on slime for all eval. +;; Support for evaluating clojure code -;;; Requirements: +;; Requirements: ;; - clojure (at least 1.2.0) ;; - clojure-mode -;; - slime +;; - either cider or SLIME -;; By far, the best way to install these components is by following +;; For Cider, see https://github.com/clojure-emacs/cider + +;; For SLIME, the best way to install these components is by following ;; the directions as set out by Phil Hagelberg (Technomancy) on the ;; web page: http://technomancy.us/126 ;;; Code: +(require 'cl-lib) (require 'ob) +(declare-function cider-current-connection "ext:cider-client" (&optional type)) +(declare-function cider-current-session "ext:cider-client" ()) +(declare-function nrepl-dict-get "ext:nrepl-client" (dict key)) +(declare-function nrepl-sync-request:eval "ext:nrepl-client" + (input connection session &optional ns)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function slime-eval "ext:slime" (sexp &optional package)) (defvar org-babel-tangle-lang-exts) @@ -47,49 +56,63 @@ (defvar org-babel-default-header-args:clojure '()) (defvar org-babel-header-args:clojure '((package . :any))) +(defcustom org-babel-clojure-backend + (cond ((featurep 'cider) 'cider) + (t 'slime)) + "Backend used to evaluate Clojure code blocks." + :group 'org-babel + :type '(choice + (const :tag "cider" cider) + (const :tag "SLIME" slime))) + (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let [" - (mapconcat - (lambda (var) - (format "%S (quote %S)" (car var) (cdr var))) - vars "\n ") - "]\n" body ")") - body)))) - (cond ((or (member "code" result-params) (member "pp" result-params)) - (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] " - "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch " - "(clojure.pprint/pprint (do %s) org-mode-print-catcher) " - "(str org-mode-print-catcher)))") - (if (member "code" result-params) "code" "simple") body)) - ;; if (:results output), collect printed output - ((member "output" result-params) - (format "(clojure.core/with-out-str %s)" body)) - (t body)))) + (body (org-trim + (if (null vars) (org-trim body) + (concat "(let [" + (mapconcat + (lambda (var) + (format "%S (quote %S)" (car var) (cdr var))) + vars "\n ") + "]\n" body ")"))))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (format "(clojure.pprint/pprint (do %s))" body) + body))) (defun org-babel-execute:clojure (body params) "Execute a block of Clojure code with Babel." - (require 'slime) - (with-temp-buffer - (insert (org-babel-expand-body:clojure body params)) - (let ((result - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params))))) - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - result - (condition-case nil (org-babel-script-escape result) - (error result))))))) + (let ((expanded (org-babel-expand-body:clojure body params)) + result) + (cl-case org-babel-clojure-backend + (cider + (require 'cider) + (let ((result-params (cdr (assq :result-params params)))) + (setq result + (nrepl-dict-get + (nrepl-sync-request:eval + expanded (cider-current-connection) (cider-current-session)) + (if (or (member "output" result-params) + (member "pp" result-params)) + "out" + "value"))))) + (slime + (require 'slime) + (with-temp-buffer + (insert expanded) + (setq result + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result + (condition-case nil (org-babel-script-escape result) + (error result))))) (provide 'ob-clojure) - - ;;; ob-clojure.el ends here diff --git a/lisp/org/ob-comint.el b/lisp/org/ob-comint.el index 78c5021b1b..cc60f4e4a7 100644 --- a/lisp/org/ob-comint.el +++ b/lisp/org/ob-comint.el @@ -1,4 +1,4 @@ -;;; ob-comint.el --- org-babel functions for interaction with comint buffers +;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -33,10 +33,7 @@ (require 'ob-core) (require 'org-compat) (require 'comint) -(eval-when-compile (require 'cl)) -(declare-function with-parsed-tramp-file-name "tramp" - (filename var &rest body) t) -(declare-function tramp-flush-directory-property "tramp-cache" (key directory)) +(require 'tramp) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -49,12 +46,14 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is executed inside the protection of `save-excursion' and `save-match-data'." (declare (indent 1)) - `(save-excursion + `(progn + (unless (org-babel-comint-buffer-livep ,buffer) + (error "Buffer %s does not exist or has no process" ,buffer)) (save-match-data - (unless (org-babel-comint-buffer-livep ,buffer) - (error "Buffer %s does not exist or has no process" ,buffer)) - (set-buffer ,buffer) - ,@body))) + (with-current-buffer ,buffer + (save-excursion + (let ((comint-input-filter (lambda (_input) nil))) + ,@body)))))) (def-edebug-spec org-babel-comint-in-buffer (form body)) (defmacro org-babel-comint-with-output (meta &rest body) @@ -70,53 +69,49 @@ elements are optional. This macro ensures that the filter is removed in case of an error or user `keyboard-quit' during execution of body." (declare (indent 1)) - (let ((buffer (car meta)) - (eoe-indicator (cadr meta)) - (remove-echo (cadr (cdr meta))) - (full-body (cadr (cdr (cdr meta))))) + (let ((buffer (nth 0 meta)) + (eoe-indicator (nth 1 meta)) + (remove-echo (nth 2 meta)) + (full-body (nth 3 meta))) `(org-babel-comint-in-buffer ,buffer - (let ((string-buffer "") dangling-text raw) - ;; setup filter - (setq comint-output-filter-functions + (let* ((string-buffer "") + (comint-output-filter-functions (cons (lambda (text) (setq string-buffer (concat string-buffer text))) comint-output-filter-functions)) - (unwind-protect - (progn - ;; got located, and save dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (let ((start (point)) - (end (point-max))) - (setq dangling-text (buffer-substring start end)) - (delete-region start end)) - ;; pass FULL-BODY to process - ,@body - ;; wait for end-of-evaluation indicator - (while (progn - (goto-char comint-last-input-end) - (not (save-excursion - (and (re-search-forward - (regexp-quote ,eoe-indicator) nil t) - (re-search-forward - comint-prompt-regexp nil t))))) - (accept-process-output (get-buffer-process (current-buffer))) - ;; thought the following this would allow async - ;; background running, but I was wrong... - ;; (run-with-timer .5 .5 'accept-process-output - ;; (get-buffer-process (current-buffer))) - ) - ;; replace cut dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert dangling-text)) - ;; remove filter - (setq comint-output-filter-functions - (cdr comint-output-filter-functions))) + dangling-text) + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + comint-prompt-regexp nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text) + ;; remove echo'd FULL-BODY from input - (if (and ,remove-echo ,full-body - (string-match - (replace-regexp-in-string - "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) - string-buffer)) - (setq raw (substring string-buffer (match-end 0)))) + (when (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq string-buffer (substring string-buffer (match-end 0)))) (split-string string-buffer comint-prompt-regexp))))) (def-edebug-spec org-babel-comint-with-output (sexp body)) @@ -149,15 +144,14 @@ Don't return until FILE exists. Code in STRING must ensure that FILE exists at end of evaluation." (unless (org-babel-comint-buffer-livep buffer) (error "Buffer %s does not exist or has no process" buffer)) - (if (file-exists-p file) (delete-file file)) + (when (file-exists-p file) (delete-file file)) (process-send-string (get-buffer-process buffer) - (if (string-match "\n$" string) string (concat string "\n"))) + (if (= (aref string (1- (length string))) ?\n) string (concat string "\n"))) ;; From Tramp 2.1.19 the following cache flush is not necessary - (if (file-remote-p default-directory) - (let (v) - (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v "")))) + (when (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v ""))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/org/ob-coq.el b/lisp/org/ob-coq.el new file mode 100644 index 0000000000..93d2b1f713 --- /dev/null +++ b/lisp/org/ob-coq.el @@ -0,0 +1,78 @@ +;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*- + +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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: + +;; Rudimentary support for evaluating Coq code blocks. Currently only +;; session evaluation is supported. Requires both coq.el and +;; coq-inferior.el, both of which are distributed with Coq. +;; +;; http://coq.inria.fr/ + +;;; Code: +(require 'ob) + +(declare-function run-coq "ext:coq-inferior.el" (cmd)) +(declare-function coq-proc "ext:coq-inferior.el" ()) + +(defvar coq-program-name "coqtop" + "Name of the coq toplevel to run.") + +(defvar org-babel-coq-buffer "*coq*" + "Buffer in which to evaluate coq code blocks.") + +(defun org-babel-coq-clean-prompt (string) + (if (string-match "^[^[:space:]]+ < " string) + (substring string 0 (match-beginning 0)) + string)) + +(defun org-babel-execute:coq (body params) + (let ((full-body (org-babel-expand-body:generic body params)) + (session (org-babel-coq-initiate-session)) + (pt (lambda () + (marker-position + (process-mark (get-buffer-process (current-buffer))))))) + (org-babel-coq-clean-prompt + (org-babel-comint-in-buffer session + (let ((start (funcall pt))) + (with-temp-buffer + (insert full-body) + (comint-send-region (coq-proc) (point-min) (point-max)) + (comint-send-string (coq-proc) + (if (string= (buffer-substring (- (point-max) 1) (point-max)) ".") + "\n" + ".\n"))) + (while (equal start (funcall pt)) (sleep-for 0.1)) + (buffer-substring start (funcall pt))))))) + +(defun org-babel-coq-initiate-session () + "Initiate a coq session. +If there is not a current inferior-process-buffer in SESSION then +create one. Return the initialized session." + (unless (fboundp 'run-coq) + (error "`run-coq' not defined, load coq-inferior.el")) + (save-window-excursion (run-coq coq-program-name)) + (sit-for 0.1) + (get-buffer org-babel-coq-buffer)) + +(provide 'ob-coq) diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index cfbcbe6ece..c630b70f91 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -1,4 +1,4 @@ -;;; ob-core.el --- working with code blocks in org-mode +;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -23,8 +23,7 @@ ;; along with GNU Emacs. If not, see . ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'ob-eval) (require 'org-macs) (require 'org-compat) @@ -33,66 +32,70 @@ (if (memq system-type '(windows-nt cygwin)) ".exe" nil)) -;; dynamically scoped for tramp -(defvar org-babel-call-process-region-original nil) -(defvar org-src-lang-modes) + (defvar org-babel-library-of-babel) -(declare-function outline-show-all "outline" ()) -(declare-function org-every "org" (pred seq)) -(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(defvar org-edit-src-content-indentation) +(defvar org-src-lang-modes) +(defvar org-src-preserve-indentation) + +(declare-function org-at-item-p "org-list" ()) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) +(declare-function org-babel-ref-headline-body "ob-ref" ()) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-current-level "org" ()) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-edit-src-code "org-src" (&optional code edit-buffer-name)) +(declare-function org-edit-src-exit "org-src" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-escape-code-in-region "org-src" (beg end)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-in-regexp "org" (regexp &optional nlines visually)) +(declare-function org-indent-line "org" ()) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-to-generic "org-list" (LIST PARAMS)) +(declare-function org-list-to-lisp "org-list" (&optional delete)) +(declare-function org-macro-escape-arguments "org-macro" (&rest args)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function tramp-compat-make-temp-file "tramp-compat" - (filename &optional dir-flag)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name)) -(declare-function org-edit-src-exit "org-src" (&optional context)) -(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-outline-overlay-data "org" (&optional use-markers)) -(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) -(declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-next-block "org" (arg &optional backward block-regexp)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) (declare-function org-previous-block "org" (arg &optional block-regexp)) +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-reverse-string "org" (string)) +(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-uniquify "org" (list)) -(declare-function org-current-level "org" ()) -(declare-function org-table-import "org-table" (file arg)) -(declare-function org-add-hook "org-compat" - (hook function &optional append local)) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-src-coderef-format "org-src" (element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) -(declare-function orgtbl-to-orgtbl "org-table" (table params)) -(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) -(declare-function org-babel-lob-get-info "ob-lob" nil) -(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) -(declare-function org-babel-ref-parse "ob-ref" (assignment)) -(declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) -(declare-function org-babel-ref-headline-body "ob-ref" ()) -(declare-function org-babel-lob-execute-maybe "ob-lob" ()) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-list-parse-list "org-list" (&optional delete)) -(declare-function org-list-to-generic "org-list" (LIST PARAMS)) -(declare-function org-list-struct "org-list" ()) -(declare-function org-list-prevs-alist "org-list" (struct)) -(declare-function org-list-get-list-end "org-list" (item struct prevs)) -(declare-function org-remove-if "org" (predicate seq)) -(declare-function org-completing-read "org" (&rest args)) -(declare-function org-escape-code-in-region "org-src" (beg end)) -(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function org-table-import "org-table" (file arg)) (declare-function org-table-to-lisp "org-table" (&optional txt)) -(declare-function org-reverse-string "org" (string)) -(declare-function org-element-context "org-element" (&optional ELEMENT)) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function org-uniquify "org" (list)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function outline-show-all "outline" ()) +(declare-function tramp-compat-make-temp-file "tramp-compat" (filename &optional dir-flag)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -101,11 +104,12 @@ (defcustom org-confirm-babel-evaluate t "Confirm before evaluation. +\\\ Require confirmation before interactively evaluating code -blocks in Org-mode buffers. The default value of this variable -is t, meaning confirmation is required for any code block -evaluation. This variable can be set to nil to inhibit any -future confirmation requests. This variable can also be set to a +blocks in Org buffers. The default value of this variable is t, +meaning confirmation is required for any code block evaluation. +This variable can be set to nil to inhibit any future +confirmation requests. This variable can also be set to a function which takes two arguments the language of the code block and the body of the code block. Such a function should then return a non-nil value if the user should be prompted for @@ -113,10 +117,11 @@ execution or nil if no prompt is required. Warning: Disabling confirmation may result in accidental evaluation of potentially harmful code. It may be advisable -remove code block execution from C-c C-c as further protection +remove code block execution from `\\[org-ctrl-c-ctrl-c]' \ +as further protection against accidental code block evaluation. The `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to -remove code block execution from the C-c C-c keybinding." +remove code block execution from the `\\[org-ctrl-c-ctrl-c]' keybinding." :group 'org-babel :version "24.1" :type '(choice boolean function)) @@ -124,19 +129,24 @@ remove code block execution from the C-c C-c keybinding." (put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) (defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil - "Remove code block evaluation from the C-c C-c key binding." + "\\\ +Remove code block evaluation from the `\\[org-ctrl-c-ctrl-c]' key binding." :group 'org-babel :version "24.1" :type 'boolean) (defcustom org-babel-results-keyword "RESULTS" "Keyword used to name results generated by code blocks. -Should be either RESULTS or NAME however any capitalization may -be used." +It should be \"RESULTS\". However any capitalization may be +used." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type 'string + :safe (lambda (v) + (and (stringp v) + (eq (compare-strings "RESULTS" nil nil v nil nil t) + t)))) (defcustom org-babel-noweb-wrap-start "<<" "String used to begin a noweb reference in a code block. @@ -155,6 +165,19 @@ See also `org-babel-noweb-wrap-start'." This string must include a \"%s\" which will be replaced by the results." :group 'org-babel :type 'string) +(put 'org-babel-inline-result-wrap + 'safe-local-variable + (lambda (value) + (and (stringp value) + (string-match-p "%s" value)))) + +(defcustom org-babel-hash-show-time nil + "Non-nil means show the time the code block was evaluated in the result hash." + :group 'org-babel + :type 'boolean + :version "26.1" + :package-version '(Org . "9.0") + :safe #'booleanp) (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start @@ -169,14 +192,6 @@ This string must include a \"%s\" which will be replaced by the results." "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" "Regular expression used to match multi-line header arguments.") -(defvar org-babel-src-name-w-name-regexp - (concat org-babel-src-name-regexp - "\\(" - org-babel-multi-line-header-regexp - "\\)*" - "\\([^ ()\f\t\n\r\v]+\\)") - "Regular expression matching source name lines with a name.") - (defvar org-babel-src-block-regexp (concat ;; (1) indentation (2) lang @@ -189,168 +204,100 @@ This string must include a \"%s\" which will be replaced by the results." "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") "Regexp used to identify code blocks.") -(defvar org-babel-inline-src-block-regexp - (concat - ;; (1) replacement target (2) lang - "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" - ;; (3,4) (unused, headers) - "\\(\\|\\[\\(.*?\\)\\]\\)" - ;; (5) body - "{\\([^\f\n\r\v]+?\\)}\\)") - "Regexp used to identify inline src-blocks.") - -(defun org-babel-get-header (params key &optional others) - "Select only header argument of type KEY from a list. -Optional argument OTHERS indicates that only the header that do -not match KEY should be returned." - (delq nil - (mapcar - (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) - params))) - -(defun org-babel-get-inline-src-block-matches() - "Set match data if within body of an inline source block. -Returns non-nil if match-data set" - (let ((src-at-0-p (save-excursion - (beginning-of-line 1) - (string= "src" (thing-at-point 'word)))) - (first-line-p (= (line-beginning-position) (point-min))) - (orig (point))) - (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) - (first-line-p "[[:punct:] \t]src_") - (t "[[:punct:] \f\t\n\r\v]src_"))) - (lower-limit (if first-line-p - nil - (- (point-at-bol) 1)))) - (save-excursion - (when (or (and src-at-0-p (bobp)) - (and (re-search-forward "}" (point-at-eol) t) - (re-search-backward search-for lower-limit t) - (> orig (point)))) - (when (looking-at org-babel-inline-src-block-regexp) - t )))))) - -(defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches() - "Set match data if on line of an lob one liner. -Returns non-nil if match-data set" - (save-excursion - (unless (= (point) (point-at-bol)) ;; move before inline block - (re-search-backward "[ \f\t\n\r\v]" nil t)) - (if (looking-at org-babel-inline-lob-one-liner-regexp) - t - nil))) - -(defun org-babel-get-src-block-info (&optional light) - "Get information on the current source block. - -Optional argument LIGHT does not resolve remote variable -references; a process which could likely result in the execution -of other code blocks. +(defun org-babel--get-vars (params) + "Return the babel variable assignments in PARAMS. + +PARAMS is a quasi-alist of header args, which may contain +multiple entries for the key `:var'. This function returns a +list of the cdr of all the `:var' entries." + (mapcar #'cdr + (cl-remove-if-not (lambda (x) (eq (car x) :var)) params))) + +(defvar org-babel-exp-reference-buffer nil + "Buffer containing original contents of the exported buffer. +This is used by Babel to resolve references in source blocks. +Its value is dynamically bound during export.") + +(defun org-babel-check-confirm-evaluate (info) + "Check whether INFO allows code block evaluation. + +Returns nil if evaluation is disallowed, t if it is +unconditionally allowed, and the symbol `query' if the user +should be asked whether to allow evaluation." + (let* ((headers (nth 2 info)) + (eval (or (cdr (assq :eval headers)) + (when (assq :noeval headers) "no"))) + (eval-no (member eval '("no" "never"))) + (export org-babel-exp-reference-buffer) + (eval-no-export (and export (member eval '("no-export" "never-export")))) + (noeval (or eval-no eval-no-export)) + (query (or (equal eval "query") + (and export (equal eval "query-export")) + (if (functionp org-confirm-babel-evaluate) + (save-excursion + (goto-char (nth 5 info)) + (funcall org-confirm-babel-evaluate + ;; language, code block body + (nth 0 info) (nth 1 info))) + org-confirm-babel-evaluate)))) + (cond + (noeval nil) + (query 'query) + (t t)))) -Returns a list - (language body header-arguments-alist switches name indent block-head)." - (let ((case-fold-search t) head info name indent) - ;; full code block - (if (setq head (org-babel-where-is-src-block-head)) - (save-excursion - (goto-char head) - (setq info (org-babel-parse-src-block-match)) - (setq indent (car (last info))) - (setq info (butlast info)) - (while (and (forward-line -1) - (looking-at org-babel-multi-line-header-regexp)) - (setf (nth 2 info) - (org-babel-merge-params - (nth 2 info) - (org-babel-parse-header-arguments (match-string 1))))) - (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-no-properties (match-string 3))))) - ;; inline source block - (when (org-babel-get-inline-src-block-matches) - (setq info (org-babel-parse-inline-src-block-match)))) - ;; resolve variable references and add summary parameters - (when (and info (not light)) - (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) - (when info (append info (list name indent head))))) - -(defvar org-current-export-file) ; dynamically bound -(defmacro org-babel-check-confirm-evaluate (info &rest body) - "Evaluate BODY with special execution confirmation variables set. - -Specifically; NOEVAL will indicate if evaluation is allowed, -QUERY will indicate if a user query is required, CODE-BLOCK will -hold the language of the code block, and BLOCK-NAME will hold the -name of the code block." - (declare (indent defun)) - (org-with-gensyms - (lang block-body headers name eval eval-no export eval-no-export) - `(let* ((,lang (nth 0 ,info)) - (,block-body (nth 1 ,info)) - (,headers (nth 2 ,info)) - (,name (nth 4 ,info)) - (,eval (or (cdr (assoc :eval ,headers)) - (when (assoc :noeval ,headers) "no"))) - (,eval-no (or (equal ,eval "no") - (equal ,eval "never"))) - (,export (org-bound-and-true-p org-current-export-file)) - (,eval-no-export (and ,export (or (equal ,eval "no-export") - (equal ,eval "never-export")))) - (noeval (or ,eval-no ,eval-no-export)) - (query (or (equal ,eval "query") - (and ,export (equal ,eval "query-export")) - (if (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - ,lang ,block-body) - org-confirm-babel-evaluate))) - (code-block (if ,info (format " %s " ,lang) " ")) - (block-name (if ,name (format " (%s) " ,name) " "))) - ;; Silence byte-compiler is `body' doesn't use those vars. - (ignore noeval query) - ,@body))) - -(defsubst org-babel-check-evaluate (info) +(defun org-babel-check-evaluate (info) "Check if code block INFO should be evaluated. -Do not query the user." - (org-babel-check-confirm-evaluate info - (not (when noeval - (message "Evaluation of this%scode-block%sis disabled." - code-block block-name))))) - - ;; dynamically scoped for asynchronous export +Do not query the user, but do display an informative message if +evaluation is blocked. Returns non-nil if evaluation is not blocked." + (let ((confirmed (org-babel-check-confirm-evaluate info))) + (unless confirmed + (message "Evaluation of this %s code block%sis disabled." + (nth 0 info) + (let ((name (nth 4 info))) + (if name (format " (%s) " name) " ")))) + confirmed)) + +;; Dynamically scoped for asynchronous export. (defvar org-babel-confirm-evaluate-answer-no) -(defsubst org-babel-confirm-evaluate (info) +(defun org-babel-confirm-evaluate (info) "Confirm evaluation of the code block INFO. -If the variable `org-babel-confirm-evaluate-answer-no' is bound -to a non-nil value, auto-answer with \"no\". - This query can also be suppressed by setting the value of `org-confirm-babel-evaluate' to nil, in which case all future interactive code block evaluations will proceed without any confirmation from the user. Note disabling confirmation may result in accidental evaluation -of potentially harmful code." - (org-babel-check-confirm-evaluate info - (not (when query - (unless - (and (not (org-bound-and-true-p +of potentially harmful code. + +The variable `org-babel-confirm-evaluate-answer-no' is used by +the async export process, which requires a non-interactive +environment, to override this check." + (let* ((evalp (org-babel-check-confirm-evaluate info)) + (lang (nth 0 info)) + (name (nth 4 info)) + (name-string (if name (format " (%s) " name) " "))) + (pcase evalp + (`nil nil) + (`t t) + (`query (or + (and (not (bound-and-true-p org-babel-confirm-evaluate-answer-no)) (yes-or-no-p - (format "Evaluate this%scode block%son your system? " - code-block block-name))) - (message "Evaluation of this%scode-block%sis aborted." - code-block block-name)))))) + (format "Evaluate this %s code block%son your system? " + lang name-string))) + (progn + (message "Evaluation of this %s code block%sis aborted." + lang name-string) + nil))) + (x (error "Unexpected value `%s' from `org-babel-check-confirm-evaluate'" x))))) ;;;###autoload (defun org-babel-execute-safely-maybe () (unless org-babel-no-eval-on-ctrl-c-ctrl-c (org-babel-execute-maybe))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) - ;;;###autoload (defun org-babel-execute-maybe () (interactive) @@ -361,8 +308,8 @@ of potentially harmful code." "Execute BODY if point is in a source block and return t. Otherwise do nothing and return nil." - `(if (or (org-babel-where-is-src-block-head) - (org-babel-get-inline-src-block-matches)) + `(if (memq (org-element-type (org-element-context)) + '(inline-src-block src-block)) (progn ,@body t) @@ -394,12 +341,16 @@ a window into the `org-babel-get-src-block-info' function." (header-args (nth 2 info))) (when name (funcall printf "Name: %s\n" name)) (when lang (funcall printf "Lang: %s\n" lang)) + (funcall printf "Properties:\n") + (funcall printf "\t:header-args \t%s\n" (org-entry-get (point) "header-args" t)) + (funcall printf "\t:header-args:%s \t%s\n" lang (org-entry-get (point) (concat "header-args:" lang) t)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) (funcall printf "Header Arguments:\n") (dolist (pair (sort header-args (lambda (a b) (string< (symbol-name (car a)) (symbol-name (car b)))))) - (when (funcall full (cdr pair)) + (when (funcall full (format "%s" (cdr pair))) (funcall printf "\t%S%s\t%s\n" (car pair) (if (> (length (format "%S" (car pair))) 7) "" "\t") @@ -442,11 +393,13 @@ then run `org-babel-switch-to-session'." (colnames . ((nil no yes))) (comments . ((no link yes org both noweb))) (dir . :any) - (eval . ((never query))) + (eval . ((yes no no-export strip-export never-export eval never + query))) (exports . ((code results both none))) (epilogue . :any) (file . :any) (file-desc . :any) + (file-ext . :any) (hlines . ((no yes))) (mkdirp . ((yes no))) (no-expand) @@ -454,6 +407,7 @@ then run `org-babel-switch-to-session'." (noweb . ((yes no tangle no-export strip-export))) (noweb-ref . :any) (noweb-sep . :any) + (output-dir . :any) (padline . ((yes no))) (post . :any) (prologue . :any) @@ -476,31 +430,76 @@ then run `org-babel-switch-to-session'." Note that individual languages may define their own language specific header arguments as well.") +(defconst org-babel-safe-header-args + '(:cache :colnames :comments :exports :epilogue :hlines :noeval + :noweb :noweb-ref :noweb-sep :padline :prologue :rownames + :sep :session :tangle :wrap + (:eval . ("never" "query")) + (:results . (lambda (str) (not (string-match "file" str))))) + "A list of safe header arguments for babel source blocks. + +The list can have entries of the following forms: +- :ARG -> :ARG is always a safe header arg +- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is + `equal' to one of the VALs. +- (:ARG . FN) -> :ARG is safe as a header arg if the function FN + returns non-nil. FN is passed one + argument, the value of the header arg + (as a string).") + +(defmacro org-babel-header-args-safe-fn (safe-list) + "Return a function that determines whether a list of header args are safe. + +Intended usage is: +\(put \\='org-babel-default-header-args \\='safe-local-variable + (org-babel-header-args-safe-p org-babel-safe-header-args) + +This allows org-babel languages to extend the list of safe values for +their `org-babel-default-header-args:foo' variable. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + `(lambda (value) + (and (listp value) + (cl-every + (lambda (pair) + (and (consp pair) + (org-babel-one-header-arg-safe-p pair ,safe-list))) + value)))) + (defvar org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) "Default arguments to use when evaluating a source block.") +(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "replace") (:exports . "results")) + '((:session . "none") (:results . "replace") + (:exports . "results") (:hlines . "yes")) "Default arguments to use when evaluating an inline source block.") - -(defvar org-babel-data-names '("tblname" "results" "name")) - -(defvar org-babel-result-regexp - (concat "^[ \t]*#\\+" - (regexp-opt org-babel-data-names t) - "\\(\\[\\(" - ;; FIXME The string below is `org-ts-regexp' - "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") +(put 'org-babel-default-inline-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) + +(defconst org-babel-name-regexp + (format "^[ \t]*#\\+%s:[ \t]*" + ;; FIXME: TBLNAME is for backward compatibility. + (regexp-opt '("NAME" "TBLNAME"))) + "Regexp matching a NAME keyword.") + +(defconst org-babel-result-regexp + (format "^[ \t]*#\\+%s\\(?:\\[\\(?:%s \\)?\\([[:alnum:]]+\\)\\]\\)?:[ \t]*" + org-babel-results-keyword + ;; <%Y-%m-%d %H:%M:%S> + "<\\(?:[0-9]\\{4\\}-[0-1][0-9]-[0-3][0-9] \ +[0-2][0-9]\\(?::[0-5][0-9]\\)\\{2\\}\\)>") "Regular expression used to match result lines. If the results are associated with a hash key then the hash will -be saved in the second match data.") +be saved in match group 1.") -(defvar org-babel-result-w-name-regexp - (concat org-babel-result-regexp - "\\([^ ()\f\t\n\r\v]+\\)\\((\\(.*\\))\\|\\)")) +(defconst org-babel-result-w-name-regexp + (concat org-babel-result-regexp "\\(?9:[^ \t\n\r\v\f]+\\)") + "Regexp matching a RESULTS keyword with a name. +Name is saved in match group 9.") (defvar org-babel-min-lines-for-block-output 10 "The minimum number of lines for block output. @@ -510,33 +509,58 @@ block. Otherwise the output is marked as literal by inserting colons at the starts of the lines. This variable only takes effect if the :results output option is in effect.") +(defvar org-babel-noweb-error-all-langs nil + "Raise errors when noweb references don't resolve. +Also see `org-babel-noweb-error-langs' to control noweb errors on +a language by language bases.") + (defvar org-babel-noweb-error-langs nil "Languages for which Babel will raise literate programming errors. List of languages for which errors should be raised when the source code block satisfying a noweb reference in this language -can not be resolved.") +can not be resolved. Also see `org-babel-noweb-error-all-langs' +to raise errors for all languages.") (defvar org-babel-hash-show 4 "Number of initial characters to show of a hidden results hash.") -(defvar org-babel-hash-show-time nil - "Non-nil means show the time the code block was evaluated in the result hash.") - (defvar org-babel-after-execute-hook nil "Hook for functions to be called after `org-babel-execute-src-block'") -(defun org-babel-named-src-block-regexp-for-name (name) - "This generates a regexp used to match a src block named NAME." - (concat org-babel-src-name-regexp (regexp-quote name) - "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" +(defun org-babel-named-src-block-regexp-for-name (&optional name) + "This generates a regexp used to match a src block named NAME. +If NAME is nil, match any name. Matched name is then put in +match group 9. Other match groups are defined in +`org-babel-src-block-regexp'." + (concat org-babel-src-name-regexp + (concat (if name (regexp-quote name) "\\(?9:.*?\\)") "[ \t]*" ) + "\\(?:\n[ \t]*#\\+\\S-+:.*\\)*?" + "\n" (substring org-babel-src-block-regexp 1))) (defun org-babel-named-data-regexp-for-name (name) "This generates a regexp used to match data named NAME." - (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) + (concat org-babel-name-regexp (regexp-quote name) "[ \t]*$")) + +(defun org-babel--normalize-body (datum) + "Normalize body for element or object DATUM. +DATUM is a source block element or an inline source block object. +Remove final newline character and spurious indentation." + (let* ((value (org-element-property :value datum)) + (body (if (string-suffix-p "\n" value) + (substring value 0 -1) + value))) + (cond ((eq (org-element-type datum) 'inline-src-block) + ;; Newline characters and indentation in an inline + ;; src-block are not meaningful, since they could come from + ;; some paragraph filling. Treat them as a white space. + (replace-regexp-in-string "\n[ \t]*" " " body)) + ((or org-src-preserve-indentation + (org-element-property :preserve-indent datum)) + body) + (t (org-remove-indentation body))))) ;;; functions -(defvar call-process-region) (defvar org-babel-current-src-block-location nil "Marker pointing to the src block currently being executed. This may also point to a call line or an inline code block. If @@ -546,6 +570,56 @@ the outer-most code block.") (defvar *this*) +(defun org-babel-get-src-block-info (&optional light datum) + "Extract information from a source block or inline source block. + +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + +By default, consider the block at point. However, when optional +argument DATUM is provided, extract information from that parsed +object instead. + +Return nil if point is not on a source block. Otherwise, return +a list with the following pattern: + + (language body arguments switches name start coderef)" + (let* ((datum (or datum (org-element-context))) + (type (org-element-type datum)) + (inline (eq type 'inline-src-block))) + (when (memq type '(inline-src-block src-block)) + (let* ((lang (org-element-property :language datum)) + (lang-headers (intern + (concat "org-babel-default-header-args:" lang))) + (name (org-element-property :name datum)) + (info + (list + lang + (org-babel--normalize-body datum) + (apply #'org-babel-merge-params + (if inline org-babel-default-inline-header-args + org-babel-default-header-args) + (and (boundp lang-headers) (eval lang-headers t)) + (append + ;; If DATUM is provided, make sure we get node + ;; properties applicable to its location within + ;; the document. + (org-with-point-at (org-element-property :begin datum) + (org-babel-params-from-properties lang)) + (mapcar #'org-babel-parse-header-arguments + (cons (org-element-property :parameters datum) + (org-element-property :header datum))))) + (or (org-element-property :switches datum) "") + name + (org-element-property (if inline :begin :post-affiliated) + datum) + (and (not inline) (org-src-coderef-format datum))))) + (unless light + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (setf (nth 2 info) (org-babel-generate-file-param name (nth 2 info))) + info)))) + ;;;###autoload (defun org-babel-execute-src-block (&optional arg info params) "Execute the current source code block. @@ -565,110 +639,91 @@ block." (interactive) (let* ((org-babel-current-src-block-location (or org-babel-current-src-block-location - (nth 6 info) + (nth 5 info) (org-babel-where-is-src-block-head))) - (info (if info - (copy-tree info) - (org-babel-get-src-block-info))) - (merged-params (org-babel-merge-params (nth 2 info) params))) - (when (org-babel-check-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) - (let* ((params (if params - (org-babel-process-params merged-params) - (nth 2 info))) - (cachep (and (not arg) (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params))))) - (new-hash (when cachep (org-babel-sha1-hash info))) - (old-hash (when cachep (org-babel-current-result-hash))) - (cache-current-p (and (not arg) new-hash - (equal new-hash old-hash)))) + (info (if info (copy-tree info) (org-babel-get-src-block-info)))) + ;; Merge PARAMS with INFO before considering source block + ;; evaluation since both could disagree. + (cl-callf org-babel-merge-params (nth 2 info) params) + (when (org-babel-check-evaluate info) + (cl-callf org-babel-process-params (nth 2 info)) + (let* ((params (nth 2 info)) + (cache (let ((c (cdr (assq :cache params)))) + (and (not arg) c (string= "yes" c)))) + (new-hash (and cache (org-babel-sha1-hash info))) + (old-hash (and cache (org-babel-current-result-hash))) + (current-cache (and new-hash (equal new-hash old-hash)))) (cond - (cache-current-p - (save-excursion ;; return cached result + (current-cache + (save-excursion ;Return cached result. (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) + (forward-line) + (skip-chars-forward " \t") (let ((result (org-babel-read-result))) - (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) - result))) - ((org-babel-confirm-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result))) + ((org-babel-confirm-evaluate info) (let* ((lang (nth 0 info)) - (result-params (cdr (assoc :result-params params))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (dir (cdr (assoc :dir params))) + (result-params (cdr (assq :result-params params))) + ;; Expand noweb references in BODY and remove any + ;; coderef. + (body + (let ((coderef (nth 6 info)) + (expand + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (if (not coderef) expand + (replace-regexp-in-string + (org-src-coderef-regexp coderef) "" expand nil nil 1)))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory (expand-file-name dir))) default-directory)) - (org-babel-call-process-region-original ;; for tramp handler - (or (org-bound-and-true-p - org-babel-call-process-region-original) - (symbol-function 'call-process-region))) - (indent (nth 5 info)) - result cmd) - (unwind-protect - (let ((call-process-region - (lambda (&rest args) - (apply 'org-babel-tramp-handle-call-process-region - args)))) - (let ((lang-check - (lambda (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f))))) - (setq cmd - (or (funcall lang-check lang) - (funcall lang-check - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - (error "No org-babel-execute function for %s!" - lang)))) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (if (member "none" result-params) - (progn - (funcall cmd body params) - (message "result silenced") - (setq result nil)) - (setq result - (let ((result (funcall cmd body params))) - (if (and (eq (cdr (assoc :result-type params)) - 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result))) - ;; If non-empty result and :file then write to :file. - (when (cdr (assoc :file params)) - (when result - (with-temp-file (cdr (assoc :file params)) - (insert - (org-babel-format-result - result (cdr (assoc :sep (nth 2 info))))))) - (setq result (cdr (assoc :file params)))) - ;; Possibly perform post process provided its appropriate. - (when (cdr (assoc :post params)) - (let ((*this* (if (cdr (assoc :file params)) - (org-babel-result-to-file - (cdr (assoc :file params)) - (when (assoc :file-desc params) - (or (cdr (assoc :file-desc params)) - result))) - result))) - (setq result (org-babel-ref-resolve - (cdr (assoc :post params)))) - (when (cdr (assoc :file params)) - (setq result-params - (remove "file" result-params))))) - (org-babel-insert-result - result result-params info new-hash indent lang)) - (run-hooks 'org-babel-after-execute-hook) - result) - (setq call-process-region - 'org-babel-call-process-region-original))))))))) + (cmd (intern (concat "org-babel-execute:" lang))) + result) + (unless (fboundp cmd) + (error "No org-babel-execute function for %s!" lang)) + (message "executing %s code block%s..." + (capitalize lang) + (let ((name (nth 4 info))) + (if name (format " (%s)" name) ""))) + (if (member "none" result-params) + (progn (funcall cmd body params) + (message "result silenced")) + (setq result + (let ((r (funcall cmd body params))) + (if (and (eq (cdr (assq :result-type params)) 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp r))) + (list (list r)) + r))) + (let ((file (cdr (assq :file params)))) + ;; If non-empty result and :file then write to :file. + (when file + (when result + (with-temp-file file + (insert (org-babel-format-result + result (cdr (assq :sep params)))))) + (setq result file)) + ;; Possibly perform post process provided its + ;; appropriate. Dynamically bind "*this*" to the + ;; actual results of the block. + (let ((post (cdr (assq :post params)))) + (when post + (let ((*this* (if (not file) result + (org-babel-result-to-file + file + (let ((desc (assq :file-desc params))) + (and desc (or (cdr desc) result))))))) + (setq result (org-babel-ref-resolve post)) + (when file + (setq result-params (remove "file" result-params)))))) + (org-babel-insert-result + result result-params info new-hash lang))) + (run-hooks 'org-babel-after-execute-hook) + result))))))) (defun org-babel-expand-body:generic (body params &optional var-lines) "Expand BODY with PARAMS. @@ -676,8 +731,8 @@ Expand a block of code with org-babel according to its header arguments. This generic implementation of body expansion is called for languages which have not defined their own specific org-babel-expand-body:lang function." - (let ((pro (cdr (assoc :prologue params))) - (epi (cdr (assoc :epilogue params)))) + (let ((pro (cdr (assq :prologue params))) + (epi (cdr (assq :epilogue params)))) (mapconcat #'identity (append (when pro (list pro)) var-lines @@ -708,10 +763,9 @@ arguments and pop open the results in a preview buffer." (org-babel-expand-body:generic body params (and (fboundp assignments-cmd) (funcall assignments-cmd params)))))) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (org-edit-src-code - nil expanded - (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) + expanded (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) expanded))) (defun org-babel-edit-distance (s1 s2) @@ -742,7 +796,7 @@ arguments and pop open the results in a preview buffer." (dolist (arg-pair new-list) (let ((header (car arg-pair))) (setq results - (cons arg-pair (org-remove-if + (cons arg-pair (cl-remove-if (lambda (pair) (equal header (car pair))) results)))))) results)) @@ -770,37 +824,43 @@ arguments and pop open the results in a preview buffer." (message "No suspicious header arguments found."))) ;;;###autoload -(defun org-babel-insert-header-arg () +(defun org-babel-insert-header-arg (&optional header-arg value) "Insert a header argument selecting from lists of common args and values." (interactive) - (let* ((lang (car (org-babel-get-src-block-info 'light))) + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (car info)) + (begin (nth 5 info)) (lang-headers (intern (concat "org-babel-header-args:" lang))) (headers (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values - (when (boundp lang-headers) (eval lang-headers)))) - (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) - (insert ":" arg) - (let ((vals (cdr (assoc (intern arg) headers)))) - (when vals - (insert - " " - (cond - ((eq vals :any) - (read-from-minibuffer "value: ")) - ((listp vals) - (mapconcat - (lambda (group) - (let ((arg (org-icompleting-read - "value: " - (cons "default" (mapcar #'symbol-name group))))) - (if (and arg (not (string= "default" arg))) - (concat arg " ") - ""))) - vals "")))))))) + (when (boundp lang-headers) (eval lang-headers t)))) + (header-arg (or header-arg + (completing-read + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) + (vals (cdr (assoc (intern header-arg) headers))) + (value (or value + (cond + ((eq vals :any) + (read-from-minibuffer "value: ")) + ((listp vals) + (mapconcat + (lambda (group) + (let ((arg (completing-read + "Value: " + (cons "default" + (mapcar #'symbol-name group))))) + (if (and arg (not (string= "default" arg))) + (concat arg " ") + ""))) + vals "")))))) + (save-excursion + (goto-char begin) + (goto-char (point-at-eol)) + (unless (= (char-before (point)) ?\ ) (insert " ")) + (insert ":" header-arg) (when value (insert " " value))))) ;; Add support for completing-read insertion of header arguments after ":" (defun org-babel-header-arg-expand () @@ -811,7 +871,7 @@ arguments and pop open the results in a preview buffer." (defun org-babel-enter-header-arg-w-completion (&optional lang) "Insert header argument appropriate for LANG with completion." (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) - (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var t))) (headers-w-values (org-babel-combine-header-arg-lists org-babel-common-header-args-w-values lang-headers)) (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) @@ -842,8 +902,8 @@ session." (if (org-babel-noweb-p params :eval) (org-babel-expand-noweb-references info) (nth 1 info))))) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) + (session (cdr (assq :session params))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) (cmd (intern (concat "org-babel-load-session:" lang)))) @@ -863,17 +923,17 @@ the session. Copy the body of the code block to the kill ring." (lang (nth 0 info)) (body (nth 1 info)) (params (nth 2 info)) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) + (session (cdr (assq :session params))) + (dir (cdr (assq :dir params))) (default-directory (or (and dir (file-name-as-directory dir)) default-directory)) (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) - (if (and (stringp session) (string= session "none")) - (error "This block is not using a session!")) + (when (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) (unless (fboundp init-cmd) (error "No org-babel-initiate-session function for %s!" lang)) - (with-temp-buffer (insert (org-babel-trim body)) + (with-temp-buffer (insert (org-trim body)) (copy-region-as-kill (point-min) (point-max))) (when arg (unless (fboundp prep-cmd) @@ -912,15 +972,15 @@ with a prefix argument then this is passed on to (org-edit-src-code) (funcall swap-windows))) +;;;###autoload (defmacro org-babel-do-in-edit-buffer (&rest body) "Evaluate BODY in edit buffer if there is a code block at point. Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) (when (and (org-babel-where-is-src-block-head) - (org-edit-src-code nil nil nil)) + (org-edit-src-code)) (unwind-protect (progn ,@body) - (if (org-bound-and-true-p org-edit-src-from-org-mode) - (org-edit-src-exit))) + (org-edit-src-exit)) t))) (def-edebug-spec org-babel-do-in-edit-buffer (body)) @@ -928,10 +988,10 @@ Return t if a code block was found at point, nil otherwise." "Read key sequence and execute the command in edit buffer. Enter a key sequence to be executed in the language major-mode edit buffer. For example, TAB will alter the contents of the -Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support -interactive sessions, this can be used to send code from the Org -buffer to the session for evaluation using the native major-mode +Org code block according to the effect of TAB in the language +major mode buffer. For languages that support interactive +sessions, this can be used to send code from the Org buffer +to the session for evaluation using the native major mode evaluation mechanisms." (interactive "kEnter key-sequence to execute in edit buffer: ") (org-babel-do-in-edit-buffer @@ -941,7 +1001,7 @@ evaluation mechanisms." (defvar org-bracket-link-regexp) (defun org-babel-active-location-p () - (memq (car (save-match-data (org-element-context))) + (memq (org-element-type (save-match-data (org-element-context))) '(babel-call inline-babel-call inline-src-block src-block))) ;;;###autoload @@ -965,7 +1025,7 @@ results already exist." ;; file results (org-open-at-point) (let ((r (org-babel-format-result - (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) + (org-babel-read-result) (cdr (assq :sep (nth 2 info)))))) (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) (delete-region (point-min) (point-max)) (insert r))) @@ -995,7 +1055,8 @@ beg-body --------- point at the beginning of the body end-body --------- point at the end of the body" (declare (indent 1)) (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) + `(let* ((case-fold-search t) + (,tempvar ,file) (visited-p (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) (point (point)) to-be-removed) @@ -1035,80 +1096,91 @@ end-body --------- point at the end of the body" ;;;###autoload (defmacro org-babel-map-inline-src-blocks (file &rest body) - "Evaluate BODY forms on each inline source-block in FILE. + "Evaluate BODY forms on each inline source block in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) + `(let* ((case-fold-search t) + (,tempvar ,file) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward org-babel-inline-src-block-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-inline-src-blocks (form body)) - -(defvar org-babel-lob-one-liner-regexp) + (while (re-search-forward "src_\\S-" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (eq (org-element-type ,datum) 'inline-src-block) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defmacro org-babel-map-call-lines (file &rest body) "Evaluate BODY forms on each call line in FILE. If FILE is nil evaluate BODY forms on source blocks in current buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) + `(let* ((case-fold-search t) + (,tempvar ,file) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward org-babel-lob-one-liner-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-call-lines (form body)) + (while (re-search-forward "call_\\S-\\|^[ \t]*#\\+CALL:" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (memq (org-element-type ,datum) + '(babel-call inline-babel-call)) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defmacro org-babel-map-executables (file &rest body) - (declare (indent 1)) - (let ((tempvar (make-symbol "file")) - (rx (make-symbol "rx"))) - `(let* ((,tempvar ,file) - (,rx (concat "\\(" org-babel-src-block-regexp - "\\|" org-babel-inline-src-block-regexp - "\\|" org-babel-lob-one-liner-regexp "\\)")) - (visited-p (or (null ,tempvar) + "Evaluate BODY forms on each active Babel code in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1) (debug (form body))) + (org-with-gensyms (datum end point tempvar to-be-removed visitedp) + `(let* ((case-fold-search t) + (,tempvar ,file) + (,visitedp (or (null ,tempvar) (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) + (,point (point)) + ,to-be-removed) (save-window-excursion (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) + (setq ,to-be-removed (current-buffer)) (goto-char (point-min)) - (while (re-search-forward ,rx nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (when (looking-at org-babel-inline-src-block-regexp) - (forward-char 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-executables (form body)) + (while (re-search-forward + "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)" nil t) + (let ((,datum (save-match-data (org-element-context)))) + (when (memq (org-element-type ,datum) + '(babel-call inline-babel-call inline-src-block + src-block)) + (goto-char (match-beginning 0)) + (let ((,end (copy-marker (org-element-property :end ,datum)))) + ,@body + (goto-char ,end) + (set-marker ,end nil)))))) + (unless ,visitedp (kill-buffer ,to-be-removed)) + (goto-char ,point)))) ;;;###autoload (defun org-babel-execute-buffer (&optional arg) @@ -1119,7 +1191,8 @@ the current buffer." (org-babel-eval-wipe-error-buffer) (org-save-outline-visibility t (org-babel-map-executables nil - (if (looking-at org-babel-lob-one-liner-regexp) + (if (memq (org-element-type (org-element-context)) + '(babel-call inline-babel-call)) (org-babel-lob-execute-maybe) (org-babel-execute-src-block arg))))) @@ -1164,7 +1237,20 @@ the current subtree." (member (car arg) '(:results :exports))) (mapconcat #'identity (sort (funcall rm (split-string v)) #'string<) " ")) - (t v))))))) + (t v)))))) + ;; expanded body + (lang (nth 0 info)) + (params (nth 2 info)) + (body (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) (nth 1 info))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" + lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) (let* ((it (format "%s-%s" (mapconcat #'identity @@ -1173,26 +1259,32 @@ the current subtree." (when normalized (format "%S" normalized)))) (nth 2 info))) ":") - (nth 1 info))) + expanded)) (hash (sha1 it))) - (when (org-called-interactively-p 'interactive) (message hash)) + (when (called-interactively-p 'interactive) (message hash)) hash)))) -(defun org-babel-current-result-hash () +(defun org-babel-current-result-hash (&optional info) "Return the current in-buffer hash." - (org-babel-where-is-src-block-result) - (org-no-properties (match-string 5))) + (let ((result (org-babel-where-is-src-block-result nil info))) + (when result + (org-with-wide-buffer + (goto-char result) + (looking-at org-babel-result-regexp) + (match-string-no-properties 1))))) -(defun org-babel-set-current-result-hash (hash) +(defun org-babel-set-current-result-hash (hash info) "Set the current in-buffer hash to HASH." - (org-babel-where-is-src-block-result) - (save-excursion (goto-char (match-beginning 5)) - (mapc #'delete-overlay (overlays-at (point))) - (forward-char org-babel-hash-show) - (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 5) - (goto-char (point-at-bol)) - (org-babel-hide-hash))) + (org-with-wide-buffer + (goto-char (org-babel-where-is-src-block-result nil info)) + (looking-at org-babel-result-regexp) + (goto-char (match-beginning 1)) + (mapc #'delete-overlay (overlays-at (point))) + (forward-char org-babel-hash-show) + (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 1) + (beginning-of-line) + (org-babel-hide-hash))) (defun org-babel-hide-hash () "Hide the hash in the current results line. @@ -1201,11 +1293,11 @@ will remain visible." (add-to-invisibility-spec '(org-babel-hide-hash . t)) (save-excursion (when (and (re-search-forward org-babel-result-regexp nil t) - (match-string 5)) - (let* ((start (match-beginning 5)) + (match-string 1)) + (let* ((start (match-beginning 1)) (hide-start (+ org-babel-hash-show start)) - (end (match-end 5)) - (hash (match-string 5)) + (end (match-end 1)) + (hash (match-string 1)) ov1 ov2) (setq ov1 (make-overlay start hide-start)) (setq ov2 (make-overlay hide-start end)) @@ -1227,14 +1319,14 @@ the `org-mode-hook'." (defun org-babel-hash-at-point (&optional point) "Return the value of the hash at POINT. +\\\ The hash is also added as the last element of the kill ring. -This can be called with C-c C-c." +This can be called with `\\[org-ctrl-c-ctrl-c]'." (interactive) (let ((hash (car (delq nil (mapcar (lambda (ol) (overlay-get ol 'babel-hash)) (overlays-at (or point (point)))))))) (when hash (kill-new hash) (message hash)))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) (defun org-babel-result-hide-spec () "Hide portions of results lines. @@ -1288,15 +1380,15 @@ portions of results lines." (eq (overlay-get overlay 'invisible) 'org-babel-hide-result)) (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov))) - (overlays-at start))) + (when (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) (setq ov (make-overlay start end)) (overlay-put ov 'invisible 'org-babel-hide-result) ;; make the block accessible to isearch @@ -1316,8 +1408,8 @@ portions of results lines." (add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) ;; Remove overlays when changing major mode (add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) + (lambda () (add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) @@ -1326,122 +1418,98 @@ Return a list of association lists of source block params specified in the properties of the current outline entry." (save-match-data (list - ;; DEPRECATED header arguments specified as separate property at - ;; point of definition - (let (val sym) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header-arg) - (and (setq val (org-entry-get (point) header-arg t)) - (cons (intern (concat ":" header-arg)) - (org-babel-read val)))) - (mapcar - #'symbol-name - (mapcar - #'car - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (progn - (setq sym (intern (concat "org-babel-header-args:" lang))) - (and (boundp sym) (eval sym)))))))))) ;; header arguments specified with the header-args property at - ;; point of call + ;; point of call. (org-babel-parse-header-arguments (org-entry-get org-babel-current-src-block-location - "header-args" 'inherit)) - (when lang ;; language-specific header arguments at point of call - (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - (concat "header-args:" lang) 'inherit)))))) - -(defvar org-src-preserve-indentation) ;; declare defcustom from org-src -(defun org-babel-parse-src-block-match () - "Parse the results from a match of the `org-babel-src-block-regexp'." - (let* ((block-indentation (length (match-string 1))) - (lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang))) - (switches (match-string 3)) - (body (org-no-properties - (let* ((body (match-string 5)) - (sub-length (- (length body) 1))) - (if (and (> sub-length 0) - (string= "\n" (substring body sub-length))) - (substring body 0 sub-length) - (or body ""))))) - (preserve-indentation (or org-src-preserve-indentation - (save-match-data - (string-match "-i\\>" switches))))) - (list lang - ;; get block body less properties, protective commas, and indentation - (with-temp-buffer - (save-match-data - (insert (org-unescape-code-in-string body)) - (unless preserve-indentation (org-do-remove-indentation)) - (buffer-string))) - (apply #'org-babel-merge-params - org-babel-default-header-args - (when (boundp lang-headers) (eval lang-headers)) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))))) - switches - block-indentation))) - -(defun org-babel-parse-inline-src-block-match () - "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) - (list lang - (org-unescape-code-in-string (org-no-properties (match-string 5))) - (apply #'org-babel-merge-params - org-babel-default-inline-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))))) + "header-args" + 'inherit)) + (and lang ; language-specific header arguments at point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + (concat "header-args:" lang) + 'inherit)))))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. -ALTS is a cons of two character options where each option may be -either the numeric code of a single character or a list of -character alternatives. For example to split on balanced -instances of \"[ \t]:\" set ALTS to ((32 9) . 58)." - (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) - (matched (lambda (ch last) - (if (consp alts) - (and (funcall matches ch (cdr alts)) - (funcall matches last (car alts))) - (funcall matches ch alts)))) - (balance 0) (last 0) - quote partial lst) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (funcall matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst)))) +ALTS is a character, or cons of two character options where each +option may be either the numeric code of a single character or +a list of character alternatives. For example, to split on +balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((splitp (lambda (past next) + ;; Non-nil when there should be a split after NEXT + ;; character. PAST is the character before NEXT. + (pcase alts + (`(,(and first (pred consp)) . ,(and second (pred consp))) + (and (memq past first) (memq next second))) + (`(,first . ,(and second (pred consp))) + (and (eq past first) (memq next second))) + (`(,(and first (pred consp)) . ,second) + (and (memq past first) (eq next second))) + (`(,first . ,second) + (and (eq past first) (eq next second))) + ((pred (eq next)) t) + (_ nil)))) + (partial nil) + (result nil)) + (while (not (eobp)) + (cond + ((funcall splitp (char-before) (char-after)) + ;; There is a split after point. If ALTS is two-folds, + ;; remove last parsed character as it belongs to ALTS. + (when (consp alts) (pop partial)) + ;; Include elements parsed so far in RESULTS and flush + ;; partial parsing. + (when partial + (push (apply #'string (nreverse partial)) result) + (setq partial nil)) + (forward-char)) + ((memq (char-after) '(?\( ?\[)) + ;; Include everything between balanced brackets. + (let* ((origin (point)) + (after (char-after)) + (openings (list after))) + (forward-char) + (while (and openings (re-search-forward "[]()]" nil t)) + (pcase (char-before) + ((and match (or ?\[ ?\()) (push match openings)) + (?\] (when (eq ?\[ (car openings)) (pop openings))) + (_ (when (eq ?\( (car openings)) (pop openings))))) + (if (null openings) + (setq partial + (nconc (nreverse (string-to-list + (buffer-substring origin (point)))) + partial)) + ;; Un-balanced bracket. Backtrack. + (push after partial) + (goto-char (1+ origin))))) + ((and (eq ?\" (char-after)) (not (eq ?\\ (char-before)))) + ;; Include everything from current double quote to next + ;; non-escaped double quote. + (let ((origin (point))) + (if (re-search-forward "[^\\]\"" nil t) + (setq partial + (nconc (nreverse (string-to-list + (buffer-substring origin (point)))) + partial)) + ;; No closing double quote. Backtrack. + (push ?\" partial) + (forward-char)))) + (t (push (char-after) partial) + (forward-char)))) + ;; Add pending parsing and return result. + (when partial (push (apply #'string (nreverse partial)) result)) + (nreverse result)))) (defun org-babel-join-splits-near-ch (ch list) "Join splits where \"=\" is on either end of the split." (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) (first= (lambda (str) (= ch (aref str 0))))) (reverse - (org-reduce (lambda (acc el) + (cl-reduce (lambda (acc el) (let ((head (car acc))) (if (and head (or (funcall last= head) (funcall first= el))) (cons (concat head el) (cdr acc)) @@ -1474,7 +1542,7 @@ shown below. (let (results) (mapc (lambda (pair) (if (eq (car pair) :var) - (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) + (mapcar (lambda (v) (push (cons :var (org-trim v)) results)) (org-babel-join-splits-near-ch 61 (org-babel-balanced-split (cdr pair) 32))) (push pair results))) @@ -1484,48 +1552,52 @@ shown below. (defun org-babel-process-params (params) "Expand variables in PARAMS and add summary parameters." (let* ((processed-vars (mapcar (lambda (el) - (if (consp (cdr el)) - (cdr el) - (org-babel-ref-parse (cdr el)))) - (org-babel-get-header params :var))) - (vars-and-names (if (and (assoc :colname-names params) - (assoc :rowname-names params)) + (if (consp el) + el + (org-babel-ref-parse el))) + (org-babel--get-vars params))) + (vars-and-names (if (and (assq :colname-names params) + (assq :rowname-names params)) (list processed-vars) (org-babel-disassemble-tables processed-vars - (cdr (assoc :hlines params)) - (cdr (assoc :colnames params)) - (cdr (assoc :rownames params))))) - (raw-result (or (cdr (assoc :results params)) "")) - (result-params (append - (split-string (if (stringp raw-result) - raw-result - (eval raw-result))) - (cdr (assoc :result-params params))))) + (cdr (assq :hlines params)) + (cdr (assq :colnames params)) + (cdr (assq :rownames params))))) + (raw-result (or (cdr (assq :results params)) "")) + (result-params (delete-dups + (append + (split-string (if (stringp raw-result) + raw-result + (eval raw-result t))) + (cdr (assq :result-params params)))))) (append (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) (list - (cons :colname-names (or (cdr (assoc :colname-names params)) + (cons :colname-names (or (cdr (assq :colname-names params)) (cadr vars-and-names))) - (cons :rowname-names (or (cdr (assoc :rowname-names params)) - (caddr vars-and-names))) + (cons :rowname-names (or (cdr (assq :rowname-names params)) + (cl-caddr vars-and-names))) (cons :result-params result-params) (cons :result-type (cond ((member "output" result-params) 'output) ((member "value" result-params) 'value) (t 'value)))) - (org-babel-get-header params :var 'other)))) + (cl-remove-if + (lambda (x) (memq (car x) '(:colname-names :rowname-names :result-params + :result-type :var))) + params)))) ;; row and column names (defun org-babel-del-hlines (table) "Remove all `hline's from TABLE." - (remove 'hline table)) + (remq 'hline table)) (defun org-babel-get-colnames (table) "Return the column names of TABLE. Return a cons cell, the `car' of which contains the TABLE less colnames, and the `cdr' of which contains a list of the column names." - (if (equal 'hline (nth 1 table)) + (if (eq 'hline (nth 1 table)) (cons (cddr table) (car table)) (cons (cdr table) (car table)))) @@ -1583,7 +1655,7 @@ of the vars, cnames and rnames." (lambda (var) (when (listp (cdr var)) (when (and (not (equal colnames "no")) - (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (or colnames (and (eq (nth 1 (cdr var)) 'hline) (not (member 'hline (cddr (cdr var))))))) (let ((both (org-babel-get-colnames (cdr var)))) (setq cnames (cons (cons (car var) (cdr both)) @@ -1612,35 +1684,26 @@ to the table for reinsertion to org-mode." (org-babel-put-colnames table colnames) table)) table)) -(defun org-babel-where-is-src-block-head () +(defun org-babel-where-is-src-block-head (&optional src-block) "Find where the current source block begins. -Return the point at the beginning of the current source -block. Specifically at the beginning of the #+BEGIN_SRC line. + +If optional argument SRC-BLOCK is `src-block' type element, find +its current beginning instead. + +Return the point at the beginning of the current source block. +Specifically at the beginning of the #+BEGIN_SRC line. Also set +match-data relatively to `org-babel-src-block-regexp', which see. If the point is not on a source block then return nil." - (let ((initial (point)) (case-fold-search t) top bottom) - (or - (save-excursion ;; on a source name line or a #+header line - (beginning-of-line 1) - (and (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)) - (progn - (while (and (forward-line 1) - (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (looking-at org-babel-src-block-regexp)) - (point))) - (save-excursion ;; on a #+begin_src line - (beginning-of-line 1) - (and (looking-at org-babel-src-block-regexp) - (point))) - (save-excursion ;; inside a src block - (and - (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) - (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) - (< top initial) (< initial bottom) - (progn (goto-char top) (beginning-of-line 1) - (looking-at org-babel-src-block-regexp)) - (point-marker)))))) + (let ((element (or src-block (org-element-at-point)))) + (when (eq (org-element-type element) 'src-block) + (let ((end (org-element-property :end element))) + (org-with-wide-buffer + ;; Ensure point is not on a blank line after the block. + (beginning-of-line) + (skip-chars-forward " \r\t\n" end) + (when (< (point) end) + (prog1 (goto-char (org-element-property :post-affiliated element)) + (looking-at org-babel-src-block-regexp)))))))) ;;;###autoload (defun org-babel-goto-src-block-head () @@ -1655,56 +1718,52 @@ If the point is not on a source block then return nil." (interactive (let ((completion-ignore-case t) (case-fold-search t) - (under-point (thing-at-point 'line))) - (list (org-icompleting-read - "source-block name: " (org-babel-src-block-names) nil t - (cond - ;; noweb - ((string-match (org-babel-noweb-wrap) under-point) - (let ((block-name (match-string 1 under-point))) - (string-match "[^(]*" block-name) - (match-string 0 block-name))) - ;; #+call: - ((string-match org-babel-lob-one-liner-regexp under-point) - (let ((source-info (car (org-babel-lob-get-info)))) - (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) - (let ((source-name (match-string 1 source-info))) - source-name)))) - ;; #+results: - ((string-match (concat "#\\+" org-babel-results-keyword - "\\:\s+\\([^\\(]*\\)") under-point) - (match-string 1 under-point)) - ;; symbol-at-point - ((and (thing-at-point 'symbol)) - (org-babel-find-named-block (thing-at-point 'symbol)) - (thing-at-point 'symbol)) - ("")))))) + (all-block-names (org-babel-src-block-names))) + (list (completing-read + "source-block name: " all-block-names nil t + (let* ((context (org-element-context)) + (type (org-element-type context)) + (noweb-ref + (and (memq type '(inline-src-block src-block)) + (org-in-regexp (org-babel-noweb-wrap))))) + (cond + (noweb-ref + (buffer-substring + (+ (car noweb-ref) (length org-babel-noweb-wrap-start)) + (- (cdr noweb-ref) (length org-babel-noweb-wrap-end)))) + ((memq type '(babel-call inline-babel-call)) ;#+CALL: + (org-element-property :call context)) + ((car (org-element-property :results context))) ;#+RESULTS: + ((let ((symbol (thing-at-point 'symbol))) ;Symbol. + (and symbol + (member-ignore-case symbol all-block-names) + symbol))) + (t ""))))))) (let ((point (org-babel-find-named-block name))) (if point - ;; taken from `org-open-at-point' + ;; Taken from `org-open-at-point'. (progn (org-mark-ring-push) (goto-char point) (org-show-context)) (message "source-code block `%s' not found in this buffer" name)))) (defun org-babel-find-named-block (name) "Find a named source-code block. Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to -org-babel-named-src-block-regexp." +NAME, or nil if no such block exists. Set match data according +to `org-babel-named-src-block-regexp'." (save-excursion - (let ((case-fold-search t) - (regexp (org-babel-named-src-block-regexp-for-name name))) - (goto-char (point-min)) - (when (or (re-search-forward regexp nil t) - (re-search-backward regexp nil t)) - (match-beginning 0))))) + (goto-char (point-min)) + (ignore-errors + (org-next-block 1 nil (org-babel-named-src-block-regexp-for-name name))))) (defun org-babel-src-block-names (&optional file) "Returns the names of source blocks in FILE or the current buffer." + (when file (find-file file)) (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (match-string 3) names))) + (goto-char (point-min)) + (let ((re (org-babel-named-src-block-regexp-for-name)) + names) + (while (ignore-errors (org-next-block 1 nil re)) + (push (match-string-no-properties 9) names)) names))) ;;;###autoload @@ -1712,33 +1771,31 @@ org-babel-named-src-block-regexp." "Go to a named result." (interactive (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-result-names) nil t)))) + (list (completing-read "Source-block name: " + (org-babel-result-names) nil t)))) (let ((point (org-babel-find-named-result name))) (if point ;; taken from `org-open-at-point' (progn (goto-char point) (org-show-context)) (message "result `%s' not found in this buffer" name)))) -(defun org-babel-find-named-result (name &optional point) +(defun org-babel-find-named-result (name) "Find a named result. Return the location of the result named NAME in the current buffer or nil if no such result exists." (save-excursion - (let ((case-fold-search t)) - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") - nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp) - (looking-at org-babel-lob-one-liner-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point)))))) + (goto-char (point-min)) + (let ((case-fold-search t) + (re (format "^[ \t]*#\\+%s.*?:[ \t]*%s[ \t]*$" + org-babel-results-keyword + (regexp-quote name)))) + (catch :found + (while (re-search-forward re nil t) + (let ((element (org-element-at-point))) + (when (or (eq (org-element-type element) 'keyword) + (< (point) + (org-element-property :post-affiliated element))) + (throw :found (line-beginning-position))))))))) (defun org-babel-result-names (&optional file) "Returns the names of results in FILE or the current buffer." @@ -1746,7 +1803,7 @@ buffer or nil if no such result exists." (when file (find-file file)) (goto-char (point-min)) (let ((case-fold-search t) names) (while (re-search-forward org-babel-result-w-name-regexp nil t) - (setq names (cons (match-string 4) names))) + (setq names (cons (match-string-no-properties 9) names))) names))) ;;;###autoload @@ -1784,26 +1841,31 @@ split. When called from outside of a code block a new code block is created. In both cases if the region is demarcated and if the region is not active then the point is demarcated." (interactive "P") - (let ((info (org-babel-get-src-block-info 'light)) - (headers (progn (org-babel-where-is-src-block-head) - (match-string 4))) - (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (let* ((info (org-babel-get-src-block-info 'light)) + (start (org-babel-where-is-src-block-head)) + (block (and start (match-string 0))) + (headers (and start (match-string 4))) + (stars (concat (make-string (or (org-current-level) 1) ?*) " ")) + (lower-case-p (and block + (let (case-fold-search) + (string-match-p "#\\+begin_src" block))))) (if info (mapc (lambda (place) (save-excursion (goto-char place) (let ((lang (nth 0 info)) - (indent (make-string (nth 5 info) ? ))) + (indent (make-string (org-get-indentation) ?\s))) (when (string-match "^[[:space:]]*$" (buffer-substring (point-at-bol) (point-at-eol))) (delete-region (point-at-bol) (point-at-eol))) (insert (concat (if (looking-at "^") "" "\n") - indent "#+end_src\n" + indent (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n") (if arg stars indent) "\n" - indent "#+begin_src " lang + indent (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") + lang (if (> (length headers) 1) (concat " " headers) headers) (if (looking-at "[\n\r]") @@ -1812,7 +1874,7 @@ region is not active then the point is demarcated." (move-end-of-line 2)) (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) (let ((start (point)) - (lang (org-icompleting-read + (lang (completing-read "Lang: " (mapcar #'symbol-name (delete-dups @@ -1823,134 +1885,222 @@ region is not active then the point is demarcated." (if (org-region-active-p) (mark) (point)) (point)))) (insert (concat (if (looking-at "^") "" "\n") (if arg (concat stars "\n") "") - "#+begin_src " lang "\n" + (funcall (if lower-case-p 'downcase 'upcase) "#+begin_src ") + lang "\n" body (if (or (= (length body) 0) - (string-match "[\r\n]$" body)) "" "\n") - "#+end_src\n")) + (string-suffix-p "\r" body) + (string-suffix-p "\n" body)) "" "\n") + (funcall (if lower-case-p 'downcase 'upcase) "#+end_src\n"))) (goto-char start) (move-end-of-line 1))))) -(defvar org-babel-lob-one-liner-regexp) -(defun org-babel-where-is-src-block-result (&optional insert info hash indent) +(defun org-babel--insert-results-keyword (name hash) + "Insert RESULTS keyword with NAME value at point. +If NAME is nil, results are anonymous. HASH is a string used as +the results hash, or nil. Leave point before the keyword." + (save-excursion (insert "\n")) ;open line to indent. + (org-indent-line) + (delete-char 1) + (insert (concat "#+" org-babel-results-keyword + (cond ((not hash) nil) + (org-babel-hash-show-time + (format "[%s %s]" + (format-time-string "<%F %T>") + hash)) + (t (format "[%s]" hash))) + ":" + (when name (concat " " name)) + "\n")) + ;; Make sure results are going to be followed by at least one blank + ;; line so they do not get merged with the next element, e.g., + ;; + ;; #+results: + ;; : 1 + ;; + ;; : fixed-width area, unrelated to the above. + (unless (looking-at "^[ \t]*$") (save-excursion (insert "\n"))) + (beginning-of-line 0) + (when hash (org-babel-hide-hash))) + +(defun org-babel--clear-results-maybe (hash) + "Clear results when hash doesn't match HASH. + +When results hash does not match HASH, remove RESULTS keyword at +point, along with related contents. Do nothing if HASH is nil. + +Return a non-nil value if results were cleared. In this case, +leave point where new results should be inserted." + (when hash + (looking-at org-babel-result-regexp) + (unless (string= (match-string 1) hash) + (let* ((e (org-element-at-point)) + (post (copy-marker (org-element-property :post-affiliated e)))) + ;; Delete contents. + (delete-region post + (save-excursion + (goto-char (org-element-property :end e)) + (skip-chars-backward " \t\n") + (line-beginning-position 2))) + ;; Delete RESULT keyword. However, if RESULTS keyword is + ;; orphaned, ignore this part. The deletion above already + ;; took care of it. + (unless (= (point) post) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (goto-char post) + (set-marker post nil) + t)))) + +(defun org-babel-where-is-src-block-result (&optional insert _info hash) "Find where the current source block results begin. + Return the point at the beginning of the result of the current -source block. Specifically at the beginning of the results line. -If no result exists for this block then create a results line -following the source block." - (save-excursion - (let* ((case-fold-search t) - (on-lob-line (save-excursion - (beginning-of-line 1) - (looking-at org-babel-lob-one-liner-regexp))) - (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) - (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (head (unless on-lob-line (org-babel-where-is-src-block-head))) - found beg end) - (when head (goto-char head)) +source block, specifically at the beginning of the results line. + +If no result exists for this block return nil, unless optional +argument INSERT is non-nil. In this case, create a results line +following the source block and return the position at its +beginning. In the case of inline code, remove the results part +instead. + +If optional argument HASH is a string, remove contents related to +RESULTS keyword if its hash is different. Then update the latter +to HASH." + (let ((context (org-element-context))) + (catch :found (org-with-wide-buffer - (setq - found ;; was there a result (before we potentially insert one) - (or - inlinep - (and - ;; named results: - ;; - return t if it is found, else return nil - ;; - if it does not need to be rebuilt, then don't set end - ;; - if it does need to be rebuilt then do set end - name (setq beg (org-babel-find-named-result name)) - (prog1 beg - (when (and hash (not (string= hash (match-string 5)))) - (goto-char beg) (setq end beg) ;; beginning of result - (forward-line 1) - (delete-region end (org-babel-result-end)) nil))) - (and - ;; unnamed results: - ;; - return t if it is found, else return nil - ;; - if it is found, and the hash doesn't match, delete and set end - (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) - (progn (end-of-line 1) - (if (eobp) (insert "\n") (forward-char 1)) - (setq end (point)) - (or (and - (not name) - (progn ;; unnamed results line already exists - (catch 'non-comment - (while (re-search-forward "[^ \f\t\n\r\v]" nil t) - (beginning-of-line 1) - (cond - ((looking-at (concat org-babel-result-regexp "\n")) - (throw 'non-comment t)) - ((looking-at "^[ \t]*#") (end-of-line 1)) - (t (throw 'non-comment nil)))))) - (let ((this-hash (match-string 5))) - (prog1 (point) - ;; must remove and rebuild if hash!=old-hash - (if (and hash (not (string= hash this-hash))) - (prog1 nil - (forward-line 1) - (delete-region - end (org-babel-result-end))) - (setq end nil))))))))))) - (if (not (and insert end)) found - (goto-char end) - (unless beg - (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) - (insert (concat - (when (wholenump indent) (make-string indent ? )) - "#+" org-babel-results-keyword - (when hash - (if org-babel-hash-show-time - (concat - "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]") - (concat "["hash"]"))) - ":" - (when name (concat " " name)) "\n")) - (unless beg (insert "\n") (backward-char)) - (beginning-of-line 0) - (if hash (org-babel-hide-hash)) - (point))))) - -(defvar org-block-regexp) + (pcase (org-element-type context) + ((or `inline-babel-call `inline-src-block) + ;; Results for inline objects are located right after them. + ;; There is no RESULTS line to insert either. + (let ((limit (org-element-property + :contents-end (org-element-property :parent context)))) + (goto-char (org-element-property :end context)) + (skip-chars-forward " \t\n" limit) + (throw :found + (and + (< (point) limit) + (let ((result (org-element-context))) + (and (eq (org-element-type result) 'macro) + (string= (org-element-property :key result) + "results") + (if (not insert) (point) + (delete-region + (point) + (progn + (goto-char (org-element-property :end result)) + (skip-chars-backward " \t") + (point))) + (point)))))))) + ((or `babel-call `src-block) + (let* ((name (org-element-property :name context)) + (named-results (and name (org-babel-find-named-result name)))) + (goto-char (or named-results (org-element-property :end context))) + (cond + ;; Existing results named after the current source. + (named-results + (when (org-babel--clear-results-maybe hash) + (org-babel--insert-results-keyword name hash)) + (throw :found (point))) + ;; Named results expect but none to be found. + (name) + ;; No possible anonymous results at the very end of + ;; buffer or outside CONTEXT parent. + ((eq (point) + (or (org-element-property + :contents-end (org-element-property :parent context)) + (point-max)))) + ;; Check if next element is an anonymous result below + ;; the current block. + ((let* ((next (org-element-at-point)) + (end (save-excursion + (goto-char + (org-element-property :post-affiliated next)) + (line-end-position))) + (empty-result-re (concat org-babel-result-regexp "$")) + (case-fold-search t)) + (re-search-forward empty-result-re end t)) + (beginning-of-line) + (when (org-babel--clear-results-maybe hash) + (org-babel--insert-results-keyword nil hash)) + (throw :found (point)))))) + ;; Ignore other elements. + (_ (throw :found nil)))) + ;; No result found. Insert a RESULTS keyword below element, if + ;; appropriate. In this case, ensure there is an empty line + ;; after the previous element. + (when insert + (save-excursion + (goto-char (min (org-element-property :end context) (point-max))) + (skip-chars-backward " \t\n") + (forward-line) + (unless (bolp) (insert "\n")) + (insert "\n") + (org-babel--insert-results-keyword + (org-element-property :name context) hash) + (point)))))) + +(defun org-babel-read-element (element) + "Read ELEMENT into emacs-lisp. +Return nil if ELEMENT cannot be read." + (org-with-wide-buffer + (goto-char (org-element-property :post-affiliated element)) + (pcase (org-element-type element) + (`fixed-width + (let ((v (org-trim (org-element-property :value element)))) + (or (org-babel--string-to-number v) v))) + (`table (org-babel-read-table)) + (`plain-list (org-babel-read-list)) + (`example-block + (let ((v (org-element-property :value element))) + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + v + (org-remove-indentation v)))) + (`export-block + (org-remove-indentation (org-element-property :value element))) + (`paragraph + ;; Treat paragraphs containing a single link specially. + (skip-chars-forward " \t") + (if (and (looking-at org-bracket-link-regexp) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \r\t\n") + (<= (org-element-property :end element) + (point)))) + (org-babel-read-link) + (buffer-substring-no-properties + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + ((or `center-block `quote-block `verse-block `special-block) + (org-remove-indentation + (buffer-substring-no-properties + (org-element-property :contents-begin element) + (org-element-property :contents-end element)))) + (_ nil)))) + (defun org-babel-read-result () - "Read the result at `point' into emacs-lisp." - (let ((case-fold-search t) result-string) - (cond - ((org-at-table-p) (org-babel-read-table)) - ((org-at-item-p) (org-babel-read-list)) - ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) - ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) - (setq result-string - (org-babel-trim - (mapconcat (lambda (line) - (or (and (> (length line) 1) - (string-match "^[ \t]*: ?\\(.+\\)" line) - (match-string 1 line)) - "")) - (split-string - (buffer-substring - (point) (org-babel-result-end)) "[\r\n]+") - "\n"))) - (or (org-babel-number-p result-string) result-string)) - ((looking-at org-babel-result-regexp) - (save-excursion (forward-line 1) (org-babel-read-result)))))) + "Read the result at point into emacs-lisp." + (and (not (save-excursion + (beginning-of-line) + (looking-at-p "[ \t]*$"))) + (org-babel-read-element (org-element-at-point)))) (defun org-babel-read-table () - "Read the table at `point' into emacs-lisp." + "Read the table at point into emacs-lisp." (mapcar (lambda (row) (if (and (symbolp row) (equal row 'hline)) row (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) (org-table-to-lisp))) (defun org-babel-read-list () - "Read the list at `point' into emacs-lisp." + "Read the list at point into emacs-lisp." (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) - (mapcar #'cadr (cdr (org-list-parse-list))))) + (cdr (org-list-to-lisp)))) (defvar org-link-types-re) (defun org-babel-read-link () - "Read the link at `point' into emacs-lisp. + "Read the link at point into emacs-lisp. If the path of the link is a file path it is expanded using `expand-file-name'." (let* ((case-fold-search t) @@ -1975,204 +2125,320 @@ If the path of the link is a file path it is expanded using ;; scalar result (funcall echo-res result)))) -(defun org-babel-insert-result - (result &optional result-params info hash indent lang) +(defun org-babel-insert-result (result &optional result-params info hash lang) "Insert RESULT into the current buffer. -By default RESULT is inserted after the end of the -current source block. With optional argument RESULT-PARAMS -controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values: + +By default RESULT is inserted after the end of the current source +block. The RESULT of an inline source block usually will be +wrapped inside a `results' macro and placed on the same line as +the inline source block. The macro is stripped upon export. +Multiline and non-scalar RESULTS from inline source blocks are +not allowed. With optional argument RESULT-PARAMS controls +insertion of results in the Org mode file. RESULT-PARAMS can +take the following values: replace - (default option) insert results after the source block - replacing any previously inserted results + or inline source block replacing any previously + inserted results. -silent -- no results are inserted into the Org-mode buffer but +silent -- no results are inserted into the Org buffer but the results are echoed to the minibuffer and are ingested by Emacs (a potentially time consuming - process) + process). file ---- the results are interpreted as a file path, and are - inserted into the buffer using the Org-mode file syntax + inserted into the buffer using the Org file syntax. -list ---- the results are interpreted as an Org-mode list. +list ---- the results are interpreted as an Org list. -raw ----- results are added directly to the Org-mode file. This - is a good option if you code block will output org-mode +raw ----- results are added directly to the Org file. This is + a good option if you code block will output Org formatted text. -drawer -- results are added directly to the Org-mode file as with - \"raw\", but are wrapped in a RESULTS drawer, allowing - them to later be replaced or removed automatically. +drawer -- results are added directly to the Org file as with + \"raw\", but are wrapped in a RESULTS drawer or results + macro, allowing them to later be replaced or removed + automatically. -org ----- results are added inside of a \"#+BEGIN_SRC org\" block. - They are not comma-escaped when inserted, but Org syntax - here will be discarded when exporting the file. +org ----- results are added inside of a \"src_org{}\" or \"#+BEGIN_SRC + org\" block depending on whether the current source block is + inline or not. They are not comma-escaped when inserted, + but Org syntax here will be discarded when exporting the + file. -html ---- results are added inside of a #+BEGIN_HTML block. This - is a good option if you code block will output html - formatted text. +html ---- results are added inside of a #+BEGIN_EXPORT HTML block + or html export snippet depending on whether the current + source block is inline or not. This is a good option + if your code block will output html formatted text. -latex --- results are added inside of a #+BEGIN_LATEX block. - This is a good option if you code block will output - latex formatted text. +latex --- results are added inside of a #+BEGIN_EXPORT LATEX + block or latex export snippet depending on whether the + current source block is inline or not. This is a good + option if your code block will output latex formatted + text. code ---- the results are extracted in the syntax of the source code of the language being evaluated and are added - inside of a #+BEGIN_SRC block with the source-code - language set appropriately. Note this relies on the - optional LANG argument." - (if (stringp result) - (progn - (setq result (org-no-properties result)) - (when (member "file" result-params) - (setq result (org-babel-result-to-file - result (when (assoc :file-desc (nth 2 info)) - (or (cdr (assoc :file-desc (nth 2 info))) - result)))))) - (unless (listp result) (setq result (format "%S" result)))) + inside of a source block with the source-code language + set appropriately. Also, source block inlining is + preserved in this case. Note this relies on the + optional LANG argument. + +list ---- the results are rendered as a list. This option not + allowed for inline src blocks. + +table --- the results are rendered as a table. This option not + allowed for inline src blocks. + +INFO may provide the values of these header arguments (in the +`header-arguments-alist' see the docstring for +`org-babel-get-src-block-info'): + +:file --- the name of the file to which output should be written. + +:wrap --- the effect is similar to `latex' in RESULT-PARAMS but + using the argument supplied to specify the export block + or snippet type." + (cond ((stringp result) + (setq result (org-no-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file + result (when (assq :file-desc (nth 2 info)) + (or (cdr (assq :file-desc (nth 2 info))) + result)))))) + ((listp result)) + (t (setq result (format "%S" result)))) (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (save-excursion - (let* ((inlinep - (save-excursion - (when (or (org-babel-get-inline-src-block-matches) - (org-babel-get-lob-one-liner-matches)) - (goto-char (match-end 0)) - (insert (if (listp result) "\n" " ")) - (point)))) - (existing-result (unless inlinep - (org-babel-where-is-src-block-result - t info hash indent))) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - (visible-beg (point-min-marker)) - (visible-end (point-max-marker)) - ;; When results exist outside of the current visible - ;; region of the buffer, be sure to widen buffer to - ;; update them. - (outside-scope-p (and existing-result + (progn (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (let ((inline (let ((context (org-element-context))) + (and (memq (org-element-type context) + '(inline-babel-call inline-src-block)) + context)))) + (when inline + (let ((warning + (or (and (member "table" result-params) "`:results table'") + (and (listp result) "list result") + (and (string-match-p "\n." result) "multiline result") + (and (member "list" result-params) "`:results list'")))) + (when warning + (user-error "Inline error: %s cannot be used" warning)))) + (save-excursion + (let* ((visible-beg (point-min-marker)) + (visible-end (copy-marker (point-max) t)) + (inline (let ((context (org-element-context))) + (and (memq (org-element-type context) + '(inline-babel-call inline-src-block)) + context))) + (existing-result (org-babel-where-is-src-block-result t nil hash)) + (results-switches (cdr (assq :results_switches (nth 2 info)))) + ;; When results exist outside of the current visible + ;; region of the buffer, be sure to widen buffer to + ;; update them. + (outside-scope (and existing-result + (buffer-narrowed-p) (or (> visible-beg existing-result) (<= visible-end existing-result)))) - beg end) - (when (and (stringp result) ; ensure results end in a newline - (not inlinep) - (> (length result) 0) - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (unwind-protect - (progn - (when outside-scope-p (widen)) - (if (not existing-result) - (setq beg (or inlinep (point))) - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) + beg end indent) + ;; Ensure non-inline results end in a newline. + (when (and (org-string-nw-p result) + (not inline) + (not (string-equal (substring result -1) "\n"))) + (setq result (concat result "\n"))) + (unwind-protect + (progn + (when outside-scope (widen)) + (if existing-result (goto-char existing-result) + (goto-char (org-element-property :end inline)) + (skip-chars-backward " \t")) + (unless inline + (setq indent (org-get-indentation)) + (forward-line 1)) (setq beg (point)) (cond + (inline + ;; Make sure new results are separated from the + ;; source code by one space. + (unless existing-result + (insert " ") + (setq beg (point)))) ((member "replace" result-params) (delete-region (point) (org-babel-result-end))) ((member "append" result-params) (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params)))) ; already there - (setq results-switches - (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish &optional no-escape) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) - (unless no-escape - (org-escape-code-in-region (min (point) end) end)) - (goto-char end) (goto-char (point-at-eol)) - (setq end (point-marker)))) - (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) - ;; insert results based on type - (cond - ;; do nothing for an empty result - ((null result)) - ;; insert a list if preferred - ((member "list" result-params) - (insert - (org-babel-trim - (org-list-to-generic - (cons 'unordered - (mapcar - (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) - (if (listp result) result (split-string result "\n" t)))) - '(:splicep nil :istart "- " :iend "\n"))) - "\n")) - ;; assume the result is a table if it's not a string - ((funcall proper-list-p result) - (goto-char beg) - (insert (concat (orgtbl-to-orgtbl - (if (org-every - (lambda (el) (or (listp el) (eq el 'hline))) - result) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (funcall proper-list-p result))) - (insert (format "%s\n" result))) - ((member "file" result-params) - (when inlinep (goto-char inlinep)) - (insert result)) - (t (goto-char beg) (insert result))) - (when (funcall proper-list-p result) (goto-char (org-table-end))) - (setq end (point-marker)) - ;; possibly wrap result - (cond - ((assoc :wrap (nth 2 info)) - (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) - (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (org-split-string name)))))) - ((member "html" result-params) - (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) - ((member "latex" result-params) - (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) - ((member "org" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) - ((member "code" result-params) - (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) - ((member "raw" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((or (member "drawer" result-params) - ;; Stay backward compatible with <7.9.2 - (member "wrap" result-params)) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap ":RESULTS:" ":END:" 'no-escape)) - ((and (not (funcall proper-list-p result)) - (not (member "file" result-params))) - (org-babel-examplize-region beg end results-switches) - (setq end (point))))) - ;; possibly indent the results to match the #+results line - (when (and (not inlinep) (numberp indent) indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)) - (if (null result) - (if (member "value" result-params) - (message "Code block returned no value.") - (message "Code block produced no output.")) - (message "Code block evaluation complete."))) - (when outside-scope-p (narrow-to-region visible-beg visible-end)) - (set-marker visible-beg nil) - (set-marker visible-end nil)))))) - -(defun org-babel-remove-result (&optional info) + ((member "prepend" result-params))) ; already there + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (let ((wrap (lambda (start finish &optional no-escape no-newlines + inline-start inline-finish) + (when inline + (setq start inline-start) + (setq finish inline-finish) + (setq no-newlines t)) + (goto-char end) + (insert (concat finish (unless no-newlines "\n"))) + (goto-char beg) + (insert (concat start (unless no-newlines "\n"))) + (unless no-escape + (org-escape-code-in-region (min (point) end) end)) + (goto-char end) + (unless no-newlines (goto-char (point-at-eol))) + (setq end (point-marker)))) + (tabulablep + (lambda (r) + ;; Non-nil when result R can be turned into + ;; a table. + (and (listp r) + (null (cdr (last r))) + (cl-every + (lambda (e) (or (atom e) (null (cdr (last e))))) + result))))) + ;; insert results based on type + (cond + ;; Do nothing for an empty result. + ((null result)) + ;; Insert a list if preferred. + ((member "list" result-params) + (insert + (org-trim + (org-list-to-generic + (cons 'unordered + (mapcar + (lambda (e) + (list (if (stringp e) e (format "%S" e)))) + (if (listp result) result + (split-string result "\n" t)))) + '(:splicep nil :istart "- " :iend "\n"))) + "\n")) + ;; Try hard to print RESULT as a table. Give up if + ;; it contains an improper list. + ((funcall tabulablep result) + (goto-char beg) + (insert (concat (orgtbl-to-orgtbl + (if (cl-every + (lambda (e) + (or (eq e 'hline) (listp e))) + result) + result + (list result)) + nil) + "\n")) + (goto-char beg) + (when (org-at-table-p) (org-table-align)) + (goto-char (org-table-end))) + ;; Print verbatim a list that cannot be turned into + ;; a table. + ((listp result) (insert (format "%s\n" result))) + ((member "file" result-params) + (when inline + (setq result (org-macro-escape-arguments result))) + (insert result)) + ((and inline (not (member "raw" result-params))) + (insert (org-macro-escape-arguments + (org-babel-chomp result "\n")))) + (t (goto-char beg) (insert result))) + (setq end (point-marker)) + ;; possibly wrap result + (cond + ((assq :wrap (nth 2 info)) + (let ((name (or (cdr (assq :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) + (concat "#+END_" (car (org-split-string name))) + nil nil (concat "{{{results(@@" name ":") "@@)}}}"))) + ((member "html" result-params) + (funcall wrap "#+BEGIN_EXPORT html" "#+END_EXPORT" nil nil + "{{{results(@@html:" "@@)}}}")) + ((member "latex" result-params) + (funcall wrap "#+BEGIN_EXPORT latex" "#+END_EXPORT" nil nil + "{{{results(@@latex:" "@@)}}}")) + ((member "org" result-params) + (goto-char beg) (when (org-at-table-p) (org-cycle)) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC" nil nil + "{{{results(src_org{" "})}}}")) + ((member "code" result-params) + (let ((lang (or lang "none"))) + (funcall wrap (format "#+BEGIN_SRC %s%s" lang results-switches) + "#+END_SRC" nil nil + (format "{{{results(src_%s[%s]{" lang results-switches) + "})}}}"))) + ((member "raw" result-params) + (goto-char beg) (when (org-at-table-p) (org-cycle))) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (goto-char beg) (when (org-at-table-p) (org-cycle)) + (funcall wrap ":RESULTS:" ":END:" 'no-escape nil + "{{{results(" ")}}}")) + ((and inline (member "file" result-params)) + (funcall wrap nil nil nil nil "{{{results(" ")}}}")) + ((and (not (funcall tabulablep result)) + (not (member "file" result-params))) + (let ((org-babel-inline-result-wrap + ;; Hard code {{{results(...)}}} on top of customization. + (format "{{{results(%s)}}}" + org-babel-inline-result-wrap))) + (org-babel-examplify-region beg end results-switches inline) + (setq end (point)))))) + ;; Possibly indent results in par with #+results line. + (when (and (not inline) (numberp indent) (> indent 0) + ;; In this case `table-align' does the work + ;; for us. + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)) + (if (null result) + (if (member "value" result-params) + (message "Code block returned no value.") + (message "Code block produced no output.")) + (message "Code block evaluation complete."))) + (when outside-scope (narrow-to-region visible-beg visible-end)) + (set-marker visible-beg nil) + (set-marker visible-end nil))))))) + +(defun org-babel-remove-result (&optional info keep-keyword) "Remove the result of the current source block." (interactive) - (let ((location (org-babel-where-is-src-block-result nil info)) start) + (let ((location (org-babel-where-is-src-block-result nil info))) (when location - (setq start (- location 1)) (save-excursion - (goto-char location) (forward-line 1) - (delete-region start (org-babel-result-end)))))) + (goto-char location) + (when (looking-at (concat org-babel-result-regexp ".*$")) + (delete-region + (if keep-keyword (1+ (match-end 0)) (1- (match-beginning 0))) + (progn (forward-line 1) (org-babel-result-end)))))))) + +(defun org-babel-remove-inline-result (&optional datum) + "Remove the result of the current inline-src-block or babel call. +The result must be wrapped in a `results' macro to be removed. +Leading white space is trimmed." + (interactive) + (let* ((el (or datum (org-element-context)))) + (when (memq (org-element-type el) '(inline-src-block inline-babel-call)) + (org-with-wide-buffer + (goto-char (org-element-property :end el)) + (skip-chars-backward " \t") + (let ((result (save-excursion + (skip-chars-forward + " \t\n" + (org-element-property + :contents-end (org-element-property :parent el))) + (org-element-context)))) + (when (and (eq (org-element-type result) 'macro) + (string= (org-element-property :key result) "results")) + (delete-region ; And leading whitespace. + (point) + (progn (goto-char (org-element-property :end result)) + (skip-chars-backward " \t\n") + (point))))))))) + +(defun org-babel-remove-result-one-or-many (x) + "Remove the result of the current source block. +If called with a prefix argument, remove all result blocks +in the buffer." + (interactive "P") + (if x + (org-babel-map-src-blocks nil (org-babel-remove-result)) + (org-babel-remove-result))) (defun org-babel-result-end () "Return the point at the end of the current set of results." @@ -2210,29 +2476,26 @@ file's directory then expand relative links." result) (if description (concat "[" description "]") "")))) -(defvar org-babel-capitalize-examplize-region-markers nil +(defvar org-babel-capitalize-example-region-markers nil "Make true to capitalize begin/end example markers inserted by code blocks.") -(defun org-babel-examplize-region (beg end &optional results-switches) +(defun org-babel-examplify-region (beg end &optional results-switches inline) "Comment out region using the inline `==' or `: ' org example quote." (interactive "*r") - (let ((chars-between (lambda (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e))))) - (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str)))) - (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (let ((maybe-cap + (lambda (str) + (if org-babel-capitalize-example-region-markers (upcase str) str)))) + (if inline (save-excursion (goto-char beg) (insert (format org-babel-inline-result-wrap - (prog1 (buffer-substring beg end) - (delete-region beg end))))) + (delete-and-extract-region beg end)))) (let ((size (count-lines beg end))) (save-excursion (cond ((= size 0)) ; do nothing for an empty result ((< size org-babel-min-lines-for-block-output) (goto-char beg) - (dotimes (n size) + (dotimes (_ size) (beginning-of-line 1) (insert ": ") (forward-line 1))) (t (goto-char beg) @@ -2241,16 +2504,37 @@ file's directory then expand relative links." (funcall maybe-cap "#+begin_example") results-switches) (funcall maybe-cap "#+begin_example\n"))) - (if (markerp end) (goto-char end) (forward-char (- end beg))) + (let ((p (point))) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (org-escape-code-in-region p (point))) (insert (funcall maybe-cap "#+end_example\n"))))))))) (defun org-babel-update-block-body (new-body) "Update the body of the current code block to NEW-BODY." - (if (not (org-babel-where-is-src-block-head)) - (error "Not in a source block") - (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) - (indent-rigidly (match-beginning 5) (match-end 5) 2))) + (let ((element (org-element-at-point))) + (unless (eq (org-element-type element) 'src-block) + (error "Not in a source block")) + (goto-char (org-babel-where-is-src-block-head element)) + (let* ((ind (org-get-indentation)) + (body-start (line-beginning-position 2)) + (body (org-element-normalize-string + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + new-body + (with-temp-buffer + (insert (org-remove-indentation new-body)) + (indent-rigidly + (point-min) + (point-max) + (+ ind org-edit-src-content-indentation)) + (buffer-string)))))) + (delete-region body-start + (org-with-wide-buffer + (goto-char (org-element-property :end element)) + (skip-chars-backward " \t\n") + (line-beginning-position))) + (goto-char body-start) + (insert body)))) (defun org-babel-merge-params (&rest plists) "Combine all parameter association lists in PLISTS. @@ -2259,133 +2543,103 @@ This takes into account some special considerations for certain parameters when merging lists." (let* ((results-exclusive-groups (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (cdr (assq 'results org-babel-common-header-args-w-values)))) (exports-exclusive-groups (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - (e-merge (lambda (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - params results exports tangle noweb cache vars shebang comments padline - clearnames) - - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (progn - (push name clearnames) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars))) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (let ((name (car (nth variable-index vars)))) - (push name clearnames) ; clear out colnames - ; and rownames - ; for replace vars - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name name) "=" (cdr pair))) - (incf variable-index))) - (error "Variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (funcall e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (funcall e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (funcall e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (funcall e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (funcall e-merge - '(("yes" "no" "tangle" "no-export" - "strip-export" "eval")) - noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (funcall e-merge '(("yes" "no")) cache - (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (funcall e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (funcall e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists) - (setq vars (reverse vars)) - (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) - ;; clear out col-names and row-names for replaced variables - (mapc - (lambda (name) - (mapc - (lambda (param) - (when (assoc param params) - (setf (cdr (assoc param params)) - (org-remove-if (lambda (pair) (equal (car pair) name)) - (cdr (assoc param params)))) - (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param) - (null (cdr pair)))) - params)))) - (list :colname-names :rowname-names))) - clearnames) - (mapc - (lambda (hd) - (let ((key (intern (concat ":" (symbol-name hd)))) - (val (eval hd))) - (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) - '(results exports tangle noweb padline cache shebang comments)) + (cdr (assq 'exports org-babel-common-header-args-w-values)))) + (merge + (lambda (exclusive-groups &rest result-params) + ;; Maintain exclusivity of mutually exclusive parameters, + ;; as defined in EXCLUSIVE-GROUPS while merging lists in + ;; RESULT-PARAMS. + (let (output) + (dolist (new-params result-params (delete-dups output)) + (dolist (new-param new-params) + (dolist (exclusive-group exclusive-groups) + (when (member new-param exclusive-group) + (setq output (cl-remove-if + (lambda (o) (member o exclusive-group)) + output)))) + (push new-param output)))))) + (variable-index 0) ;Handle positional arguments. + clearnames + params ;Final parameters list. + ;; Some keywords accept multiple values. We need to treat + ;; them specially. + vars results exports) + (dolist (plist plists) + (dolist (pair plist) + (pcase pair + (`(:var . ,value) + (let ((name (cond + ((listp value) (car value)) + ((string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" value) + (intern (match-string 1 value))) + (t nil)))) + (cond + (name + (setq vars + (append (if (not (assoc name vars)) vars + (push name clearnames) + (cl-remove-if (lambda (p) (equal name (car p))) + vars)) + (list (cons name pair))))) + ((and vars (nth variable-index vars)) + ;; If no name is given and we already have named + ;; variables then assign to named variables in order. + (let ((name (car (nth variable-index vars)))) + ;; Clear out colnames and rownames for replace vars. + (push name clearnames) + (setf (cddr (nth variable-index vars)) + (concat (symbol-name name) "=" value)) + (cl-incf variable-index))) + (t (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (`(:results . ,value) + (setq results (funcall merge + results-exclusive-groups + results + (split-string + (if (stringp value) value (eval value t)))))) + (`(,(or :file :file-ext) . ,value) + ;; `:file' and `:file-ext' are regular keywords but they + ;; imply a "file" `:results' and a "results" `:exports'. + (when value + (setq results + (funcall merge results-exclusive-groups results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports + (funcall merge + exports-exclusive-groups exports '("results")))) + (push pair params))) + (`(:exports . ,value) + (setq exports (funcall merge + exports-exclusive-groups + exports + (split-string (or value ""))))) + ;; Regular keywords: any value overwrites the previous one. + (_ (setq params (cons pair (assq-delete-all (car pair) params))))))) + ;; Handle `:var' and clear out colnames and rownames for replaced + ;; variables. + (setq params (nconc (mapcar (lambda (v) (cons :var (cddr v))) vars) + params)) + (dolist (name clearnames) + (dolist (param '(:colname-names :rowname-names)) + (when (assq param params) + (setf (cdr (assq param params)) + (cl-remove-if (lambda (pair) (equal name (car pair))) + (cdr (assq param params)))) + (setq params + (cl-remove-if (lambda (pair) (and (equal (car pair) param) + (null (cdr pair)))) + params))))) + ;; Handle other special keywords, which accept multiple values. + (setq params (nconc (list (cons :results (mapconcat #'identity results " ")) + (cons :exports (mapconcat #'identity exports " "))) + params)) + ;; Return merged params. params)) (defvar org-babel-use-quick-and-dirty-noweb-expansion nil @@ -2397,17 +2651,12 @@ header argument from buffer or subtree wide properties.") (defun org-babel-noweb-p (params context) "Check if PARAMS require expansion in CONTEXT. CONTEXT may be one of :tangle, :export or :eval." - (let* (intersect - (intersect (lambda (as bs) - (when as - (if (member (car as) bs) - (car as) - (funcall intersect (cdr as) bs)))))) - (funcall intersect (case context - (:tangle '("yes" "tangle" "no-export" "strip-export")) - (:eval '("yes" "no-export" "strip-export" "eval")) - (:export '("yes"))) - (split-string (or (cdr (assoc :noweb params)) ""))))) + (let ((allowed-values (cl-case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))))) + (cl-some (lambda (v) (member v allowed-values)) + (split-string (or (cdr (assq :noweb params)) ""))))) (defun org-babel-expand-noweb-references (&optional info parent-buffer) "Expand Noweb references in the body of the current source code block. @@ -2445,7 +2694,7 @@ block but are passed literally to the \"example-block\"." (body (nth 1 info)) (ob-nww-start org-babel-noweb-wrap-start) (ob-nww-end org-babel-noweb-wrap-end) - (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) + (comment (string= "noweb" (cdr (assq :comments (nth 2 info))))) (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" ":noweb-ref[ \t]+" "\\)")) (new-body "") @@ -2454,11 +2703,11 @@ block but are passed literally to the \"example-block\"." (with-temp-buffer (funcall (intern (concat lang "-mode"))) (comment-region (point) (progn (insert text) (point))) - (org-babel-trim (buffer-string))))) + (org-trim (buffer-string))))) index source-name evaluate prefix) (with-temp-buffer - (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) - (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (setq-local org-babel-noweb-wrap-start ob-nww-start) + (setq-local org-babel-noweb-wrap-end ob-nww-end) (insert body) (goto-char (point-min)) (setq index (point)) (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) @@ -2502,7 +2751,7 @@ block but are passed literally to the \"example-block\"." (while (re-search-forward rx nil t) (let* ((i (org-babel-get-src-block-info 'light)) (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + (sep (or (cdr (assq :noweb-sep (nth 2 i))) "\n")) (full (if comment (let ((cs (org-babel-tangle-comment-links i))) @@ -2513,11 +2762,11 @@ block but are passed literally to the \"example-block\"." (setq expansion (cons sep (cons full expansion))))) (org-babel-map-src-blocks nil (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (when (equal (or (cdr (assq :noweb-ref (nth 2 i))) (nth 4 i)) source-name) (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + (sep (or (cdr (assq :noweb-sep (nth 2 i))) "\n")) (full (if comment (let ((cs (org-babel-tangle-comment-links i))) @@ -2530,7 +2779,8 @@ block but are passed literally to the \"example-block\"." (and expansion (mapconcat #'identity (nreverse (cdr expansion)) ""))) ;; Possibly raise an error if named block doesn't exist. - (if (member lang org-babel-noweb-error-langs) + (if (or org-babel-noweb-error-all-langs + (member lang org-babel-noweb-error-langs)) (error "%s" (concat (org-babel-noweb-wrap source-name) "could not be resolved (see " @@ -2540,79 +2790,120 @@ block but are passed literally to the \"example-block\"." (funcall nb-add (buffer-substring index (point-max)))) new-body)) +(defun org-babel--script-escape-inner (str) + (let (in-single in-double backslash out) + (mapc + (lambda (ch) + (setq + out + (if backslash + (progn + (setq backslash nil) + (cond + ((and in-single (eq ch ?')) + ;; Escaped single quote inside single quoted string: + ;; emit just a single quote, since we've changed the + ;; outer quotes to double. + (cons ch out)) + ((eq ch ?\") + ;; Escaped double quote + (if in-single + ;; This should be interpreted as backslash+quote, + ;; not an escape. Emit a three backslashes + ;; followed by a quote (because one layer of + ;; quoting will be stripped by `org-babel-read'). + (append (list ch ?\\ ?\\ ?\\) out) + ;; Otherwise we are in a double-quoted string. Emit + ;; a single escaped quote + (append (list ch ?\\) out))) + ((eq ch ?\\) + ;; Escaped backslash: emit a single escaped backslash + (append (list ?\\ ?\\) out)) + ;; Other: emit a quoted backslash followed by whatever + ;; the character was (because one layer of quoting will + ;; be stripped by `org-babel-read'). + (t (append (list ch ?\\ ?\\) out)))) + (cl-case ch + (?\[ (if (or in-double in-single) + (cons ?\[ out) + (cons ?\( out))) + (?\] (if (or in-double in-single) + (cons ?\] out) + (cons ?\) out))) + (?\{ (if (or in-double in-single) + (cons ?\{ out) + (cons ?\( out))) + (?\} (if (or in-double in-single) + (cons ?\} out) + (cons ?\) out))) + (?, (if (or in-double in-single) + (cons ?, out) (cons ?\s out))) + (?\' (if in-double + (cons ?\' out) + (setq in-single (not in-single)) (cons ?\" out))) + (?\" (if in-single + (append (list ?\" ?\\) out) + (setq in-double (not in-double)) (cons ?\" out))) + (?\\ (unless (or in-single in-double) + (error "Can't handle backslash outside string in `org-babel-script-escape'")) + (setq backslash t) + out) + (t (cons ch out)))))) + (string-to-list str)) + (when (or in-single in-double) + (error "Unterminated string in `org-babel-script-escape'")) + (apply #'string (reverse out)))) + (defun org-babel-script-escape (str &optional force) "Safely convert tables into elisp lists." + (unless (stringp str) + (error "`org-babel-script-escape' expects a string")) (let ((escaped - (if (or force - (and (stringp str) - (> (length str) 2) - (or (and (string-equal "[" (substring str 0 1)) - (string-equal "]" (substring str -1))) - (and (string-equal "{" (substring str 0 1)) - (string-equal "}" (substring str -1))) - (and (string-equal "(" (substring str 0 1)) - (string-equal ")" (substring str -1)))))) - (org-babel-read - (concat - "'" - (let (in-single in-double out) - (mapc - (lambda (ch) - (setq - out - (case ch - (91 (if (or in-double in-single) ; [ - (cons 91 out) - (cons 40 out))) - (93 (if (or in-double in-single) ; ] - (cons 93 out) - (cons 41 out))) - (123 (if (or in-double in-single) ; { - (cons 123 out) - (cons 40 out))) - (125 (if (or in-double in-single) ; } - (cons 125 out) - (cons 41 out))) - (44 (if (or in-double in-single) ; , - (cons 44 out) (cons 32 out))) - (39 (if in-double ; ' - (cons 39 out) - (setq in-single (not in-single)) (cons 34 out))) - (34 (if in-single ; " - (append (list 34 32) out) - (setq in-double (not in-double)) (cons 34 out))) - (t (cons ch out))))) - (string-to-list str)) - (apply #'string (reverse out))))) - str))) + (cond + ((and (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1))))) + + (concat "'" (org-babel--script-escape-inner str))) + ((or force + (and (> (length str) 2) + (or (and (string-equal "'" (substring str 0 1)) + (string-equal "'" (substring str -1))) + ;; We need to pass double-quoted strings + ;; through the backslash-twiddling bits, even + ;; though we don't need to change their + ;; delimiters. + (and (string-equal "\"" (substring str 0 1)) + (string-equal "\"" (substring str -1)))))) + (org-babel--script-escape-inner str)) + (t str)))) (condition-case nil (org-babel-read escaped) (error escaped)))) (defun org-babel-read (cell &optional inhibit-lisp-eval) "Convert the string value of CELL to a number if appropriate. -Otherwise if cell looks like lisp (meaning it starts with a -\"(\", \"\\='\", \"\\=`\" or a \"[\") then read it as lisp, -otherwise return it unmodified as a string. Optional argument -NO-LISP-EVAL inhibits lisp evaluation for situations in which is -it not appropriate." - (if (and (stringp cell) (not (equal cell ""))) - (or (org-babel-number-p cell) - (if (and (not inhibit-lisp-eval) - (or (member (substring cell 0 1) '("(" "'" "`" "[")) - (string= cell "*this*"))) - (eval (read cell)) - (if (string= (substring cell 0 1) "\"") - (read cell) - (progn (set-text-properties 0 (length cell) nil cell) cell)))) - cell)) - -(defun org-babel-number-p (string) - "If STRING represents a number return its value." - (if (and (string-match "[0-9]+" string) - (string-match "^-?[0-9]*\\.?[0-9]*$" string) - (= (length (substring string (match-beginning 0) - (match-end 0))) - (length string))) - (string-to-number string))) +Otherwise if CELL looks like lisp (meaning it starts with a +\"(\", \"\\='\", \"\\=`\" or a \"[\") then read and evaluate it as +lisp, otherwise return it unmodified as a string. Optional +argument INHIBIT-LISP-EVAL inhibits lisp evaluation for +situations in which is it not appropriate." + (cond ((not (org-string-nw-p cell)) cell) + ((org-babel--string-to-number cell)) + ((and (not inhibit-lisp-eval) + (or (memq (string-to-char cell) '(?\( ?' ?` ?\[)) + (string= cell "*this*"))) + (eval (read cell) t)) + ((eq (string-to-char cell) ?\") (read cell)) + (t (org-no-properties cell)))) + +(defun org-babel--string-to-number (string) + "If STRING represents a number return its value. +Otherwise return nil." + (and (string-match-p "\\`-?[0-9]*\\.?[0-9]*\\'" string) + (string-to-number string))) (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. @@ -2644,49 +2935,15 @@ If the table is trivial, then return it as a scalar." cell) t)) (defun org-babel-chomp (string &optional regexp) - "Strip trailing spaces and carriage returns from STRING. -Default regexp used is \"[ \f\t\n\r\v]\" but can be -overwritten by specifying a regexp as a second argument." + "Strip a trailing space or carriage return from STRING. +The default regexp used is \"[ \\f\\t\\n\\r\\v]\" but another one +can be specified as the REGEXP argument." (let ((regexp (or regexp "[ \f\t\n\r\v]"))) (while (and (> (length string) 0) (string-match regexp (substring string -1))) (setq string (substring string 0 -1))) string)) -(defun org-babel-trim (string &optional regexp) - "Strip leading and trailing spaces and carriage returns from STRING. -Like `org-babel-chomp' only it runs on both the front and back -of the string." - (org-babel-chomp (org-reverse-string - (org-babel-chomp (org-reverse-string string) regexp)) - regexp)) - -(defun org-babel-tramp-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Use Tramp to handle `call-process-region'. -Fixes a bug in `tramp-handle-call-process-region'." - (if (file-remote-p default-directory) - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - ;; (apply 'call-process program tmpfile buffer display args) - ;; bug in tramp - (apply 'process-file program tmpfile buffer display args) - (delete-file tmpfile))) - ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in - ;; org-babel-execute-src-block - (apply org-babel-call-process-region-original - start end program delete buffer display args))) - -(defalias 'org-babel-local-file-name - (if (fboundp 'file-local-name) - 'file-local-name - (lambda (file) - "Return the local name component of FILE." - (or (file-remote-p file 'localname) file)))) - (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. If NAME specifies a remote location, the remote portion of the @@ -2694,7 +2951,7 @@ name is removed, since in that case the process will be executing remotely. The file name is then processed by `expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, the file name is additionally processed by `shell-quote-argument'" - (let ((f (expand-file-name (org-babel-local-file-name name)))) + (let ((f (org-babel-local-file-name (expand-file-name name)))) (if no-quote-p f (shell-quote-argument f)))) (defvar org-babel-temporary-directory) @@ -2708,6 +2965,11 @@ additionally processed by `shell-quote-argument'" Used by `org-babel-temp-file'. This directory will be removed on Emacs shutdown.")) +(defcustom org-babel-remote-temporary-directory "/tmp/" + "Directory to hold temporary files on remote hosts." + :group 'org-babel + :type 'string) + (defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) "Call the code to parse raw string results according to RESULT-PARAMS." (declare (indent 1) @@ -2720,6 +2982,7 @@ Emacs shutdown.")) (member "html" ,params) (member "code" ,params) (member "pp" ,params) + (member "file" ,params) (and (or (member "output" ,params) (member "raw" ,params) (member "org" ,params) @@ -2737,7 +3000,8 @@ of `org-babel-temporary-directory'." (if (file-remote-p default-directory) (let ((prefix (concat (file-remote-p default-directory) - (expand-file-name prefix temporary-file-directory)))) + (expand-file-name + prefix org-babel-remote-temporary-directory)))) (make-temp-file prefix nil suffix)) (let ((temporary-file-directory (or (and (boundp 'org-babel-temporary-directory) @@ -2772,6 +3036,96 @@ of `org-babel-temporary-directory'." (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(defun org-babel-one-header-arg-safe-p (pair safe-list) + "Determine if the PAIR is a safe babel header arg according to SAFE-LIST. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + (and (consp pair) + (keywordp (car pair)) + (stringp (cdr pair)) + (or + (memq (car pair) safe-list) + (let ((entry (assq (car pair) safe-list))) + (and entry + (consp entry) + (cond ((functionp (cdr entry)) + (funcall (cdr entry) (cdr pair))) + ((listp (cdr entry)) + (member (cdr pair) (cdr entry))) + (t nil))))))) + +(defun org-babel-generate-file-param (src-name params) + "Calculate the filename for source block results. + +The directory is calculated from the :output-dir property of the +source block; if not specified, use the current directory. + +If the source block has a #+NAME and the :file parameter does not +contain any period characters, then the :file parameter is +treated as an extension, and the output file name is the +concatenation of the directory (as calculated above), the block +name, a period, and the parameter value as a file extension. +Otherwise, the :file parameter is treated as a full file name, +and the output file name is the directory (as calculated above) +plus the parameter value." + (let* ((file-cons (assq :file params)) + (file-ext-cons (assq :file-ext params)) + (file-ext (cdr-safe file-ext-cons)) + (dir (cdr-safe (assq :output-dir params))) + fname) + ;; create the output-dir if it does not exist + (when dir + (make-directory dir t)) + (if file-cons + ;; :file given; add :output-dir if given + (when dir + (setcdr file-cons (concat (file-name-as-directory dir) (cdr file-cons)))) + ;; :file not given; compute from name and :file-ext if possible + (when (and src-name file-ext) + (if dir + (setq fname (concat (file-name-as-directory (or dir "")) + src-name "." file-ext)) + (setq fname (concat src-name "." file-ext))) + (setq params (cons (cons :file fname) params)))) + params)) + +(defun org-babel-graphical-output-file (params) + "File where a babel block should send graphical output, per PARAMS. +Return nil if no graphical output is expected. Raise an error if +the output file is ill-defined." + (let ((file (cdr (assq :file params)))) + (cond (file (and (member "graphics" (cdr (assq :result-params params))) + file)) + ((assq :file-ext params) + (user-error ":file-ext given but no :file generated; did you forget \ +to name a block?")) + (t (user-error "No :file header argument given; cannot create \ +graphical result"))))) + +(defun org-babel-make-language-alias (new old) + "Make source blocks of type NEW aliases for those of type OLD. + +NEW and OLD should be strings. This function should be called +after the babel API for OLD-type source blocks is fully defined. + +Callers of this function will probably want to add an entry to +`org-src-lang-modes' as well." + (dolist (fn '("execute" "expand-body" "prep-session" + "variable-assignments" "load-session")) + (let ((sym (intern-soft (concat "org-babel-" fn ":" old)))) + (when (and sym (fboundp sym)) + (defalias (intern (concat "org-babel-" fn ":" new)) sym)))) + ;; Technically we don't need a `dolist' for just one variable, but + ;; we keep it for symmetry/ease of future expansion. + (dolist (var '("default-header-args")) + (let ((sym (intern-soft (concat "org-babel-" var ":" old)))) + (when (and sym (boundp sym)) + (defvaralias (intern (concat "org-babel-" var ":" new)) sym))))) + +(defun org-babel-strip-quotes (string) + "Strip \\\"s from around a string, if applicable." + (org-unbracket-string "\"" "\"" string)) + (provide 'ob-core) ;; Local variables: diff --git a/lisp/org/ob-css.el b/lisp/org/ob-css.el index 70c66d4670..4203b1258c 100644 --- a/lisp/org/ob-css.el +++ b/lisp/org/ob-css.el @@ -1,4 +1,4 @@ -;;; ob-css.el --- org-babel functions for css evaluation +;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -24,19 +24,19 @@ ;;; Commentary: ;; Since CSS can't be executed, this file exists solely for tangling -;; CSS from org-mode files. +;; CSS from Org files. ;;; Code: (require 'ob) (defvar org-babel-default-header-args:css '()) -(defun org-babel-execute:css (body params) +(defun org-babel-execute:css (body _params) "Execute a block of CSS code. This function is called by `org-babel-execute-src-block'." body) -(defun org-babel-prep-session:css (session params) +(defun org-babel-prep-session:css (_session _params) "Return an error if the :session header argument is set. CSS does not support sessions." (error "CSS sessions are nonsensical")) diff --git a/lisp/org/ob-ditaa.el b/lisp/org/ob-ditaa.el index 5eb8e2fdb4..89b5d2465c 100644 --- a/lisp/org/ob-ditaa.el +++ b/lisp/org/ob-ditaa.el @@ -1,4 +1,4 @@ -;;; ob-ditaa.el --- org-babel functions for ditaa evaluation +;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -81,15 +81,21 @@ Do not leave leading or trailing spaces in this string." (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (let ((el (cdr (assoc :file params)))) - (or el - (error - "ditaa code block requires :file header argument")))) - (cmdline (cdr (assoc :cmdline params))) - (java (cdr (assoc :java params))) + (let* ((out-file (or (cdr (assq :file params)) + (error + "ditaa code block requires :file header argument"))) + (cmdline (cdr (assq :cmdline params))) + (java (cdr (assq :java params))) (in-file (org-babel-temp-file "ditaa-")) - (eps (cdr (assoc :eps params))) + (eps (cdr (assq :eps params))) + (eps-file (when eps + (org-babel-process-file-name (concat in-file ".eps")))) + (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") + (cdr (assq :pdf params)))) + (concat + "epstopdf" + " " eps-file + " -o=" (org-babel-process-file-name out-file)))) (cmd (concat org-babel-ditaa-java-cmd " " java " " org-ditaa-jar-option " " (shell-quote-argument @@ -97,13 +103,9 @@ This function is called by `org-babel-execute-src-block'." (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) " " cmdline " " (org-babel-process-file-name in-file) - " " (org-babel-process-file-name out-file))) - (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") - (cdr (assoc :pdf params)))) - (concat - "epstopdf" - " " (org-babel-process-file-name (concat in-file ".eps")) - " -o=" (org-babel-process-file-name out-file))))) + " " (if pdf-cmd + eps-file + (org-babel-process-file-name out-file))))) (unless (file-exists-p org-ditaa-jar-path) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) @@ -111,7 +113,7 @@ This function is called by `org-babel-execute-src-block'." (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd)) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:ditaa (session params) +(defun org-babel-prep-session:ditaa (_session _params) "Return an error because ditaa does not support sessions." (error "Ditaa does not support sessions")) diff --git a/lisp/org/ob-dot.el b/lisp/org/ob-dot.el index aa0445b4ca..81442bfc1c 100644 --- a/lisp/org/ob-dot.el +++ b/lisp/org/ob-dot.el @@ -1,4 +1,4 @@ -;;; ob-dot.el --- org-babel functions for dot evaluation +;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -46,7 +46,7 @@ (defun org-babel-expand-body:dot (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -55,19 +55,20 @@ (replace-regexp-in-string (concat "$" (regexp-quote name)) (if (stringp value) value (format "%S" value)) - body)))) + body + t + t)))) vars) body)) (defun org-babel-execute:dot (body params) "Execute a block of Dot code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (or (assoc :file params) + (let* ((out-file (cdr (or (assq :file params) (error "You need to specify a :file parameter")))) - (cmdline (or (cdr (assoc :cmdline params)) + (cmdline (or (cdr (assq :cmdline params)) (format "-T%s" (file-name-extension out-file)))) - (cmd (or (cdr (assoc :cmd params)) "dot")) + (cmd (or (cdr (assq :cmd params)) "dot")) (in-file (org-babel-temp-file "dot-"))) (with-temp-file in-file (insert (org-babel-expand-body:dot body params))) @@ -78,7 +79,7 @@ This function is called by `org-babel-execute-src-block'." " -o " (org-babel-process-file-name out-file)) "") nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:dot (session params) +(defun org-babel-prep-session:dot (_session _params) "Return an error because Dot does not support sessions." (error "Dot does not support sessions")) diff --git a/lisp/org/ob-ebnf.el b/lisp/org/ob-ebnf.el new file mode 100644 index 0000000000..410570bc5d --- /dev/null +++ b/lisp/org/ob-ebnf.el @@ -0,0 +1,83 @@ +;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. + +;; Author: Michael Gauland +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 1.00 + +;;; License: + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;;; Org-Babel support for using ebnf2ps to generate encapsulated postscript +;;; railroad diagrams. It recogises these arguments: +;;; +;;; :file is required; it must include the extension '.eps.' All the rules +;;; in the block will be drawn in the same file. This is done by +;;; inserting a '[' comment at the start of the block (see the +;;; documentation for ebnf-eps-buffer for more information). +;;; +;;; :style specifies a value in ebnf-style-database. This provides the +;;; ability to customise the output. The style can also specify the +;;; grammar syntax (by setting ebnf-syntax); note that only ebnf, +;;; iso-ebnf, and yacc are supported by this file. + +;;; Requirements: + +;;; Code: +(require 'ob) +(require 'ebnf2ps) + +;; optionally declare default header arguments for this language +(defvar org-babel-default-header-args:ebnf '((:style . nil))) + +;; Use ebnf-eps-buffer to produce an encapsulated postscript file. +;; +(defun org-babel-execute:ebnf (body params) + "Execute a block of Ebnf code with org-babel. This function is +called by `org-babel-execute-src-block'" + (save-excursion + (let* ((dest-file (cdr (assq :file params))) + (dest-dir (file-name-directory dest-file)) + (dest-root (file-name-sans-extension + (file-name-nondirectory dest-file))) + (style (cdr (assq :style params))) + (result nil)) + (with-temp-buffer + (when style (ebnf-push-style style)) + (let ((comment-format + (cond ((string= ebnf-syntax 'yacc) "/*%s*/") + ((string= ebnf-syntax 'ebnf) ";%s") + ((string= ebnf-syntax 'iso-ebnf) "(*%s*)") + (t (setq result + (format "EBNF error: format %s not supported." + ebnf-syntax)))))) + (setq ebnf-eps-prefix dest-dir) + (insert (format comment-format (format "[%s" dest-root))) + (newline) + (insert body) + (newline) + (insert (format comment-format (format "]%s" dest-root))) + (ebnf-eps-buffer) + (when style (ebnf-pop-style)))) + result))) + +(provide 'ob-ebnf) +;;; ob-ebnf.el ends here diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index d95c475c4e..c0bd12a879 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -1,4 +1,4 @@ -;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation +;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -28,17 +28,21 @@ ;;; Code: (require 'ob) -(defvar org-babel-default-header-args:emacs-lisp - '((:hlines . "yes") (:colnames . "no")) - "Default arguments for evaluating an emacs-lisp source block.") +(defconst org-babel-header-args:emacs-lisp '((lexical . :any)) + "Emacs-lisp specific header arguments.") -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) +(defvar org-babel-default-header-args:emacs-lisp '((:lexical . "no")) + "Default arguments for evaluating an emacs-lisp source block. + +A value of \"yes\" or t causes src blocks to be eval'd using +lexical scoping. It can also be an alist mapping symbols to +their value. It is used as the optional LEXICAL argument to +`eval', which see.") (defun org-babel-expand-body:emacs-lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) (body (if (> (length vars) 0) (concat "(let (" @@ -55,26 +59,33 @@ (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion - (let ((result - (eval (read (format (if (member "output" - (cdr (assoc :result-params params))) - "(with-output-to-string %s)" - "(progn %s)") - (org-babel-expand-body:emacs-lisp - body params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (let* ((lexical (cdr (assq :lexical params))) + (result + (eval (read (format (if (member "output" + (cdr (assq :result-params params))) + "(with-output-to-string %s)" + "(progn %s)") + (org-babel-expand-body:emacs-lisp + body params))) + + (if (listp lexical) + lexical + (member lexical '("yes" "t")))))) + (org-babel-result-cond (cdr (assq :result-params params)) (let ((print-level nil) (print-length nil)) - (if (or (member "scalar" (cdr (assoc :result-params params))) - (member "verbatim" (cdr (assoc :result-params params)))) + (if (or (member "scalar" (cdr (assq :result-params params))) + (member "verbatim" (cdr (assq :result-params params)))) (format "%S" result) (format "%s" result))) (org-babel-reassemble-table result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))))) + +(org-babel-make-language-alias "elisp" "emacs-lisp") (provide 'ob-emacs-lisp) diff --git a/lisp/org/ob-eval.el b/lisp/org/ob-eval.el index 46d21c88e8..324cf5fb27 100644 --- a/lisp/org/ob-eval.el +++ b/lisp/org/ob-eval.el @@ -1,4 +1,4 @@ -;;; ob-eval.el --- org-babel functions for external code evaluation +;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -28,7 +28,6 @@ ;;; Code: (require 'org-macs) -(eval-when-compile (require 'cl)) (defvar org-babel-error-buffer-name "*Org-Babel Error Output*") (declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) @@ -57,6 +56,13 @@ STDERR with `org-babel-eval-error-notify'." (progn (with-current-buffer err-buff (org-babel-eval-error-notify exit-code (buffer-string))) + (save-excursion + (when (get-buffer org-babel-error-buffer-name) + (with-current-buffer org-babel-error-buffer-name + (unless (derived-mode-p 'compilation-mode) + (compilation-mode)) + ;; Compilation-mode enforces read-only, but Babel expects the buffer modifiable. + (setq buffer-read-only nil)))) nil) (buffer-string))))) @@ -114,18 +120,18 @@ function in various versions of Emacs. (delete-file input-file)) (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) - (with-current-buffer (get-buffer-create error-buffer) - (let ((pos-from-end (- (point-max) (point)))) - (or (bobp) - (insert "\f\n")) - ;; Do no formatting while reading error file, - ;; because that can run a shell command, and we - ;; don't want that to cause an infinite recursion. - (format-insert-file error-file nil) - ;; Put point after the inserted errors. - (goto-char (- (point-max) pos-from-end))) - (current-buffer))) + (when (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (current-buffer))) (delete-file error-file)) exit-status)) diff --git a/lisp/org/ob-exp.el b/lisp/org/ob-exp.el index 2677fe59cb..2556362f92 100644 --- a/lisp/org/ob-exp.el +++ b/lisp/org/ob-exp.el @@ -1,4 +1,4 @@ -;;; ob-exp.el --- Exportation of org-babel source blocks +;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -24,81 +24,49 @@ ;;; Code: (require 'ob-core) -(require 'org-src) -(eval-when-compile - (require 'cl)) - -(defvar org-current-export-file) -(defvar org-babel-lob-one-liner-regexp) -(defvar org-babel-ref-split-regexp) -(defvar org-list-forbidden-blocks) - -(declare-function org-babel-lob-get-info "ob-lob" ()) -(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) -(declare-function org-between-regexps-p "org" - (start-re end-re &optional lim-up lim-down)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-heading-components "org" ()) -(declare-function org-in-block-p "org" (names)) -(declare-function org-in-verbatim-emphasis "org" ()) -(declare-function org-link-search "org" (s &optional type avoid-pos stealth)) -(declare-function org-fill-template "org" (template alist)) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-element-at-point "org-element" (&optional keep-trail)) + +(declare-function org-babel-lob-get-info "ob-lob" (&optional datum)) +(declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-escape-code-in-string "org-src" (s)) +(declare-function org-export-copy-buffer "ox" ()) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) + +(defvar org-src-preserve-indentation) (defcustom org-export-babel-evaluate t "Switch controlling code evaluation during export. When set to nil no code will be evaluated as part of the export -process. When set to `inline-only', only inline code blocks will -be executed." +process and no header argumentss will be obeyed. When set to +`inline-only', only inline code blocks will be executed. Users +who wish to avoid evaluating code on export should use the header +argument `:eval never-export'." :group 'org-babel :version "24.1" :type '(choice (const :tag "Never" nil) (const :tag "Only inline code" inline-only) (const :tag "Always" t))) -(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) - -(defun org-babel-exp-get-export-buffer () - "Return the current export buffer if possible." - (cond - ((bufferp org-current-export-file) org-current-export-file) - (org-current-export-file (get-file-buffer org-current-export-file)) - ('otherwise - (error "Requested export buffer when `org-current-export-file' is nil")))) - -(defvar org-link-search-inhibit-query) - -(defmacro org-babel-exp-in-export-file (lang &rest body) - (declare (indent 1)) - `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) - (heading (nth 4 (ignore-errors (org-heading-components)))) - (export-buffer (current-buffer)) - (original-buffer (org-babel-exp-get-export-buffer)) results) - (when original-buffer - ;; resolve parameters in the original file so that - ;; headline and file-wide parameters are included, attempt - ;; to go to the same heading in the original file - (set-buffer original-buffer) - (save-restriction - (when heading - (condition-case nil - (let ((org-link-search-inhibit-query t)) - (org-link-search heading)) - (error (when heading - (goto-char (point-min)) - (re-search-forward (regexp-quote heading) nil t))))) - (setq results ,@body)) - (set-buffer export-buffer) - results))) -(def-edebug-spec org-babel-exp-in-export-file (form body)) - -(defun org-babel-exp-src-block (&rest headers) +(put 'org-export-babel-evaluate 'safe-local-variable #'null) + +(defmacro org-babel-exp--at-source (&rest body) + "Evaluate BODY at the source of the Babel block at point. +Source is located in `org-babel-exp-reference-buffer'. The value +returned is the value of the last form in BODY. Assume that +point is at the beginning of the Babel block." + (declare (indent 1) (debug body)) + `(let ((source (get-text-property (point) 'org-reference))) + (with-current-buffer org-babel-exp-reference-buffer + (org-with-wide-buffer + (goto-char source) + ,@body)))) + +(defun org-babel-exp-src-block () "Process source block for export. -Depending on the `export' headers argument, replace the source +Depending on the \":export\" header argument, replace the source code block like this: both ---- display the code and the results @@ -107,29 +75,36 @@ code ---- the default, display the code inside the block but do not process results - just like none only the block is run on export ensuring - that it's results are present in the org-mode buffer + that its results are present in the Org mode buffer none ---- do not display either code or results upon export -Assume point is at the beginning of block's starting line." +Assume point is at block opening line." (interactive) - (unless noninteractive (message "org-babel-exp processing...")) (save-excursion (let* ((info (org-babel-get-src-block-info 'light)) (lang (nth 0 info)) - (raw-params (nth 2 info)) hash) + (raw-params (nth 2 info)) + hash) ;; bail if we couldn't get any info from the block + (unless noninteractive + (message "org-babel-exp process %s at position %d..." + lang + (line-beginning-position))) (when info ;; if we're actually going to need the parameters - (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) - (org-babel-exp-in-export-file lang - (setf (nth 2 info) - (org-babel-process-params - (apply #'org-babel-merge-params - org-babel-default-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append (org-babel-params-from-properties lang) - (list raw-params)))))) + (when (member (cdr (assq :exports (nth 2 info))) '("both" "results")) + (let ((lang-headers (intern (concat "org-babel-default-header-args:" + lang)))) + (org-babel-exp--at-source + (setf (nth 2 info) + (org-babel-process-params + (apply #'org-babel-merge-params + org-babel-default-header-args + (and (boundp lang-headers) + (symbol-value lang-headers)) + (append (org-babel-params-from-properties lang) + (list raw-params))))))) (setf hash (org-babel-sha1-hash info))) (org-babel-exp-do-export info 'block hash))))) @@ -150,166 +125,180 @@ this template." :group 'org-babel :type 'string) -(defvar org-babel-default-lob-header-args) (defun org-babel-exp-process-buffer () "Execute all Babel blocks in current buffer." (interactive) - (save-window-excursion - (save-excursion + (when org-export-babel-evaluate + (save-window-excursion (let ((case-fold-search t) - (regexp (concat org-babel-inline-src-block-regexp "\\|" - org-babel-lob-one-liner-regexp "\\|" - "^[ \t]*#\\+BEGIN_SRC"))) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let* ((element (save-excursion - ;; If match is inline, point is at its - ;; end. Move backward so - ;; `org-element-context' can get the - ;; object, not the following one. - (backward-char) - (save-match-data (org-element-context)))) - (type (org-element-type element)) - (begin (copy-marker (org-element-property :begin element))) - (end (copy-marker - (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (point))))) - (case type - (inline-src-block - (let* ((info (org-babel-parse-inline-src-block-match)) - (params (nth 2 info))) - (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) - (nth 1 info))) - (goto-char begin) - (let ((replacement (org-babel-exp-do-export info 'inline))) - (if (equal replacement "") - ;; Replacement code is empty: remove inline src - ;; block, including extra white space that - ;; might have been created when inserting - ;; results. - (delete-region begin - (progn (goto-char end) - (skip-chars-forward " \t") - (point))) - ;; Otherwise: remove inline src block but - ;; preserve following white spaces. Then insert - ;; value. - (delete-region begin end) - (insert replacement))))) - ((babel-call inline-babel-call) - (let* ((lob-info (org-babel-lob-get-info)) - (results - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat 'identity - (butlast lob-info 2) - " "))))))) - "" (nth 3 lob-info) (nth 2 lob-info)) - 'lob)) - (rep (org-fill-template - org-babel-exp-call-line-template - `(("line" . ,(nth 0 lob-info)))))) - ;; If replacement is empty, completely remove the - ;; object/element, including any extra white space - ;; that might have been created when including - ;; results. - (if (equal rep "") - (delete-region - begin - (progn (goto-char end) - (if (not (eq type 'babel-call)) - (progn (skip-chars-forward " \t") (point)) - (skip-chars-forward " \r\t\n") - (line-beginning-position)))) - ;; Otherwise, preserve following white - ;; spaces/newlines and then, insert replacement - ;; string. - (goto-char begin) - (delete-region begin end) - (insert rep)))) - (src-block - (let* ((match-start (copy-marker (match-beginning 0))) - (ind (org-get-indentation)) - (headers - (cons - (org-element-property :language element) - (let ((params (org-element-property :parameters - element))) - (and params (org-split-string params "[ \t]+")))))) - ;; Take care of matched block: compute replacement - ;; string. In particular, a nil REPLACEMENT means - ;; the block should be left as-is while an empty - ;; string should remove the block. - (let ((replacement (progn (goto-char match-start) - (org-babel-exp-src-block headers)))) - (cond ((not replacement) (goto-char end)) - ((equal replacement "") - (goto-char end) - (skip-chars-forward " \r\t\n") - (beginning-of-line) - (delete-region begin (point))) - (t - (goto-char match-start) - (delete-region (point) - (save-excursion (goto-char end) - (line-end-position))) - (insert replacement) - (if (or org-src-preserve-indentation - (org-element-property :preserve-indent - element)) - ;; Indent only the code block markers. - (save-excursion (skip-chars-backward " \r\t\n") - (indent-line-to ind) - (goto-char match-start) - (indent-line-to ind)) - ;; Indent everything. - (indent-rigidly match-start (point) ind))))) - (set-marker match-start nil)))) - (set-marker begin nil) - (set-marker end nil))))))) - -(defun org-babel-in-example-or-verbatim () - "Return true if point is in example or verbatim code. -Example and verbatim code include escaped portions of -an org-mode buffer code that should be treated as normal -org-mode text." - (or (save-match-data - (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*:[ \t]"))) - (org-in-verbatim-emphasis) - (org-in-block-p org-list-forbidden-blocks) - (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + (regexp (if (eq org-export-babel-evaluate 'inline-only) + "\\(call\\|src\\)_" + "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")) + ;; Get a pristine copy of current buffer so Babel + ;; references are properly resolved and source block + ;; context is preserved. + (org-babel-exp-reference-buffer (org-export-copy-buffer))) + (unwind-protect + (save-excursion + ;; First attach to every source block their original + ;; position, so that they can be retrieved within + ;; `org-babel-exp-reference-buffer', even after heavy + ;; modifications on current buffer. + ;; + ;; False positives are harmless, so we don't check if + ;; we're really at some Babel object. Moreover, + ;; `line-end-position' ensures that we propertize + ;; a noticeable part of the object, without affecting + ;; multiple objects on the same line. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((s (match-beginning 0))) + (put-text-property s (line-end-position) 'org-reference s))) + ;; Evaluate from top to bottom every Babel block + ;; encountered. + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (unless (save-match-data (org-in-commented-heading-p)) + (let* ((object? (match-end 1)) + (element (save-match-data + (if object? (org-element-context) + ;; No deep inspection if we're + ;; just looking for an element. + (org-element-at-point)))) + (type + (pcase (org-element-type element) + ;; Discard block elements if we're looking + ;; for inline objects. False results + ;; happen when, e.g., "call_" syntax is + ;; located within affiliated keywords: + ;; + ;; #+name: call_src + ;; #+begin_src ... + ((and (or `babel-call `src-block) (guard object?)) + nil) + (type type))) + (begin + (copy-marker (org-element-property :begin element))) + (end + (copy-marker + (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (point))))) + (pcase type + (`inline-src-block + (let* ((info + (org-babel-get-src-block-info nil element)) + (params (nth 2 info))) + (setf (nth 1 info) + (if (and (cdr (assq :noweb params)) + (string= "yes" + (cdr (assq :noweb params)))) + (org-babel-expand-noweb-references + info org-babel-exp-reference-buffer) + (nth 1 info))) + (goto-char begin) + (let ((replacement + (org-babel-exp-do-export info 'inline))) + (if (equal replacement "") + ;; Replacement code is empty: remove + ;; inline source block, including extra + ;; white space that might have been + ;; created when inserting results. + (delete-region begin + (progn (goto-char end) + (skip-chars-forward " \t") + (point))) + ;; Otherwise: remove inline src block but + ;; preserve following white spaces. Then + ;; insert value. + (delete-region begin end) + (insert replacement))))) + ((or `babel-call `inline-babel-call) + (org-babel-exp-do-export (org-babel-lob-get-info element) + 'lob) + (let ((rep + (org-fill-template + org-babel-exp-call-line-template + `(("line" . + ,(org-element-property :value element)))))) + ;; If replacement is empty, completely remove + ;; the object/element, including any extra + ;; white space that might have been created + ;; when including results. + (if (equal rep "") + (delete-region + begin + (progn (goto-char end) + (if (not (eq type 'babel-call)) + (progn (skip-chars-forward " \t") + (point)) + (skip-chars-forward " \r\t\n") + (line-beginning-position)))) + ;; Otherwise, preserve trailing + ;; spaces/newlines and then, insert + ;; replacement string. + (goto-char begin) + (delete-region begin end) + (insert rep)))) + (`src-block + (let ((match-start (copy-marker (match-beginning 0))) + (ind (org-get-indentation))) + ;; Take care of matched block: compute + ;; replacement string. In particular, a nil + ;; REPLACEMENT means the block is left as-is + ;; while an empty string removes the block. + (let ((replacement + (progn (goto-char match-start) + (org-babel-exp-src-block)))) + (cond ((not replacement) (goto-char end)) + ((equal replacement "") + (goto-char end) + (skip-chars-forward " \r\t\n") + (beginning-of-line) + (delete-region begin (point))) + (t + (goto-char match-start) + (delete-region (point) + (save-excursion + (goto-char end) + (line-end-position))) + (insert replacement) + (if (or org-src-preserve-indentation + (org-element-property + :preserve-indent element)) + ;; Indent only code block + ;; markers. + (save-excursion + (skip-chars-backward " \r\t\n") + (indent-line-to ind) + (goto-char match-start) + (indent-line-to ind)) + ;; Indent everything. + (indent-rigidly + match-start (point) ind))))) + (set-marker match-start nil)))) + (set-marker begin nil) + (set-marker end nil))))) + (kill-buffer org-babel-exp-reference-buffer) + (remove-text-properties (point-min) (point-max) '(org-reference))))))) (defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. The function respects the value of the :exports header argument." - (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (not (and session (equal "none" session))) - (org-babel-exp-results info type 'silent))))) - (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) - (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (funcall silently) (funcall clean) "") - ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) - ('results (org-babel-exp-results info type nil hash) "") - ('both (org-babel-exp-results info type nil hash) - (org-babel-exp-code info))))) + (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info))))) + (unless (equal "none" session) + (org-babel-exp-results info type 'silent))))) + (clean (lambda () (if (eq type 'inline) + (org-babel-remove-inline-result) + (org-babel-remove-result info))))) + (pcase (or (cdr (assq :exports (nth 2 info))) "code") + ("none" (funcall silently) (funcall clean) "") + ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type)) + ("results" (org-babel-exp-results info type nil hash) "") + ("both" + (org-babel-exp-results info type nil hash) + (org-babel-exp-code info type))))) (defcustom org-babel-exp-code-template "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC" @@ -331,18 +320,42 @@ replaced with its value." :group 'org-babel :type 'string) -(defun org-babel-exp-code (info) +(defcustom org-babel-exp-inline-code-template + "src_%lang[%switches%flags]{%body}" + "Template used to export the body of inline code blocks. +This template may be customized to include additional information +such as the code block name, or the values of particular header +arguments. The template is filled out using `org-fill-template', +and the following %keys may be used. + + lang ------ the language of the code block + name ------ the name of the code block + body ------ the body of the code block + switches -- the switches associated to the code block + flags ----- the flags passed to the code block + +In addition to the keys mentioned above, every header argument +defined for the code block may be used as a key and will be +replaced with its value." + :group 'org-babel + :type 'string + :version "26.1" + :package-version '(Org . "8.3")) + +(defun org-babel-exp-code (info type) "Return the original code block formatted for export." (setf (nth 1 info) - (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (if (string= "strip-export" (cdr (assq :noweb (nth 2 info)))) (replace-regexp-in-string (org-babel-noweb-wrap) "" (nth 1 info)) (if (org-babel-noweb-p (nth 2 info) :export) (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) + info org-babel-exp-reference-buffer) (nth 1 info)))) (org-fill-template - org-babel-exp-code-template + (if (eq type 'inline) + org-babel-exp-inline-code-template + org-babel-exp-code-template) `(("lang" . ,(nth 0 info)) ("body" . ,(org-escape-code-in-string (nth 1 info))) ("switches" . ,(let ((f (nth 3 info))) @@ -357,48 +370,41 @@ replaced with its value." (defun org-babel-exp-results (info type &optional silent hash) "Evaluate and return the results of the current code block for export. -Results are prepared in a manner suitable for export by org-mode. +Results are prepared in a manner suitable for export by Org mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (when (and (or (eq org-export-babel-evaluate t) - (and (eq type 'inline) - (eq org-export-babel-evaluate 'inline-only))) - (not (and hash (equal hash (org-babel-current-result-hash))))) + (unless (and hash (equal hash (org-babel-current-result-hash))) (let ((lang (nth 0 info)) (body (if (org-babel-noweb-p (nth 2 info) :eval) (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) + info org-babel-exp-reference-buffer) (nth 1 info))) (info (copy-sequence info)) (org-babel-current-src-block-location (point-marker))) - ;; skip code blocks which we can't evaluate + ;; Skip code blocks which we can't evaluate. (when (fboundp (intern (concat "org-babel-execute:" lang))) (org-babel-eval-wipe-error-buffer) - (prog1 nil - (setf (nth 1 info) body) - (setf (nth 2 info) - (org-babel-exp-in-export-file lang - (org-babel-process-params - (org-babel-merge-params - (nth 2 info) - `((:results . ,(if silent "silent" "replace"))))))) - (cond - ((equal type 'block) - (org-babel-execute-src-block nil info)) - ((equal type 'inline) - ;; position the point on the inline source block allowing - ;; `org-babel-insert-result' to check that the block is - ;; inline - (re-search-backward "[ \f\t\n\r\v]" nil t) - (re-search-forward org-babel-inline-src-block-regexp nil t) - (re-search-backward "src_" nil t) + (setf (nth 1 info) body) + (setf (nth 2 info) + (org-babel-exp--at-source + (org-babel-process-params + (org-babel-merge-params + (nth 2 info) + `((:results . ,(if silent "silent" "replace"))))))) + (pcase type + (`block (org-babel-execute-src-block nil info)) + (`inline + ;; Position the point on the inline source block + ;; allowing `org-babel-insert-result' to check that the + ;; block is inline. + (goto-char (nth 5 info)) (org-babel-execute-src-block nil info)) - ((equal type 'lob) - (save-excursion - (re-search-backward org-babel-lob-one-liner-regexp nil t) - (let (org-confirm-babel-evaluate) - (org-babel-execute-src-block nil info)))))))))) + (`lob + (save-excursion + (goto-char (nth 5 info)) + (let (org-confirm-babel-evaluate) + (org-babel-execute-src-block nil info))))))))) (provide 'ob-exp) diff --git a/lisp/org/ob-forth.el b/lisp/org/ob-forth.el new file mode 100644 index 0000000000..152cf727e2 --- /dev/null +++ b/lisp/org/ob-forth.el @@ -0,0 +1,87 @@ +;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, forth +;; Homepage: http://orgmode.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: + +;; Requires the gforth forth compiler and `forth-mode' (see below). +;; https://www.gnu.org/software/gforth/ + +;;; Requirements: + +;; Session evaluation requires the gforth forth compiler as well as +;; `forth-mode' which is distributed with gforth (in gforth.el). + +;;; Code: +(require 'ob) + +(declare-function forth-proc "ext:gforth" ()) +(declare-function org-trim "org" (s &optional keep-lead)) + +(defvar org-babel-default-header-args:forth '((:session . "yes")) + "Default header arguments for forth code blocks.") + +(defun org-babel-execute:forth (body params) + "Execute a block of Forth code with org-babel. +This function is called by `org-babel-execute-src-block'" + (if (string= "none" (cdr (assq :session params))) + (error "Non-session evaluation not supported for Forth code blocks") + (let ((all-results (org-babel-forth-session-execute body params))) + (if (member "output" (cdr (assq :result-params params))) + (mapconcat #'identity all-results "\n") + (car (last all-results)))))) + +(defun org-babel-forth-session-execute (body params) + (require 'forth-mode) + (let ((proc (forth-proc)) + (rx " \\(\n:\\|compiled\n\\\|ok\n\\)") + (result-start)) + (with-current-buffer (process-buffer (forth-proc)) + (mapcar (lambda (line) + (setq result-start (progn (goto-char (process-mark proc)) + (point))) + (comint-send-string proc (concat line "\n")) + ;; wait for forth to say "ok" + (while (not (progn (goto-char result-start) + (re-search-forward rx nil t))) + (accept-process-output proc 0.01)) + (let ((case (match-string 1))) + (cond + ((string= "ok\n" case) + ;; Collect intermediate output. + (buffer-substring (+ result-start 1 (length line)) + (match-beginning 0))) + ((string= "compiled\n" case)) + ;; Ignore partial compilation. + ((string= "\n:" case) + ;; Report errors. + (org-babel-eval-error-notify 1 + (buffer-substring + (+ (match-beginning 0) 1) (point-max))) nil)))) + (split-string (org-trim + (org-babel-expand-body:generic body params)) + "\n" + 'omit-nulls))))) + +(provide 'ob-forth) + +;;; ob-forth.el ends here diff --git a/lisp/org/ob-fortran.el b/lisp/org/ob-fortran.el index 6a6112df9b..d059245b30 100644 --- a/lisp/org/ob-fortran.el +++ b/lisp/org/ob-fortran.el @@ -1,4 +1,4 @@ -;;; ob-fortran.el --- org-babel functions for fortran +;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -29,10 +29,12 @@ ;;; Code: (require 'ob) (require 'cc-mode) +(require 'cl-lib) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) -(declare-function org-every "org" (pred seq)) +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) @@ -47,43 +49,42 @@ "This function should only be called by `org-babel-execute:fortran'" (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) - (cmdline (cdr (assoc :cmdline params))) - (flags (cdr (assoc :flags params))) - (full-body (org-babel-expand-body:fortran body params)) - (compile - (progn - (with-temp-file tmp-src-file (insert full-body)) - (org-babel-eval - (format "%s -o %s %s %s" - org-babel-fortran-compiler - (org-babel-process-file-name tmp-bin-file) - (mapconcat 'identity - (if (listp flags) flags (list flags)) " ") - (org-babel-process-file-name tmp-src-file)) "")))) + (cmdline (cdr (assq :cmdline params))) + (flags (cdr (assq :flags params))) + (full-body (org-babel-expand-body:fortran body params))) + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + org-babel-fortran-compiler + (org-babel-process-file-name tmp-bin-file) + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + (org-babel-process-file-name tmp-src-file)) "") (let ((results - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-trim + (org-remove-indentation + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results) (let ((tmp-file (org-babel-temp-file "f-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defun org-babel-expand-body:fortran (body params) "Expand a block of fortran or fortran code with org-babel according to -it's header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (includes (or (cdr (assoc :includes params)) +its header arguments." + (let ((vars (org-babel--get-vars params)) + (main-p (not (string= (cdr (assq :main params)) "no"))) + (includes (or (cdr (assq :includes params)) (org-babel-read (org-entry-get nil "includes" t)))) (defines (org-babel-read - (or (cdr (assoc :defines params)) + (or (cdr (assq :defines params)) (org-babel-read (org-entry-get nil "defines" t)))))) (mapconcat 'identity (list @@ -107,17 +108,17 @@ it's header arguments." (defun org-babel-fortran-ensure-main-wrap (body params) "Wrap body in a \"program ... end program\" block if none exists." (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if vars (error "Cannot use :vars if `program' statement is present")) body) (format "program main\n%s\nend program main\n" body))) -(defun org-babel-prep-session:fortran (session params) +(defun org-babel-prep-session:fortran (_session _params) "This function does nothing as fortran is a compiled language with no support for sessions" (error "Fortran is a compiled languages -- no support for sessions")) -(defun org-babel-load-session:fortran (session body params) +(defun org-babel-load-session:fortran (_session _body _params) "This function does nothing as fortran is a compiled language with no support for sessions" (error "Fortran is a compiled languages -- no support for sessions")) @@ -145,7 +146,7 @@ of the same value." (format "character(len=%d), parameter :: %S = '%s'\n" (length val) var val)) ;; val is a matrix - ((and (listp val) (org-every #'listp val)) + ((and (listp val) (cl-every #'listp val)) (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n" var (length val) (length (car val)) (org-babel-fortran-transform-list val) diff --git a/lisp/org/ob-gnuplot.el b/lisp/org/ob-gnuplot.el index 82b103e52c..400823b2d7 100644 --- a/lisp/org/ob-gnuplot.el +++ b/lisp/org/ob-gnuplot.el @@ -1,4 +1,4 @@ -;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation +;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -39,12 +39,10 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function org-time-string-to-time "org" (s &optional buffer pos)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) +(declare-function orgtbl-to-generic "org-table" (table params)) (declare-function gnuplot-mode "ext:gnuplot-mode" ()) (declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) (declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) @@ -65,7 +63,7 @@ (term . :any)) "Gnuplot specific header args.") -(defvar org-babel-gnuplot-timestamp-fmt nil) +(defvar org-babel-gnuplot-timestamp-fmt nil) ; Dynamically scoped. (defvar *org-babel-gnuplot-missing* nil) @@ -81,7 +79,7 @@ Dumps all vectors into files and returns an association list of variable names and the related value to be used in the gnuplot code." - (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params)))) + (let ((*org-babel-gnuplot-missing* (cdr (assq :missing params)))) (mapcar (lambda (pair) (cons @@ -95,38 +93,33 @@ code." (if tablep val (mapcar 'list val))) (org-babel-temp-file "gnuplot-") params) val)))) - (mapcar #'cdr (org-babel-get-header params :var))))) + (org-babel--get-vars params)))) (defun org-babel-expand-body:gnuplot (body params) "Expand BODY according to PARAMS, return the expanded body." (save-window-excursion (let* ((vars (org-babel-gnuplot-process-vars params)) - (out-file (cdr (assoc :file params))) - (prologue (cdr (assoc :prologue params))) - (epilogue (cdr (assoc :epilogue params))) - (term (or (cdr (assoc :term params)) + (out-file (cdr (assq :file params))) + (prologue (cdr (assq :prologue params))) + (epilogue (cdr (assq :epilogue params))) + (term (or (cdr (assq :term params)) (when out-file (let ((ext (file-name-extension out-file))) (or (cdr (assoc (intern (downcase ext)) *org-babel-gnuplot-terms*)) ext))))) - (cmdline (cdr (assoc :cmdline params))) - (title (cdr (assoc :title params))) - (lines (cdr (assoc :line params))) - (sets (cdr (assoc :set params))) - (x-labels (cdr (assoc :xlabels params))) - (y-labels (cdr (assoc :ylabels params))) - (timefmt (cdr (assoc :timefmt params))) - (time-ind (or (cdr (assoc :timeind params)) + (title (cdr (assq :title params))) + (lines (cdr (assq :line params))) + (sets (cdr (assq :set params))) + (x-labels (cdr (assq :xlabels params))) + (y-labels (cdr (assq :ylabels params))) + (timefmt (cdr (assq :timefmt params))) + (time-ind (or (cdr (assq :timeind params)) (when timefmt 1))) - (missing (cdr (assoc :missing params))) - (add-to-body (lambda (text) (setq body (concat text "\n" body)))) - output) + (add-to-body (lambda (text) (setq body (concat text "\n" body))))) ;; append header argument settings to body (when title (funcall add-to-body (format "set title '%s'" title))) (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) - (when missing - (funcall add-to-body (format "set datafile missing '%s'" missing))) (when sets (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) (when x-labels @@ -175,9 +168,8 @@ code." "Execute a block of Gnuplot code. This function is called by `org-babel-execute-src-block'." (require 'gnuplot) - (let ((session (cdr (assoc :session params))) - (result-type (cdr (assoc :results params))) - (out-file (cdr (assoc :file params))) + (let ((session (cdr (assq :session params))) + (result-type (cdr (assq :results params))) (body (org-babel-expand-body:gnuplot body params)) output) (save-window-excursion @@ -195,7 +187,7 @@ This function is called by `org-babel-execute-src-block'." script-file (if (member system-type '(cygwin windows-nt ms-dos)) t nil))))) - (message output)) + (message "%s" output)) (with-temp-buffer (insert (concat body "\n")) (gnuplot-mode) @@ -210,10 +202,12 @@ This function is called by `org-babel-execute-src-block'." (var-lines (org-babel-variable-assignments:gnuplot params))) (message "%S" session) (org-babel-comint-in-buffer session - (mapc (lambda (var-line) - (insert var-line) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines)) + (dolist (var-line var-lines) + (insert var-line) + (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) + (goto-char (point-max)))) session)) (defun org-babel-load-session:gnuplot (session body params) @@ -232,7 +226,7 @@ This function is called by `org-babel-execute-src-block'." (org-babel-gnuplot-process-vars params))) (defvar gnuplot-buffer) -(defun org-babel-gnuplot-initiate-session (&optional session params) +(defun org-babel-gnuplot-initiate-session (&optional session _params) "Initiate a gnuplot session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session. The current @@ -268,15 +262,13 @@ then create one. Return the initialized session. The current "Export TABLE to DATA-FILE in a format readable by gnuplot. Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (with-temp-file data-file - (make-local-variable 'org-babel-gnuplot-timestamp-fmt) - (setq org-babel-gnuplot-timestamp-fmt (or - (plist-get params :timefmt) - "%Y-%m-%d-%H:%M:%S")) - (insert (orgtbl-to-generic - table - (org-combine-plists - '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) - params)))) + (insert (let ((org-babel-gnuplot-timestamp-fmt + (or (plist-get params :timefmt) "%Y-%m-%d-%H:%M:%S"))) + (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) + params))))) data-file) (provide 'ob-gnuplot) diff --git a/lisp/org/ob-groovy.el b/lisp/org/ob-groovy.el new file mode 100644 index 0000000000..69993c0f6a --- /dev/null +++ b/lisp/org/ob-groovy.el @@ -0,0 +1,116 @@ +;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. + +;; Author: Miro Bezjak +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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: +;; Currently only supports the external execution. No session support yet. + +;;; Requirements: +;; - Groovy language :: http://groovy.codehaus.org +;; - Groovy major mode :: Can be installed from MELPA or +;; https://github.com/russel/Emacs-Groovy-Mode + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) ;; Autoloaded +(add-to-list 'org-babel-tangle-lang-exts '("groovy" . "groovy")) +(defvar org-babel-default-header-args:groovy '()) +(defcustom org-babel-groovy-command "groovy" + "Name of the command to use for executing Groovy code. +May be either a command in the path, like groovy +or an absolute path name, like /usr/local/bin/groovy +parameters may be used, like groovy -v" + :group 'org-babel + :version "24.3" + :type 'string) + +(defun org-babel-execute:groovy (body params) + "Execute a block of Groovy code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Groovy source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-groovy-initiate-session (nth 0 processed-params))) + (result-params (nth 2 processed-params)) + (result-type (cdr (assq :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-groovy-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) + (org-babel-pick-name + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) + +(defvar org-babel-groovy-wrapper-method + + "class Runner extends Script { + def out = new PrintWriter(new ByteArrayOutputStream()) + def run() { %s } +} + +println(new Runner().run()) +") + + +(defun org-babel-groovy-evaluate + (session body &optional result-type result-params) + "Evaluate BODY in external Groovy process. +If RESULT-TYPE equals `output' then return standard output as a string. +If RESULT-TYPE equals `value' then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Groovy")) + (pcase result-type + (`output + (let ((src-file (org-babel-temp-file "groovy-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-groovy-command " " src-file) "")))) + (`value + (let* ((src-file (org-babel-temp-file "groovy-")) + (wrapper (format org-babel-groovy-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + (let ((raw (org-babel-eval + (concat org-babel-groovy-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-script-escape raw))))))) + + +(defun org-babel-prep-session:groovy (_session _params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Groovy")) + +(defun org-babel-groovy-initiate-session (&optional _session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Groovy." + nil) + +(provide 'ob-groovy) + + + +;;; ob-groovy.el ends here diff --git a/lisp/org/ob-haskell.el b/lisp/org/ob-haskell.el index ce6b8edbeb..ecce6dcd5d 100644 --- a/lisp/org/ob-haskell.el +++ b/lisp/org/ob-haskell.el @@ -1,4 +1,4 @@ -;;; ob-haskell.el --- org-babel functions for haskell evaluation +;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -41,9 +41,9 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function haskell-mode "ext:haskell-mode" ()) (declare-function run-haskell "ext:inf-haskell" (&optional arg)) (declare-function inferior-haskell-load-file @@ -61,42 +61,35 @@ (defun org-babel-execute:haskell (body params) "Execute a block of Haskell code." - (let* ((session (cdr (assoc :session params))) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-type (cdr (assoc :result-type params))) + (let* ((session (cdr (assq :session params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:haskell params))) (session (org-babel-haskell-initiate-session session params)) (raw (org-babel-comint-with-output (session org-babel-haskell-eoe t full-body) - (insert (org-babel-trim full-body)) + (insert (org-trim full-body)) (comint-send-input nil t) (insert org-babel-haskell-eoe) (comint-send-input nil t))) (results (mapcar - #'org-babel-haskell-read-string + #'org-babel-strip-quotes (cdr (member org-babel-haskell-eoe - (reverse (mapcar #'org-babel-trim raw))))))) + (reverse (mapcar #'org-trim raw))))))) (org-babel-reassemble-table (let ((result - (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value (car results))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (org-babel-haskell-table-or-string result))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colname-names params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rowname-names params)))))) - -(defun org-babel-haskell-read-string (string) - "Strip \\\"s from around a haskell string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(defun org-babel-haskell-initiate-session (&optional session params) + (pcase result-type + (`output (mapconcat #'identity (reverse (cdr results)) "\n")) + (`value (car results))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result (org-babel-script-escape result))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colname-names params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rowname-names params)))))) + +(defun org-babel-haskell-initiate-session (&optional _session _params) "Initiate a haskell session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." @@ -131,13 +124,7 @@ then create one. Return the initialized session." (format "let %s = %s" (car pair) (org-babel-haskell-var-to-haskell (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-haskell-table-or-string (results) - "Convert RESULTS to an Emacs-lisp table or string. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) + (org-babel--get-vars params))) (defun org-babel-haskell-var-to-haskell (var) "Convert an elisp value VAR into a haskell variable. @@ -157,7 +144,7 @@ specifying a variable of the same value." When called with a prefix argument the resulting .lhs file will be exported to a .tex file. This function will create two new files, base-name.lhs and base-name.tex where -base-name is the name of the current org-mode file. +base-name is the name of the current Org file. Note that all standard Babel literate programming constructs (header arguments, no-web syntax etc...) are ignored." @@ -185,12 +172,12 @@ constructs (header arguments, no-web syntax etc...) are ignored." (save-match-data (setq indentation (length (match-string 1)))) (replace-match (save-match-data (concat - "#+begin_latex\n\\begin{code}\n" + "#+begin_export latex\n\\begin{code}\n" (if (or preserve-indentp (string-match "-i" (match-string 2))) (match-string 3) (org-remove-indentation (match-string 3))) - "\n\\end{code}\n#+end_latex\n")) + "\n\\end{code}\n#+end_export\n")) t t) (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) (save-excursion diff --git a/lisp/org/ob-io.el b/lisp/org/ob-io.el index 1d3a42aa38..5dd611098e 100644 --- a/lisp/org/ob-io.el +++ b/lisp/org/ob-io.el @@ -1,4 +1,4 @@ -;;; ob-io.el --- org-babel functions for Io evaluation +;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -33,7 +33,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded (add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) @@ -47,9 +46,8 @@ called by `org-babel-execute-src-block'" (message "executing Io source code block") (let* ((processed-params (org-babel-process-params params)) (session (org-babel-io-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params)) (result (org-babel-io-evaluate @@ -58,17 +56,9 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - - -(defun org-babel-io-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defvar org-babel-io-wrapper-method "( @@ -79,33 +69,33 @@ Emacs-lisp table, otherwise return the results as a string." (defun org-babel-io-evaluate (session body &optional result-type result-params) "Evaluate BODY in external Io process. -If RESULT-TYPE equals 'output then return standard output as a string. -If RESULT-TYPE equals 'value then return the value of the last statement +If RESULT-TYPE equals `output' then return standard output as a string. +If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Io")) - (case result-type - (output + (pcase result-type + (`output (if (member "repl" result-params) (org-babel-eval org-babel-io-command body) (let ((src-file (org-babel-temp-file "io-"))) (progn (with-temp-file src-file (insert body)) (org-babel-eval (concat org-babel-io-command " " src-file) ""))))) - (value (let* ((src-file (org-babel-temp-file "io-")) - (wrapper (format org-babel-io-wrapper-method body))) - (with-temp-file src-file (insert wrapper)) - (let ((raw (org-babel-eval - (concat org-babel-io-command " " src-file) ""))) - (org-babel-result-cond result-params - raw - (org-babel-io-table-or-string raw))))))) + (`value (let* ((src-file (org-babel-temp-file "io-")) + (wrapper (format org-babel-io-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + (let ((raw (org-babel-eval + (concat org-babel-io-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-script-escape raw))))))) -(defun org-babel-prep-session:io (session params) +(defun org-babel-prep-session:io (_session _params) "Prepare SESSION according to the header arguments specified in PARAMS." (error "Sessions are not (yet) supported for Io")) -(defun org-babel-io-initiate-session (&optional session) +(defun org-babel-io-initiate-session (&optional _session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session. Sessions are not supported in Io." diff --git a/lisp/org/ob-java.el b/lisp/org/ob-java.el index 70a10e0131..7e720231e4 100644 --- a/lisp/org/ob-java.el +++ b/lisp/org/ob-java.el @@ -1,4 +1,4 @@ -;;; ob-java.el --- org-babel functions for java evaluation +;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -32,41 +32,51 @@ (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) -(defvar org-babel-java-command "java" - "Name of the java command.") - -(defvar org-babel-java-compiler "javac" - "Name of the java compiler.") +(defcustom org-babel-java-command "java" + "Name of the java command. +May be either a command in the path, like java +or an absolute path name, like /usr/local/bin/java +parameters may be used, like java -verbose" + :group 'org-babel + :version "24.3" + :type 'string) + +(defcustom org-babel-java-compiler "javac" + "Name of the java compiler. +May be either a command in the path, like javac +or an absolute path name, like /usr/local/bin/javac +parameters may be used, like javac -verbose" + :group 'org-babel + :version "24.3" + :type 'string) (defun org-babel-execute:java (body params) - (let* ((classname (or (cdr (assoc :classname params)) + (let* ((classname (or (cdr (assq :classname params)) (error "Can't compile a java block without a classname"))) (packagename (file-name-directory classname)) (src-file (concat classname ".java")) - (cmpflag (or (cdr (assoc :cmpflag params)) "")) - (cmdline (or (cdr (assoc :cmdline params)) "")) - (full-body (org-babel-expand-body:generic body params)) - (compile - (progn (with-temp-file src-file (insert full-body)) - (org-babel-eval - (concat org-babel-java-compiler - " " cmpflag " " src-file) "")))) + (cmpflag (or (cdr (assq :cmpflag params)) "")) + (cmdline (or (cdr (assq :cmdline params)) "")) + (full-body (org-babel-expand-body:generic body params))) + (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-java-compiler " " cmpflag " " src-file) "") ;; created package-name directories if missing (unless (or (not packagename) (file-exists-p packagename)) (make-directory packagename 'parents)) (let ((results (org-babel-eval (concat org-babel-java-command " " cmdline " " classname) ""))) (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) (org-babel-read results) (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (provide 'ob-java) diff --git a/lisp/org/ob-js.el b/lisp/org/ob-js.el index f4f8116dfd..91be6b0735 100644 --- a/lisp/org/ob-js.el +++ b/lisp/org/ob-js.el @@ -1,4 +1,4 @@ -;;; ob-js.el --- org-babel functions for Javascript +;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -39,7 +39,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function run-mozilla "ext:moz" (arg)) @@ -56,20 +55,20 @@ :type 'string) (defvar org-babel-js-function-wrapper - "require('sys').print(require('sys').inspect(function(){%s}()));" + "require('sys').print(require('sys').inspect(function(){\n%s\n}()));" "Javascript code to print value of body.") (defun org-babel-execute:js (body params) "Execute a block of Javascript code with org-babel. This function is called by `org-babel-execute-src-block'" - (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) - (result-type (cdr (assoc :result-type params))) + (let* ((org-babel-js-cmd (or (cdr (assq :cmd params)) org-babel-js-cmd)) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:js params))) - (result (if (not (string= (cdr (assoc :session params)) "none")) + (result (if (not (string= (cdr (assq :session params)) "none")) ;; session evaluation (let ((session (org-babel-prep-session:js - (cdr (assoc :session params)) params))) + (cdr (assq :session params)) params))) (nth 1 (org-babel-comint-with-output (session (format "%S" org-babel-js-eoe) t body) @@ -89,7 +88,7 @@ This function is called by `org-babel-execute-src-block'" (org-babel-eval (format "%s %s" org-babel-js-cmd (org-babel-process-file-name script-file)) ""))))) - (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-result-cond (cdr (assq :result-params params)) result (org-babel-js-read result)))) (defun org-babel-js-read (results) @@ -97,14 +96,17 @@ This function is called by `org-babel-execute-src-block'" If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." (org-babel-read - (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (if (and (stringp results) + (string-prefix-p "[" results) + (string-suffix-p "]" results)) (org-babel-read (concat "'" (replace-regexp-in-string "\\[" "(" (replace-regexp-in-string "\\]" ")" (replace-regexp-in-string - ", " " " (replace-regexp-in-string - "'" "\"" results)))))) + ",[[:space:]]" " " + (replace-regexp-in-string + "'" "\"" results)))))) results))) (defun org-babel-js-var-to-js (var) @@ -113,7 +115,7 @@ Convert an elisp value into a string of js source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") - (format "%S" var))) + (replace-regexp-in-string "\n" "\\\\n" (format "%S" var)))) (defun org-babel-prep-session:js (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -133,7 +135,7 @@ specifying a variable of the same value." (mapcar (lambda (pair) (format "var %s=%s;" (car pair) (org-babel-js-var-to-js (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-js-initiate-session (&optional session) "If there is not a current inferior-process-buffer in SESSION diff --git a/lisp/org/ob-keys.el b/lisp/org/ob-keys.el index b71fba416f..f5fb910123 100644 --- a/lisp/org/ob-keys.el +++ b/lisp/org/ob-keys.el @@ -1,4 +1,4 @@ -;;; ob-keys.el --- key bindings for org-babel +;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -23,8 +23,8 @@ ;;; Commentary: -;; Add org-babel keybindings to the org-mode keymap for exposing -;; org-babel functions. These will all share a common prefix. See +;; Add Org Babel keybindings to the Org mode keymap for exposing +;; Org Babel functions. These will all share a common prefix. See ;; the value of `org-babel-key-bindings' for a list of interactive ;; functions and their associated keys. @@ -89,6 +89,7 @@ functions which are assigned key bindings, and see ("h" . org-babel-describe-bindings) ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) ("x" . org-babel-do-key-sequence-in-edit-buffer) + ("k" . org-babel-remove-result-one-or-many) ("\C-\M-h" . org-babel-mark-block)) "Alist of key bindings and interactive Babel functions. This list associates interactive Babel functions diff --git a/lisp/org/ob-latex.el b/lisp/org/ob-latex.el index d00827645e..763ffb16ff 100644 --- a/lisp/org/ob-latex.el +++ b/lisp/org/ob-latex.el @@ -1,4 +1,4 @@ -;;; ob-latex.el --- org-babel functions for latex "evaluation" +;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -32,12 +32,11 @@ ;;; Code: (require 'ob) -(declare-function org-create-formula-image "org" - (string tofile options buffer &optional type)) -(declare-function org-splice-latex-header "org" - (tpl def-pkg pkg snippets-p &optional extra)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-create-formula-image "org" (string tofile options buffer &optional type)) (declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) @@ -51,7 +50,22 @@ '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") -(defcustom org-babel-latex-htlatex "" +(defconst org-babel-header-args:latex + '((border . :any) + (fit . :any) + (imagemagick . ((nil t))) + (iminoptions . :any) + (imoutoptions . :any) + (packages . :any) + (pdfheight . :any) + (pdfpng . :any) + (pdfwidth . :any) + (headers . :any) + (packages . :any) + (buffer . ((yes no)))) + "LaTeX-specific header arguments.") + +(defcustom org-babel-latex-htlatex "htlatex" "The htlatex command to enable conversion of latex to SVG or HTML." :group 'org-babel :type 'string) @@ -70,37 +84,82 @@ (regexp-quote (format "%S" (car pair))) (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) - body))) (mapcar #'cdr (org-babel-get-header params :var))) - (org-babel-trim body)) + body))) (org-babel--get-vars params)) + (org-trim body)) (defun org-babel-execute:latex (body params) "Execute a block of Latex code with Babel. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) - (if (cdr (assoc :file params)) - (let* ((out-file (cdr (assoc :file params))) + (if (cdr (assq :file params)) + (let* ((out-file (cdr (assq :file params))) + (extension (file-name-extension out-file)) (tex-file (org-babel-temp-file "latex-" ".tex")) - (border (cdr (assoc :border params))) - (imagemagick (cdr (assoc :imagemagick params))) - (im-in-options (cdr (assoc :iminoptions params))) - (im-out-options (cdr (assoc :imoutoptions params))) - (pdfpng (cdr (assoc :pdfpng params))) - (fit (or (cdr (assoc :fit params)) border)) - (height (and fit (cdr (assoc :pdfheight params)))) - (width (and fit (cdr (assoc :pdfwidth params)))) - (headers (cdr (assoc :headers params))) - (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (border (cdr (assq :border params))) + (imagemagick (cdr (assq :imagemagick params))) + (im-in-options (cdr (assq :iminoptions params))) + (im-out-options (cdr (assq :imoutoptions params))) + (fit (or (cdr (assq :fit params)) border)) + (height (and fit (cdr (assq :pdfheight params)))) + (width (and fit (cdr (assq :pdfwidth params)))) + (headers (cdr (assq :headers params))) + (in-buffer (not (string= "no" (cdr (assq :buffer params))))) (org-latex-packages-alist - (append (cdr (assoc :packages params)) org-latex-packages-alist))) + (append (cdr (assq :packages params)) org-latex-packages-alist))) (cond - ((and (string-match "\\.png$" out-file) (not imagemagick)) + ((and (string-suffix-p ".png" out-file) (not imagemagick)) (org-create-formula-image body out-file org-format-latex-options in-buffer)) - ((string-match "\\.tikz$" out-file) + ((string-suffix-p ".tikz" out-file) (when (file-exists-p out-file) (delete-file out-file)) (with-temp-file out-file (insert body))) - ((or (string-match "\\.pdf$" out-file) imagemagick) + ((and (or (string= "svg" extension) + (string= "html" extension)) + (executable-find org-babel-latex-htlatex)) + ;; TODO: this is a very different way of generating the + ;; frame latex document than in the pdf case. Ideally, both + ;; would be unified. This would prevent bugs creeping in + ;; such as the one fixed on Aug 16 2014 whereby :headers was + ;; not included in the SVG/HTML case. + (with-temp-file tex-file + (insert (concat + "\\documentclass[preview]{standalone} +\\def\\pgfsysdriver{pgfsys-tex4ht.def} +" + (mapconcat (lambda (pkg) + (concat "\\usepackage" pkg)) + org-babel-latex-htlatex-packages + "\n") + (if headers + (concat "\n" + (if (listp headers) + (mapconcat #'identity headers "\n") + headers) "\n") + "") + "\\begin{document}" + body + "\\end{document}"))) + (when (file-exists-p out-file) (delete-file out-file)) + (let ((default-directory (file-name-directory tex-file))) + (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) + (cond + ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) + (if (string-suffix-p ".svg" out-file) + (progn + (shell-command "pwd") + (shell-command (format "mv %s %s" + (concat (file-name-sans-extension tex-file) "-1.svg") + out-file))) + (error "SVG file produced but HTML file requested"))) + ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) + (if (string-suffix-p ".html" out-file) + (shell-command "mv %s %s" + (concat (file-name-sans-extension tex-file) + ".html") + out-file) + (error "HTML file produced but SVG file requested"))))) + ((or (string= "pdf" extension) imagemagick) (with-temp-file tex-file (require 'ox-latex) (insert @@ -133,54 +192,20 @@ This function is called by `org-babel-execute-src-block'." (when (file-exists-p out-file) (delete-file out-file)) (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) (cond - ((string-match "\\.pdf$" out-file) + ((string= "pdf" extension) (rename-file transient-pdf-file out-file)) (imagemagick - (convert-pdf + (org-babel-latex-convert-pdf transient-pdf-file out-file im-in-options im-out-options) (when (file-exists-p transient-pdf-file) - (delete-file transient-pdf-file)))))) - ((and (or (string-match "\\.svg$" out-file) - (string-match "\\.html$" out-file)) - (not (string= "" org-babel-latex-htlatex))) - (with-temp-file tex-file - (insert (concat - "\\documentclass[preview]{standalone} -\\def\\pgfsysdriver{pgfsys-tex4ht.def} -" - (mapconcat (lambda (pkg) - (concat "\\usepackage" pkg)) - org-babel-latex-htlatex-packages - "\n") - "\\begin{document}" - body - "\\end{document}"))) - (when (file-exists-p out-file) (delete-file out-file)) - (let ((default-directory (file-name-directory tex-file))) - (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) - (cond - ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) - (if (string-match "\\.svg$" out-file) - (progn - (shell-command "pwd") - (shell-command (format "mv %s %s" - (concat (file-name-sans-extension tex-file) "-1.svg") - out-file))) - (error "SVG file produced but HTML file requested."))) - ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) - (if (string-match "\\.html$" out-file) - (shell-command "mv %s %s" - (concat (file-name-sans-extension tex-file) - ".html") - out-file) - (error "HTML file produced but SVG file requested."))))) - ((string-match "\\.\\([^\\.]+\\)$" out-file) - (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" - (match-string 1 out-file)))) + (delete-file transient-pdf-file))) + (t + (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" + extension)))))) nil) ;; signal that output has already been written to file body)) -(defun convert-pdf (pdffile out-file im-in-options im-out-options) +(defun org-babel-latex-convert-pdf (pdffile out-file im-in-options im-out-options) "Generate a file from a pdf file using imagemagick." (let ((cmd (concat "convert " im-in-options " " pdffile " " im-out-options " " out-file))) @@ -192,7 +217,7 @@ This function is called by `org-babel-execute-src-block'." (require 'ox-latex) (org-latex-compile file)) -(defun org-babel-prep-session:latex (session params) +(defun org-babel-prep-session:latex (_session _params) "Return an error because LaTeX doesn't support sessions." (error "LaTeX does not support sessions")) diff --git a/lisp/org/ob-ledger.el b/lisp/org/ob-ledger.el index 154e75c0e0..c02069e283 100644 --- a/lisp/org/ob-ledger.el +++ b/lisp/org/ob-ledger.el @@ -1,4 +1,4 @@ -;;; ob-ledger.el --- org-babel functions for ledger evaluation +;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -46,8 +46,7 @@ "Execute a block of Ledger entries with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Ledger source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (cmdline (cdr (assoc :cmdline params))) + (let ((cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "ledger-")) (out-file (org-babel-temp-file "ledger-output-"))) (with-temp-file in-file (insert body)) @@ -61,7 +60,7 @@ called by `org-babel-execute-src-block'." " > " (org-babel-process-file-name out-file)))) (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) -(defun org-babel-prep-session:ledger (session params) +(defun org-babel-prep-session:ledger (_session _params) (error "Ledger does not support sessions")) (provide 'ob-ledger) diff --git a/lisp/org/ob-lilypond.el b/lisp/org/ob-lilypond.el index b37ecd87a7..37a7a6b57e 100644 --- a/lisp/org/ob-lilypond.el +++ b/lisp/org/ob-lilypond.el @@ -1,4 +1,4 @@ -;;; ob-lilypond.el --- org-babel functions for lilypond evaluation +;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -28,6 +28,8 @@ ;; ;; Lilypond documentation can be found at ;; http://lilypond.org/manuals.html +;; +;; This depends on epstopdf --- See http://www.ctan.org/pkg/epstopdf. ;;; Code: (require 'ob) @@ -60,51 +62,68 @@ org-babel-lilypond-play-midi-post-tangle determines whether to automate the playing of the resultant midi file. If the value is nil, the midi file is not automatically played. Default value is t") -(defvar org-babel-lilypond-OSX-ly-path - "/Applications/lilypond.app/Contents/Resources/bin/lilypond") -(defvar org-babel-lilypond-OSX-pdf-path "open") -(defvar org-babel-lilypond-OSX-midi-path "open") - -(defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond") -(defvar org-babel-lilypond-nix-pdf-path "evince") -(defvar org-babel-lilypond-nix-midi-path "timidity") - -(defvar org-babel-lilypond-w32-ly-path "lilypond") -(defvar org-babel-lilypond-w32-pdf-path "") -(defvar org-babel-lilypond-w32-midi-path "") +(defvar org-babel-lilypond-ly-command "" + "Command to execute lilypond on your system. +Do not set it directly. Customize `org-babel-lilypond-commands' instead.") +(defvar org-babel-lilypond-pdf-command "" + "Command to show a PDF file on your system. +Do not set it directly. Customize `org-babel-lilypond-commands' instead.") +(defvar org-babel-lilypond-midi-command "" + "Command to play a MIDI file on your system. +Do not set it directly. Customize `org-babel-lilypond-commands' instead.") +(defcustom org-babel-lilypond-commands + (cond + ((eq system-type 'darwin) + '("/Applications/lilypond.app/Contents/Resources/bin/lilypond" "open" "open")) + ((eq system-type 'windows-nt) + '("lilypond" "" "")) + (t + '("lilypond" "xdg-open" "xdg-open"))) + "Commands to run lilypond and view or play the results. +These should be executables that take a filename as an argument. +On some system it is possible to specify the filename directly +and the viewer or player will be determined from the file type; +you can leave the string empty on this case." + :group 'org-babel + :type '(list + (string :tag "Lilypond ") + (string :tag "PDF Viewer ") + (string :tag "MIDI Player")) + :version "24.3" + :package-version '(Org . "8.2.7") + :set + (lambda (_symbol value) + (setq + org-babel-lilypond-ly-command (nth 0 value) + org-babel-lilypond-pdf-command (nth 1 value) + org-babel-lilypond-midi-command (nth 2 value)))) (defvar org-babel-lilypond-gen-png nil - "Image generation (png) can be turned on by default by setting -ORG-BABEL-LILYPOND-GEN-PNG to t") + "Non-nil means image generation (PNG) is turned on by default.") (defvar org-babel-lilypond-gen-svg nil - "Image generation (SVG) can be turned on by default by setting -ORG-BABEL-LILYPOND-GEN-SVG to t") + "Non-nil means image generation (SVG) is be turned on by default.") (defvar org-babel-lilypond-gen-html nil - "HTML generation can be turned on by default by setting -ORG-BABEL-LILYPOND-GEN-HTML to t") + "Non-nil means HTML generation is turned on by default.") (defvar org-babel-lilypond-gen-pdf nil - "PDF generation can be turned on by default by setting -ORG-BABEL-LILYPOND-GEN-PDF to t") + "Non-nil means PDF generation is be turned on by default.") (defvar org-babel-lilypond-use-eps nil - "You can force the compiler to use the EPS backend by setting -ORG-BABEL-LILYPOND-USE-EPS to t") + "Non-nil forces the compiler to use the EPS backend.") (defvar org-babel-lilypond-arrange-mode nil - "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-ARRANGE-MODE -to t. In Arrange mode the following settings are altered -from default... + "Non-nil turns Arrange mode on. +In Arrange mode the following settings are altered from default: :tangle yes, :noweb yes :results silent :comments yes. In addition lilypond block execution causes tangling of all lilypond -blocks") +blocks.") (defun org-babel-expand-body:lilypond (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapc (lambda (pair) (let ((name (symbol-name (car pair))) @@ -138,9 +157,8 @@ specific arguments to =org-babel-tangle=" (defun org-babel-lilypond-process-basic (body params) "Execute a lilypond block in basic mode." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) - (cmdline (or (cdr (assoc :cmdline params)) + (let* ((out-file (cdr (assq :file params))) + (cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "lilypond-"))) @@ -148,7 +166,7 @@ specific arguments to =org-babel-tangle=" (insert (org-babel-expand-body:generic body params))) (org-babel-eval (concat - (org-babel-lilypond-determine-ly-path) + org-babel-lilypond-ly-command " -dbackend=eps " "-dno-gs-load-fonts " "-dinclude-eps-fonts " @@ -163,7 +181,7 @@ specific arguments to =org-babel-tangle=" cmdline in-file) "")) nil) -(defun org-babel-prep-session:lilypond (session params) +(defun org-babel-prep-session:lilypond (_session _params) "Return an error because LilyPond exporter does not support sessions." (error "Sorry, LilyPond does not currently support sessions!")) @@ -175,29 +193,27 @@ If error in compilation, attempt to mark the error in lilypond org file" (buffer-file-name) ".lilypond")) (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension (buffer-file-name) ".ly"))) - (if (file-exists-p org-babel-lilypond-tangled-file) - (progn - (when (file-exists-p org-babel-lilypond-temp-file) - (delete-file org-babel-lilypond-temp-file)) - (rename-file org-babel-lilypond-tangled-file - org-babel-lilypond-temp-file)) - (error "Error: Tangle Failed!") t) + (if (not (file-exists-p org-babel-lilypond-tangled-file)) + (error "Error: Tangle Failed!") + (when (file-exists-p org-babel-lilypond-temp-file) + (delete-file org-babel-lilypond-temp-file)) + (rename-file org-babel-lilypond-tangled-file + org-babel-lilypond-temp-file)) (switch-to-buffer-other-window "*lilypond*") (erase-buffer) (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) (goto-char (point-min)) - (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file)) - (progn - (other-window -1) - (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file) - (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)) - (error "Error in Compilation!")))) nil) + (if (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file) + (error "Error in Compilation!") + (other-window -1) + (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file) + (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file))))) (defun org-babel-lilypond-compile-lilyfile (file-name &optional test) "Compile lilypond file and check for compile errors FILE-NAME is full path to lilypond (.ly) file" (message "Compiling LilyPond...") - (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program + (let ((arg-1 org-babel-lilypond-ly-command) ;program (arg-2 nil) ;infile (arg-3 "*lilypond*") ;buffer (arg-4 t) ;display @@ -223,11 +239,10 @@ FILE-NAME is full path to lilypond file. If TEST is t just return nil if no error found, and pass nil as file-name since it is unused in this context" (let ((is-error (search-forward "error:" nil t))) - (if (not test) - (if (not is-error) - nil - (org-babel-lilypond-process-compile-error file-name)) - is-error))) + (if test + is-error + (when is-error + (org-babel-lilypond-process-compile-error file-name))))) (defun org-babel-lilypond-process-compile-error (file-name) "Process the compilation error that has occurred. @@ -249,32 +264,26 @@ LINE is the erroneous line" (setq case-fold-search nil) (if (search-forward line nil t) (progn - (show-all) + (outline-show-all) (set-mark (point)) (goto-char (- (point) (length line)))) (goto-char temp)))) (defun org-babel-lilypond-parse-line-num (&optional buffer) "Extract error line number." - (when buffer - (set-buffer buffer)) + (when buffer (set-buffer buffer)) (let ((start (and (search-backward ":" nil t) (search-backward ":" nil t) (search-backward ":" nil t) - (search-backward ":" nil t))) - (num nil)) - (if start - (progn - (forward-char) - (let ((num (buffer-substring - (+ 1 start) - (- (search-forward ":" nil t) 1)))) - (setq num (string-to-number num)) - (if (numberp num) - num - nil))) - nil))) + (search-backward ":" nil t)))) + (when start + (forward-char) + (let ((num (string-to-number + (buffer-substring + (+ 1 start) + (- (search-forward ":" nil t) 1))))) + (and (numberp num) num))))) (defun org-babel-lilypond-parse-error-line (file-name lineNo) "Extract the erroneous line from the tangled .ly file @@ -298,13 +307,13 @@ If TEST is non-nil, the shell command is returned and is not run" (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf"))) (if (file-exists-p pdf-file) (let ((cmd-string - (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file))) + (concat org-babel-lilypond-pdf-command " " pdf-file))) (if test cmd-string (start-process "\"Audition pdf\"" "*lilypond*" - (org-babel-lilypond-determine-pdf-path) + org-babel-lilypond-pdf-command pdf-file))) (message "No pdf file generated so can't display!"))))) @@ -316,49 +325,16 @@ If TEST is non-nil, the shell command is returned and is not run" (let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi"))) (if (file-exists-p midi-file) (let ((cmd-string - (concat (org-babel-lilypond-determine-midi-path) " " midi-file))) + (concat org-babel-lilypond-midi-command " " midi-file))) (if test cmd-string (start-process "\"Audition midi\"" "*lilypond*" - (org-babel-lilypond-determine-midi-path) + org-babel-lilypond-midi-command midi-file))) (message "No midi file generated so can't play!"))))) -(defun org-babel-lilypond-determine-ly-path (&optional test) - "Return correct path to ly binary depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test system-type))) - (cond ((string= sys-type "darwin") - org-babel-lilypond-OSX-ly-path) - ((string= sys-type "windows-nt") - org-babel-lilypond-w32-ly-path) - (t org-babel-lilypond-nix-ly-path)))) - -(defun org-babel-lilypond-determine-pdf-path (&optional test) - "Return correct path to pdf viewer depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test system-type))) - (cond ((string= sys-type "darwin") - org-babel-lilypond-OSX-pdf-path) - ((string= sys-type "windows-nt") - org-babel-lilypond-w32-pdf-path) - (t org-babel-lilypond-nix-pdf-path)))) - -(defun org-babel-lilypond-determine-midi-path (&optional test) - "Return correct path to midi player depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test test system-type))) - (cond ((string= sys-type "darwin") - org-babel-lilypond-OSX-midi-path) - ((string= sys-type "windows-nt") - org-babel-lilypond-w32-midi-path) - (t org-babel-lilypond-nix-midi-path)))) - (defun org-babel-lilypond-toggle-midi-play () "Toggle whether midi will be played following a successful compilation." (interactive) diff --git a/lisp/org/ob-lisp.el b/lisp/org/ob-lisp.el index 2f66549fc3..1e381d0ce2 100644 --- a/lisp/org/ob-lisp.el +++ b/lisp/org/ob-lisp.el @@ -1,4 +1,4 @@ -;;; ob-lisp.el --- org-babel functions for common lisp evaluation +;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -25,17 +25,22 @@ ;;; Commentary: -;;; support for evaluating common lisp code, relies on slime for all eval +;;; Support for evaluating Common Lisp code, relies on SLY or SLIME +;;; for all eval. ;;; Requirements: -;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) -;; See http://common-lisp.net/project/slime/ +;; Requires SLY (Sylvester the Cat's Common Lisp IDE) or SLIME +;; (Superior Lisp Interaction Mode for Emacs). See: +;; - https://github.com/capitaomorte/sly +;; - http://common-lisp.net/project/slime/ ;;; Code: (require 'ob) +(declare-function sly-eval "ext:sly" (sexp &optional package)) (declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) @@ -43,8 +48,16 @@ (defvar org-babel-default-header-args:lisp '()) (defvar org-babel-header-args:lisp '((package . :any))) +(defcustom org-babel-lisp-eval-fn #'slime-eval + "The function to be called to evaluate code on the Lisp side. +Valid values include `slime-eval' and `sly-eval'." + :group 'org-babel + :version "26.1" + :package-version '(Org . "9.0") + :type 'function) + (defcustom org-babel-lisp-dir-fmt - "(let ((*default-pathname-defaults* #P%S)) %%s)" + "(let ((*default-pathname-defaults* #P%S\n)) %%s\n)" "Format string used to wrap code bodies to set the current directory. For example a value of \"(progn ;; %s\\n %%s)\" would ignore the current directory string." @@ -54,49 +67,54 @@ current directory string." (defun org-babel-expand-body:lisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) + (let* ((vars (org-babel--get-vars params)) + (result-params (cdr (assq :result-params params))) (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "(%S (quote %S))" (car var) (cdr var))) - vars "\n ") - ")\n" body ")") - body)))) + (body (if (null vars) (org-trim body) + (concat "(let (" + (mapconcat + (lambda (var) + (format "(%S (quote %S))" (car var) (cdr var))) + vars "\n ") + ")\n" body ")")))) (if (or (member "code" result-params) (member "pp" result-params)) (format "(pprint %s)" body) body))) (defun org-babel-execute:lisp (body params) - "Execute a block of Common Lisp code with Babel." - (require 'slime) + "Execute a block of Common Lisp code with Babel. +BODY is the contents of the block, as a string. PARAMS is +a property list containing the parameters of the block." + (require (pcase org-babel-lisp-eval-fn + (`slime-eval 'slime) + (`sly-eval 'sly))) (org-babel-reassemble-table (let ((result - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - (car result) + (funcall (if (member "output" (cdr (assq :result-params params))) + #'car #'cadr) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (funcall org-babel-lisp-eval-fn + `(swank:eval-and-grab-output + ,(let ((dir (if (assq :dir params) + (cdr (assq :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s\n)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assq :package params))))))) + (org-babel-result-cond (cdr (assq :result-params params)) + result (condition-case nil - (read (org-babel-lisp-vector-to-list (cadr result))) - (error (cadr result))))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))) + (read (org-babel-lisp-vector-to-list result)) + (error result)))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params))))) (defun org-babel-lisp-vector-to-list (results) ;; TODO: better would be to replace #(...) with [...] diff --git a/lisp/org/ob-lob.el b/lisp/org/ob-lob.el index ddfac2afee..b6f50d33ed 100644 --- a/lisp/org/ob-lob.el +++ b/lisp/org/ob-lob.el @@ -1,4 +1,4 @@ -;;; ob-lob.el --- functions supporting the Library of Babel +;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -23,27 +23,27 @@ ;; along with GNU Emacs. If not, see . ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'ob-core) (require 'ob-table) -(declare-function org-babel-in-example-or-verbatim "ob-exp" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) (defvar org-babel-library-of-babel nil "Library of source-code blocks. -This is an association list. Populate the library by adding -files to `org-babel-lob-files'.") - -(defcustom org-babel-lob-files nil - "Files used to populate the `org-babel-library-of-babel'. -To add files to this list use the `org-babel-lob-ingest' command." - :group 'org-babel - :version "24.1" - :type '(repeat file)) +This is an association list. Populate the library by calling +`org-babel-lob-ingest' on files containing source blocks.") (defvar org-babel-default-lob-header-args '((:exports . "results")) - "Default header arguments to use when exporting #+lob/call lines.") + "Default header arguments to use when exporting Babel calls. +By default, a Babel call inherits its arguments from the source +block being called. Header arguments defined in this variable +take precedence over these. It is useful for properties that +should not be inherited from a source block.") (defun org-babel-lob-ingest (&optional file) "Add all named source blocks defined in FILE to `org-babel-library-of-babel'." @@ -62,24 +62,7 @@ To add files to this list use the `org-babel-lob-ingest' command." lob-ingest-count (if (> lob-ingest-count 1) "s" "")) lob-ingest-count)) -(defconst org-babel-block-lob-one-liner-regexp - (concat - "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" - "(\\([^\n]*?\\))\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?") - "Regexp to match non-inline calls to predefined source block functions.") - -(defconst org-babel-inline-lob-one-liner-regexp - (concat - "\\([^\n]*?\\)call_\\([^()\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)" - "(\\([^\n]*?\\))\\(\\[\\(.*?\\)\\]\\)?") - "Regexp to match inline calls to predefined source block functions.") - -(defconst org-babel-lob-one-liner-regexp - (concat "\\(" org-babel-block-lob-one-liner-regexp - "\\|" org-babel-inline-lob-one-liner-regexp "\\)") - "Regexp to match calls to predefined source block functions.") - -;; functions for executing lob one-liners +;; Functions for executing lob one-liners. ;;;###autoload (defun org-babel-lob-execute-maybe () @@ -88,72 +71,76 @@ Detect if this is context for a Library Of Babel source block and if so then run the appropriate source block from the Library." (interactive) (let ((info (org-babel-lob-get-info))) - (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim))) - (progn (org-babel-lob-execute info) t) - nil))) + (when info + (org-babel-execute-src-block nil info) + t))) + +(defun org-babel-lob--src-info (name) + "Return internal representation for Babel data named NAME. +NAME is a string. This function looks into the current document +for a Babel call or source block. If none is found, it looks +after NAME in the Library of Babel. Eventually, if that also +fails, it returns nil." + ;; During export, look into the pristine copy of the document being + ;; exported instead of the current one, which could miss some data. + (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer)) + (org-with-wide-buffer + (goto-char (point-min)) + (catch :found + (let ((case-fold-search t) + (regexp (org-babel-named-data-regexp-for-name name))) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (equal name (org-element-property :name element)) + (throw :found + (pcase (org-element-type element) + (`src-block (org-babel-get-src-block-info t element)) + (`babel-call (org-babel-lob-get-info element)) + ;; Non-executable data found. Since names are + ;; supposed to be unique throughout a document, + ;; bail out. + (_ nil)))))) + ;; No element named NAME in buffer. Try Library of Babel. + (cdr (assoc-string name org-babel-library-of-babel))))))) ;;;###autoload -(defun org-babel-lob-get-info () - "Return a Library of Babel function call as a string." - (let ((case-fold-search t) - (nonempty (lambda (a b) - (let ((it (match-string a))) - (if (= (length it) 0) (match-string b) it))))) - (save-excursion - (beginning-of-line 1) - (when (looking-at org-babel-lob-one-liner-regexp) - (append - (mapcar #'org-no-properties - (list - (format "%s%s(%s)%s" - (funcall nonempty 3 12) - (if (not (= 0 (length (funcall nonempty 5 14)))) - (concat "[" (funcall nonempty 5 14) "]") "") - (or (funcall nonempty 7 16) "") - (or (funcall nonempty 8 19) "")) - (funcall nonempty 9 18))) - (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11))) - (save-excursion - (forward-line -1) - (and (looking-at (concat org-babel-src-name-regexp - "\\([^\n]*\\)$")) - (org-no-properties (match-string 1)))))))))) - -(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el -(defun org-babel-lob-execute (info) - "Execute the lob call specified by INFO." - (let* ((mkinfo (lambda (p) - (list "emacs-lisp" "results" p nil - (nth 3 info) ;; name - (nth 2 info)))) - (pre-params (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-header-args:emacs-lisp - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat #'identity (butlast info 2) - " ")))))))) - (pre-info (funcall mkinfo pre-params)) - (cache-p (and (cdr (assoc :cache pre-params)) - (string= "yes" (cdr (assoc :cache pre-params))))) - (new-hash (when cache-p (org-babel-sha1-hash pre-info))) - (old-hash (when cache-p (org-babel-current-result-hash))) - (org-babel-current-src-block-location (point-marker))) - (if (and cache-p (equal new-hash old-hash)) - (save-excursion (goto-char (org-babel-where-is-src-block-result)) - (forward-line 1) - (message "%S" (org-babel-read-result))) - (prog1 (let* ((proc-params (org-babel-process-params pre-params)) - org-confirm-babel-evaluate) - (org-babel-execute-src-block nil (funcall mkinfo proc-params))) - ;; update the hash - (when new-hash (org-babel-set-current-result-hash new-hash)))))) +(defun org-babel-lob-get-info (&optional datum) + "Return internal representation for Library of Babel function call. +Consider DATUM, when provided, or element at point. Return nil +when not on an appropriate location. Otherwise return a list +compatible with `org-babel-get-src-block-info', which see." + (let* ((context (or datum (org-element-context))) + (type (org-element-type context))) + (when (memq type '(babel-call inline-babel-call)) + (pcase (org-babel-lob--src-info (org-element-property :call context)) + (`(,language ,body ,header ,_ ,_ ,_ ,coderef) + (let ((begin (org-element-property (if (eq type 'inline-babel-call) + :begin + :post-affiliated) + context))) + (list language + body + (apply #'org-babel-merge-params + header + org-babel-default-lob-header-args + (append + (org-with-wide-buffer + (goto-char begin) + (org-babel-params-from-properties language)) + (list + (org-babel-parse-header-arguments + (org-element-property :inside-header context)) + (let ((args (org-element-property :arguments context))) + (and args + (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args args)))) + (org-babel-parse-header-arguments + (org-element-property :end-header context))))) + nil + (org-element-property :name context) + begin + coderef))) + (_ nil))))) (provide 'ob-lob) diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el new file mode 100644 index 0000000000..fa60b0ee2d --- /dev/null +++ b/lisp/org/ob-lua.el @@ -0,0 +1,403 @@ +;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*- + +;; Copyright (C) 2014, 2016, 2017 Free Software Foundation, Inc. + +;; Authors: Dieter Schoen +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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 . + +;; Requirements: +;; for session support, lua-mode is needed. +;; lua-mode is not part of GNU Emacs/orgmode, but can be obtained +;; from marmalade or melpa. +;; The source respository is here: +;; https://github.com/immerrr/lua-mode + +;; However, sessions are not yet working. + +;; Org-Babel support for evaluating lua source code. + +;;; Code: +(require 'ob) +(require 'cl-lib) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function lua-shell "ext:lua-mode" (&optional argprompt)) +(declare-function lua-toggle-shells "ext:lua-mode" (arg)) +(declare-function run-lua "ext:lua" (cmd &optional dedicated show)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("lua" . "lua")) + +(defvar org-babel-default-header-args:lua '()) + +(defcustom org-babel-lua-command "lua" + "Name of the command for executing Lua code." + :version "24.5" + :package-version '(Org . "8.3") + :group 'org-babel + :type 'string) + +(defcustom org-babel-lua-mode 'lua-mode + "Preferred lua mode for use in running lua interactively. +This will typically be 'lua-mode." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'symbol) + +(defcustom org-babel-lua-hline-to "None" + "Replace hlines in incoming tables with this when translating to lua." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'string) + +(defcustom org-babel-lua-None-to 'hline + "Replace 'None' in lua tables with this before returning." + :group 'org-babel + :version "24.5" + :package-version '(Org . "8.3") + :type 'symbol) + +(defun org-babel-execute:lua (body params) + "Execute a block of Lua code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-lua-initiate-session + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) + (return-val (when (and (eq result-type 'value) (not session)) + (cdr (assq :return params)))) + (preamble (cdr (assq :preamble params))) + (full-body + (org-babel-expand-body:generic + (concat body (if return-val (format "\nreturn %s" return-val) "")) + params (org-babel-variable-assignments:lua params))) + (result (org-babel-lua-evaluate + session full-body result-type result-params preamble))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) + +(defun org-babel-prep-session:lua (session params) + "Prepare SESSION according to the header arguments in PARAMS. +VARS contains resolved variable references" + (let* ((session (org-babel-lua-initiate-session session)) + (var-lines + (org-babel-variable-assignments:lua params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:lua (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:lua session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:lua (params) + "Return a list of Lua statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-lua-var-to-lua (cdr pair)))) + (org-babel--get-vars params))) + +(defun org-babel-lua-var-to-lua (var) + "Convert an elisp value to a lua variable. +Convert an elisp value, VAR, into a string of lua source code +specifying a variable of the same value." + (if (listp var) + (if (and (= 1 (length var)) (not (listp (car var)))) + (org-babel-lua-var-to-lua (car var)) + (if (and + (= 2 (length var)) + (not (listp (car var)))) + (concat + (substring-no-properties (car var)) + "=" + (org-babel-lua-var-to-lua (cdr var))) + (concat "{" (mapconcat #'org-babel-lua-var-to-lua var ", ") "}"))) + (if (eq var 'hline) + org-babel-lua-hline-to + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + (if (stringp var) (substring-no-properties var) var))))) + +(defun org-babel-lua-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (eq el 'None) + org-babel-lua-None-to el)) + res) + res))) + +(defvar org-babel-lua-buffers '((:default . "*Lua*"))) + +(defun org-babel-lua-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-lua-buffers))) + +(defun org-babel-lua-with-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + name + (format "*%s*" name)))) + +(defun org-babel-lua-without-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + (substring name 1 (- (length name) 1)) + name))) + +(defvar lua-default-interpreter) +(defvar lua-which-bufname) +(defvar lua-shell-buffer-name) +(defun org-babel-lua-initiate-session-by-key (&optional session) + "Initiate a lua session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + ;; (require org-babel-lua-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (lua-buffer (org-babel-lua-session-buffer session)) + ;; (cmd (if (member system-type '(cygwin windows-nt ms-dos)) + ;; (concat org-babel-lua-command " -i") + ;; org-babel-lua-command)) + ) + (cond + ((and (eq 'lua-mode org-babel-lua-mode) + (fboundp 'lua-start-process)) ; lua-mode.el + ;; Make sure that lua-which-bufname is initialized, as otherwise + ;; it will be overwritten the first time a Lua buffer is + ;; created. + ;;(lua-toggle-shells lua-default-interpreter) + ;; `lua-shell' creates a buffer whose name is the value of + ;; `lua-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if (and lua-buffer (buffer-live-p lua-buffer)) + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" (buffer-name lua-buffer)) + (concat "Lua-" (symbol-name session)))) + (lua-which-bufname bufname)) + (lua-start-process) + (setq lua-buffer (org-babel-lua-with-earmuffs bufname)))) + (t + (error "No function available for running an inferior Lua"))) + (setq org-babel-lua-buffers + (cons (cons session lua-buffer) + (assq-delete-all session org-babel-lua-buffers))) + session))) + +(defun org-babel-lua-initiate-session (&optional session _params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (error "Sessions currently not supported, work in progress") + (org-babel-lua-session-buffer + (org-babel-lua-initiate-session-by-key session)))) + +(defvar org-babel-lua-eoe-indicator "--eoe" + "A string to indicate that evaluation has completed.") + +(defvar org-babel-lua-wrapper-method + " +function main() +%s +end + +fd=io.open(\"%s\", \"w\") +fd:write( main() ) +fd:close()") +(defvar org-babel-lua-pp-wrapper-method + " +-- table to string +function t2s(t, indent) + if indent == nil then + indent = \"\" + end + if type(t) == \"table\" then + ts = \"\" + for k,v in pairs(t) do + if type(v) == \"table\" then + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" .. + t2s(v, indent .. \" \") + else + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" .. + t2s(v, indent .. \" \") .. \"\\n\" + end + end + return ts + else + return tostring(t) + end +end + + +function main() +%s +end + +fd=io.open(\"%s\", \"w\") +fd:write(t2s(main())) +fd:close()") + +(defun org-babel-lua-evaluate + (session body &optional result-type result-params preamble) + "Evaluate BODY as Lua code." + (if session + (org-babel-lua-evaluate-session + session body result-type result-params) + (org-babel-lua-evaluate-external-process + body result-type result-params preamble))) + +(defun org-babel-lua-evaluate-external-process + (body &optional result-type result-params preamble) + "Evaluate BODY in external lua process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let ((raw + (pcase result-type + (`output (org-babel-eval org-babel-lua-command + (concat (if preamble (concat preamble "\n")) + body))) + (`value (let ((tmp-file (org-babel-temp-file "lua-"))) + (org-babel-eval + org-babel-lua-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-lua-pp-wrapper-method + org-babel-lua-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + (org-babel-eval-read-file tmp-file)))))) + (org-babel-result-cond result-params + raw + (org-babel-lua-table-or-string (org-trim raw))))) + +(defun org-babel-lua-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Lua process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) + (dump-last-value + (lambda + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (funcall send-wait)) + (if pp + (list + "-- table to string +function t2s(t, indent) + if indent == nil then + indent = \"\" + end + if type(t) == \"table\" then + ts = \"\" + for k,v in pairs(t) do + if type(v) == \"table\" then + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \\n\" .. + t2s(v, indent .. \" \") + else + ts = ts .. indent .. t2s(k,indent .. \" \") .. \" = \" .. + t2s(v, indent .. \" \") .. \"\\n\" + end + end + return ts + else + return tostring(t) + end +end +" + (concat "fd:write(_)) +fd:close()" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "fd=io.open(\"%s\", \"w\") +fd:write( _ ) +fd:close()" + (org-babel-process-file-name tmp-file + 'noquote))))))) + (input-body (lambda (body) + (mapc (lambda (line) (insert line) (funcall send-wait)) + (split-string body "[\r\n]")) + (funcall send-wait))) + (results + (pcase result-type + (`output + (mapconcat + #'org-trim + (butlast + (org-babel-comint-with-output + (session org-babel-lua-eoe-indicator t body) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) + (insert org-babel-lua-eoe-indicator) + (funcall send-wait)) + 2) "\n")) + (`value + (let ((tmp-file (org-babel-temp-file "lua-"))) + (org-babel-comint-with-output + (session org-babel-lua-eoe-indicator nil body) + (let ((comint-process-echoes nil)) + (funcall input-body body) + (funcall dump-last-value tmp-file + (member "pp" result-params)) + (funcall send-wait) (funcall send-wait) + (insert org-babel-lua-eoe-indicator) + (funcall send-wait))) + (org-babel-eval-read-file tmp-file)))))) + (unless (string= (substring org-babel-lua-eoe-indicator 1 -1) results) + (org-babel-result-cond result-params + results + (org-babel-lua-table-or-string results))))) + +(defun org-babel-lua-read-string (string) + "Strip 's from around Lua string." + (org-unbracket-string "'" "'" string)) + +(provide 'ob-lua) + + + +;;; ob-lua.el ends here diff --git a/lisp/org/ob-makefile.el b/lisp/org/ob-makefile.el index a292800dc1..2aa04fd2af 100644 --- a/lisp/org/ob-makefile.el +++ b/lisp/org/ob-makefile.el @@ -1,4 +1,4 @@ -;;; ob-makefile.el --- org-babel functions for makefile evaluation +;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -24,19 +24,19 @@ ;;; Commentary: -;; This file exists solely for tangling a Makefile from org-mode files. +;; This file exists solely for tangling a Makefile from Org files. ;;; Code: (require 'ob) (defvar org-babel-default-header-args:makefile '()) -(defun org-babel-execute:makefile (body params) +(defun org-babel-execute:makefile (body _params) "Execute a block of makefile code. This function is called by `org-babel-execute-src-block'." body) -(defun org-babel-prep-session:makefile (session params) +(defun org-babel-prep-session:makefile (_session _params) "Return an error if the :session header argument is set. Make does not support sessions." (error "Makefile sessions are nonsensical")) diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el index 42bbd2b907..23cfa36d1e 100644 --- a/lisp/org/ob-matlab.el +++ b/lisp/org/ob-matlab.el @@ -1,4 +1,4 @@ -;;; ob-matlab.el --- org-babel support for matlab evaluation +;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. diff --git a/lisp/org/ob-maxima.el b/lisp/org/ob-maxima.el index b567fd484a..0a4d835a3a 100644 --- a/lisp/org/ob-maxima.el +++ b/lisp/org/ob-maxima.el @@ -1,4 +1,4 @@ -;;; ob-maxima.el --- org-babel functions for maxima evaluation +;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -48,11 +48,11 @@ (defun org-babel-maxima-expand (body params) "Expand a block of Maxima code according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (mapconcat 'identity (list ;; graphic output - (let ((graphic-file (org-babel-maxima-graphical-output-file params))) + (let ((graphic-file (ignore-errors (org-babel-graphical-output-file params)))) (if graphic-file (format "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" @@ -69,9 +69,9 @@ "Execute a block of Maxima entries with org-babel. This function is called by `org-babel-execute-src-block'." (message "executing Maxima source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (result - (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) + (let* ((cmdline (or (cdr (assq :cmdline params)) "")) (in-file (org-babel-temp-file "maxima-" ".max")) (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" org-babel-maxima-command in-file cmdline))) @@ -89,7 +89,7 @@ This function is called by `org-babel-execute-src-block'." (= 0 (length line))) line)) (split-string raw "[\r\n]"))) "\n"))))) - (if (org-babel-maxima-graphical-output-file params) + (if (ignore-errors (org-babel-graphical-output-file params)) nil (org-babel-result-cond result-params result @@ -98,7 +98,7 @@ This function is called by `org-babel-execute-src-block'." (org-babel-import-elisp-from-file tmp-file)))))) -(defun org-babel-prep-session:maxima (session params) +(defun org-babel-prep-session:maxima (_session _params) (error "Maxima does not support sessions")) (defun org-babel-maxima-var-to-maxima (pair) @@ -113,11 +113,6 @@ of the same value." (format "%S: %s$" var (org-babel-maxima-elisp-to-maxima val)))) -(defun org-babel-maxima-graphical-output-file (params) - "Name of file to which maxima should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - (defun org-babel-maxima-elisp-to-maxima (val) "Return a string of maxima code which evaluates to VAL." (if (listp val) diff --git a/lisp/org/ob-mscgen.el b/lisp/org/ob-mscgen.el index b764475cb2..5c9dccc67c 100644 --- a/lisp/org/ob-mscgen.el +++ b/lisp/org/ob-mscgen.el @@ -1,4 +1,4 @@ -;;; ob-msc.el --- org-babel functions for mscgen evaluation +;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -65,15 +65,15 @@ This function is called by `org-babel-execute-src-block'. Default filetype is png. Modify by setting :filetype parameter to mscgen supported formats." - (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) - (filetype (or (cdr (assoc :filetype params)) "png" ))) - (unless (cdr (assoc :file params)) + (let* ((out-file (or (cdr (assq :file params)) "output.png" )) + (filetype (or (cdr (assq :filetype params)) "png" ))) + (unless (cdr (assq :file params)) (error " ERROR: no output file specified. Add \":file name.png\" to the src header")) (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:mscgen (session params) +(defun org-babel-prep-session:mscgen (_session _params) "Raise an error because Mscgen doesn't support sessions." (error "Mscgen does not support sessions")) diff --git a/lisp/org/ob-ocaml.el b/lisp/org/ob-ocaml.el index 31f0d01d7f..7997ff03a6 100644 --- a/lisp/org/ob-ocaml.el +++ b/lisp/org/ob-ocaml.el @@ -1,4 +1,4 @@ -;;; ob-ocaml.el --- org-babel functions for ocaml evaluation +;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -37,11 +37,11 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function tuareg-run-caml "ext:tuareg" ()) (declare-function tuareg-run-ocaml "ext:tuareg" ()) (declare-function tuareg-interactive-send-input "ext:tuareg" ()) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) @@ -60,17 +60,17 @@ (defun org-babel-execute:ocaml (body params) "Execute a block of Ocaml code with Babel." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (full-body (org-babel-expand-body:generic + (let* ((full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ocaml params))) (session (org-babel-prep-session:ocaml - (cdr (assoc :session params)) params)) + (cdr (assq :session params)) params)) (raw (org-babel-comint-with-output - (session org-babel-ocaml-eoe-output t full-body) + (session org-babel-ocaml-eoe-output nil full-body) (insert (concat - (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator)) + (org-babel-chomp full-body) ";;\n" + org-babel-ocaml-eoe-indicator)) (tuareg-interactive-send-input))) (clean (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) @@ -79,23 +79,31 @@ (progn (setq out nil) line) (when (string-match re line) (progn (setq out t) nil)))) - (mapcar #'org-babel-trim (reverse raw)))))))) - (org-babel-reassemble-table - (let ((raw (org-babel-trim clean)) - (result-params (cdr (assoc :result-params params)))) + (mapcar #'org-trim (reverse raw))))))) + (raw (org-trim clean)) + (result-params (cdr (assq :result-params params)))) + (string-match + "\\(\\(.*\n\\)*\\)[^:\n]+ : \\([^=\n]+\\) =\\(\n\\| \\)\\(.+\\)$" + raw) + (let ((output (match-string 1 raw)) + (type (match-string 3 raw)) + (value (match-string 5 raw))) + (org-babel-reassemble-table (org-babel-result-cond result-params - ;; strip type information from output unless verbatim is specified - (if (and (not (member "verbatim" result-params)) - (string-match "= \\(.+\\)$" raw)) - (match-string 1 raw) raw) - (org-babel-ocaml-parse-output raw))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cond + ((member "verbatim" result-params) raw) + ((member "output" result-params) output) + (t raw)) + (if (and value type) + (org-babel-ocaml-parse-output value type) + raw)) + (org-babel-pick-name + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) + (org-babel-pick-name + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defvar tuareg-interactive-buffer-name) -(defun org-babel-prep-session:ocaml (session params) +(defun org-babel-prep-session:ocaml (session _params) "Prepare SESSION according to the header arguments in PARAMS." (require 'tuareg) (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) @@ -113,7 +121,7 @@ (mapcar (lambda (pair) (format "let %s = %s;;" (car pair) (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-ocaml-elisp-to-ocaml (val) "Return a string of ocaml code which evaluates to VAL." @@ -121,26 +129,29 @@ (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") (format "%S" val))) -(defun org-babel-ocaml-parse-output (output) - "Parse OUTPUT. -OUTPUT is string output from an ocaml process." - (let ((regexp "[^:]+ : %s = \\(.+\\)$")) - (cond - ((string-match (format regexp "string") output) - (org-babel-read (match-string 1 output))) - ((or (string-match (format regexp "int") output) - (string-match (format regexp "float") output)) - (string-to-number (match-string 1 output))) - ((string-match (format regexp "list") output) - (org-babel-ocaml-read-list (match-string 1 output))) - ((string-match (format regexp "array") output) - (org-babel-ocaml-read-array (match-string 1 output))) - (t (message "don't recognize type of %s" output) output)))) +(defun org-babel-ocaml-parse-output (value type) + "Parse VALUE of type TYPE. +VALUE and TYPE are string output from an ocaml process." + (cond + ((string= "string" type) + (org-babel-read value)) + ((or (string= "int" type) + (string= "float" type)) + (string-to-number value)) + ((string-match "list" type) + (org-babel-ocaml-read-list value)) + ((string-match "array" type) + (org-babel-ocaml-read-array value)) + (t (message "don't recognize type %s" type) value))) (defun org-babel-ocaml-read-list (results) "Convert RESULTS into an elisp table or string. If the results look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." + ;; XXX: This probably does not behave as expected when a semicolon + ;; is in a string in a list. The same comment applies to + ;; `org-babel-ocaml-read-array' below (with even more failure + ;; modes). (org-babel-script-escape (replace-regexp-in-string ";" "," results))) (defun org-babel-ocaml-read-array (results) diff --git a/lisp/org/ob-octave.el b/lisp/org/ob-octave.el index 4a96cdbf03..90735b11fb 100644 --- a/lisp/org/ob-octave.el +++ b/lisp/org/ob-octave.el @@ -1,4 +1,4 @@ -;;; ob-octave.el --- org-babel functions for octave and matlab evaluation +;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -30,10 +30,10 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function matlab-shell "ext:matlab-mode") (declare-function matlab-shell-run-region "ext:matlab-mode") +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-default-header-args:matlab '()) (defvar org-babel-default-header-args:octave '()) @@ -74,33 +74,31 @@ end") (let* ((session (funcall (intern (format "org-babel-%s-initiate-session" (if matlabp "matlab" "octave"))) - (cdr (assoc :session params)) params)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (out-file (cdr (assoc :file params))) + (cdr (assq :session params)) params)) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:octave params))) + (gfx-file (ignore-errors (org-babel-graphical-output-file params))) (result (org-babel-octave-evaluate session - (if (org-babel-octave-graphical-output-file params) + (if gfx-file (mapconcat 'identity (list "set (0, \"defaultfigurevisible\", \"off\");" full-body - (format "print -dpng %s" (org-babel-octave-graphical-output-file params))) + (format "print -dpng %s" gfx-file)) "\n") full-body) result-type matlabp))) - (if (org-babel-octave-graphical-output-file params) + (if gfx-file nil (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params))))))) (defun org-babel-prep-session:matlab (session params) "Prepare SESSION according to PARAMS." @@ -113,7 +111,7 @@ end") (format "%s=%s;" (car pair) (org-babel-octave-var-to-octave (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defalias 'org-babel-variable-assignments:matlab 'org-babel-variable-assignments:octave) @@ -147,7 +145,7 @@ If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." (org-babel-octave-initiate-session session params 'matlab)) -(defun org-babel-octave-initiate-session (&optional session params matlabp) +(defun org-babel-octave-initiate-session (&optional session _params matlabp) "Create an octave inferior process buffer. If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." @@ -167,8 +165,8 @@ create. Return the initialized session." (defun org-babel-octave-evaluate (session body result-type &optional matlabp) "Pass BODY to the octave process in SESSION. -If RESULT-TYPE equals 'output then return the outputs of the -statements in BODY, if RESULT-TYPE equals 'value then return the +If RESULT-TYPE equals `output' then return the outputs of the +statements in BODY, if RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (if session (org-babel-octave-evaluate-session session body result-type matlabp) @@ -179,9 +177,9 @@ value of the last statement in BODY, as elisp." (let ((cmd (if matlabp org-babel-matlab-shell-command org-babel-octave-shell-command))) - (case result-type - (output (org-babel-eval cmd body)) - (value (let ((tmp-file (org-babel-temp-file "octave-"))) + (pcase result-type + (`output (org-babel-eval cmd body)) + (`value (let ((tmp-file (org-babel-temp-file "octave-"))) (org-babel-eval cmd (format org-babel-octave-wrapper-method body @@ -190,17 +188,17 @@ value of the last statement in BODY, as elisp." (org-babel-octave-import-elisp-from-file tmp-file)))))) (defun org-babel-octave-evaluate-session - (session body result-type &optional matlabp) + (session body result-type &optional matlabp) "Evaluate BODY in SESSION." (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body - (case result-type - (output + (pcase result-type + (`output (mapconcat #'org-babel-chomp (list body org-babel-octave-eoe-indicator) "\n")) - (value + (`value (if (and matlabp org-babel-matlab-with-emacs-link) (concat (format org-babel-matlab-emacs-link-wrapper-method @@ -233,21 +231,20 @@ value of the last statement in BODY, as elisp." org-babel-octave-eoe-output) t full-body) (insert full-body) (comint-send-input nil t)))) results) - (case result-type - (value + (pcase result-type + (`value (org-babel-octave-import-elisp-from-file tmp-file)) - (output - (progn - (setq results - (if matlabp - (cdr (reverse (delq "" (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))) - (cdr (member org-babel-octave-eoe-output - (reverse (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))))) - (mapconcat #'identity (reverse results) "\n")))))) + (`output + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-strip-quotes + (mapcar #'org-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-strip-quotes + (mapcar #'org-trim raw))))))) + (mapconcat #'identity (reverse results) "\n"))))) (defun org-babel-octave-import-elisp-from-file (file-name) "Import data from FILE-NAME. @@ -262,17 +259,6 @@ This removes initial blank and comment lines and then calls (delete-region beg end))) (org-babel-import-elisp-from-file temp-file '(16)))) -(defun org-babel-octave-read-string (string) - "Strip \\\"s from around octave string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(defun org-babel-octave-graphical-output-file (params) - "Name of file to which maxima should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - (provide 'ob-octave) diff --git a/lisp/org/ob-org.el b/lisp/org/ob-org.el index 3535891613..5683b96fca 100644 --- a/lisp/org/ob-org.el +++ b/lisp/org/ob-org.el @@ -1,4 +1,4 @@ -;;; ob-org.el --- org-babel functions for org code block evaluation +;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -41,7 +41,7 @@ "Default header inserted during export of org blocks.") (defun org-babel-expand-body:org (body params) - (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) + (dolist (var (org-babel--get-vars params)) (setq body (replace-regexp-in-string (regexp-quote (format "$%s" (car var))) (format "%s" (cdr var)) @@ -51,7 +51,7 @@ (defun org-babel-execute:org (body params) "Execute a block of Org code with. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) (body (org-babel-expand-body:org (replace-regexp-in-string "^," "" body) params))) (cond @@ -61,7 +61,7 @@ This function is called by `org-babel-execute-src-block'." ((member "ascii" result-params) (org-export-string-as body 'ascii t)) (t body)))) -(defun org-babel-prep-session:org (session params) +(defun org-babel-prep-session:org (_session _params) "Return an error because org does not support sessions." (error "Org does not support sessions")) diff --git a/lisp/org/ob-perl.el b/lisp/org/ob-perl.el index 4e4407d176..62df8c555f 100644 --- a/lisp/org/ob-perl.el +++ b/lisp/org/ob-perl.el @@ -1,4 +1,4 @@ -;;; ob-perl.el --- org-babel functions for perl evaluation +;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -28,7 +28,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) @@ -41,20 +40,20 @@ (defun org-babel-execute:perl (body params) "Execute a block of Perl code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((session (cdr (assoc :session params))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((session (cdr (assq :session params))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:perl params))) (session (org-babel-perl-initiate-session session))) (org-babel-reassemble-table (org-babel-perl-evaluate session full-body result-type result-params) (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) -(defun org-babel-prep-session:perl (session params) +(defun org-babel-prep-session:perl (_session _params) "Prepare SESSION according to the header arguments in PARAMS." (error "Sessions are not supported for Perl")) @@ -63,7 +62,7 @@ This function is called by `org-babel-execute-src-block'." (mapcar (lambda (pair) (org-babel-perl--var-to-perl (cdr pair) (car pair))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) ;; helper functions @@ -76,7 +75,7 @@ This function is called by `org-babel-execute-src-block'." The elisp value, VAR, is converted to a string of perl source code specifying a var of the same value." (if varn - (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) + (let ((org-babel-perl--lvl 0) (lvar (listp var))) (concat "my $" (symbol-name varn) "=" (when lvar "\n") (org-babel-perl--var-to-perl var) ";\n")) @@ -92,7 +91,7 @@ specifying a var of the same value." (defvar org-babel-perl-buffers '(:default . nil)) -(defun org-babel-perl-initiate-session (&optional session params) +(defun org-babel-perl-initiate-session (&optional _session _params) "Return nil because sessions are not supported by perl." nil) @@ -127,8 +126,8 @@ specifying a var of the same value." (defun org-babel-perl-evaluate (session ibody &optional result-type result-params) "Pass BODY to the Perl process in SESSION. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then +If RESULT-TYPE equals `output' then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (when session (error "Sessions are not supported for Perl")) (let* ((body (concat org-babel-perl-preface ibody)) @@ -136,13 +135,13 @@ return the value of the last statement in BODY, as elisp." (tmp-babel-file (org-babel-process-file-name tmp-file 'noquote))) (let ((results - (case result-type - (output + (pcase result-type + (`output (with-temp-file tmp-file (insert (org-babel-eval org-babel-perl-command body)) (buffer-string))) - (value + (`value (org-babel-eval org-babel-perl-command (format org-babel-perl-wrapper-method body tmp-babel-file)))))) diff --git a/lisp/org/ob-picolisp.el b/lisp/org/ob-picolisp.el index a87c15ea97..f577381557 100644 --- a/lisp/org/ob-picolisp.el +++ b/lisp/org/ob-picolisp.el @@ -1,4 +1,4 @@ -;;; ob-picolisp.el --- org-babel functions for picolisp evaluation +;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -55,7 +55,6 @@ ;;; Code: (require 'ob) (require 'comint) -(eval-when-compile (require 'cl)) (declare-function run-picolisp "ext:inferior-picolisp" (cmd)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded @@ -80,9 +79,9 @@ (defun org-babel-expand-body:picolisp (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil)) + (let ((vars (org-babel--get-vars params)) + (print-level nil) + (print-length nil)) (if (> (length vars) 0) (concat "(prog (let (" (mapconcat @@ -100,12 +99,11 @@ (message "executing Picolisp source code block") (let* ( ;; Name of the session or "none". - (session-name (cdr (assoc :session params))) + (session-name (cdr (assq :session params))) ;; Set the session if the session variable is non-nil. (session (org-babel-picolisp-initiate-session session-name)) ;; Either OUTPUT or VALUE which should behave as described above. - (result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) + (result-params (cdr (assq :result-params params))) ;; Expand the body with `org-babel-expand-body:picolisp'. (full-body (org-babel-expand-body:picolisp body params)) ;; Wrap body appropriately for the type of evaluation and results. diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el index e05565e32c..e90021a52a 100644 --- a/lisp/org/ob-plantuml.el +++ b/lisp/org/ob-plantuml.el @@ -1,4 +1,4 @@ -;;; ob-plantuml.el --- org-babel functions for plantuml evaluation +;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -49,21 +49,36 @@ (defun org-babel-execute:plantuml (body params) "Execute a block of plantuml code with org-babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (or (cdr (assoc :file params)) + (let* ((out-file (or (cdr (assq :file params)) (error "PlantUML requires a \":file\" header argument"))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) - (java (or (cdr (assoc :java params)) "")) + (java (or (cdr (assq :java params)) "")) (cmd (if (string= "" org-plantuml-jar-path) (error "`org-plantuml-jar-path' is not set") (concat "java " java " -jar " (shell-quote-argument (expand-file-name org-plantuml-jar-path)) + (if (string= (file-name-extension out-file) "png") + " -tpng" "") (if (string= (file-name-extension out-file) "svg") " -tsvg" "") (if (string= (file-name-extension out-file) "eps") " -teps" "") + (if (string= (file-name-extension out-file) "pdf") + " -tpdf" "") + (if (string= (file-name-extension out-file) "vdx") + " -tvdx" "") + (if (string= (file-name-extension out-file) "xmi") + " -txmi" "") + (if (string= (file-name-extension out-file) "scxml") + " -tscxml" "") + (if (string= (file-name-extension out-file) "html") + " -thtml" "") + (if (string= (file-name-extension out-file) "txt") + " -ttxt" "") + (if (string= (file-name-extension out-file) "utxt") + " -utxt" "") " -p " cmdline " < " (org-babel-process-file-name in-file) " > " @@ -74,7 +89,7 @@ This function is called by `org-babel-execute-src-block'." (message "%s" cmd) (org-babel-eval cmd "") nil)) ;; signal that output has already been written to file -(defun org-babel-prep-session:plantuml (session params) +(defun org-babel-prep-session:plantuml (_session _params) "Return an error because plantuml does not support sessions." (error "Plantuml does not support sessions")) diff --git a/lisp/org/ob-processing.el b/lisp/org/ob-processing.el new file mode 100644 index 0000000000..a18a53cbf1 --- /dev/null +++ b/lisp/org/ob-processing.el @@ -0,0 +1,195 @@ +;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. + +;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte) +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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: + +;; Babel support for evaluating processing source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in processing +;; +;; 2) results can only be exported as html; in this case, the +;; processing code is embedded via a file into a javascript block +;; using the processing.js module; the script then draws the +;; resulting output when the web page is viewed in a browser; note +;; that the user is responsible for making sure that processing.js +;; is available on the website +;; +;; 3) it is possible to interactively view the sketch of the +;; Processing code block via Processing 2.0 Emacs mode, using +;; `org-babel-processing-view-sketch'. You can bind this command +;; to, e.g., C-c C-v C-k with +;; +;; (define-key org-babel-map (kbd "C-k") 'org-babel-processing-view-sketch) + + +;;; Requirements: + +;; - processing2-emacs mode :: https://github.com/ptrv/processing2-emacs +;; - Processing.js module :: http://processingjs.org/ + +;;; Code: +(require 'ob) +(require 'sha1) + +(declare-function processing-sketch-run "ext:processing-mode" ()) + +(defvar org-babel-temporary-directory) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("processing" . "pde")) + +;; Default header tags depend on whether exporting html or not; if not +;; exporting html, then no results are produced; otherwise results are +;; HTML. +(defvar org-babel-default-header-args:processing + '((:results . "html") (:exports . "results")) + "Default arguments when evaluating a Processing source block.") + +(defvar org-babel-processing-processing-js-filename "processing.js" + "Filename of the processing.js file.") + +(defun org-babel-processing-view-sketch () + "Show the sketch of the Processing block under point in an external viewer." + (interactive) + (require 'processing-mode) + (let ((info (org-babel-get-src-block-info))) + (if (string= (nth 0 info) "processing") + (let* ((body (nth 1 info)) + (params (org-babel-process-params (nth 2 info))) + (sketch-code + (org-babel-expand-body:generic + body + params + (org-babel-variable-assignments:processing params)))) + ;; Note: sketch filename can not contain a hyphen, since it + ;; has to be a valid java class name; for this reason + ;; make-temp-file is repeated until no hyphen is in the + ;; name; also sketch dir name must be the same as the + ;; basename of the sketch file. + (let* ((temporary-file-directory org-babel-temporary-directory) + (sketch-dir + (let (sketch-dir-candidate) + (while + (progn + (setq sketch-dir-candidate + (make-temp-file "processing" t)) + (when (string-match-p + "-" + (file-name-nondirectory sketch-dir-candidate)) + (delete-directory sketch-dir-candidate) + t))) + sketch-dir-candidate)) + (sketch-filename + (concat sketch-dir + "/" + (file-name-nondirectory sketch-dir) + ".pde"))) + (with-temp-file sketch-filename (insert sketch-code)) + (find-file sketch-filename) + (processing-sketch-run) + (kill-buffer))) + (message "Not inside a Processing source block.")))) + +(defun org-babel-execute:processing (body params) + "Execute a block of Processing code. +This function is called by `org-babel-execute-src-block'." + (let ((sketch-code + (org-babel-expand-body:generic + body + params + (org-babel-variable-assignments:processing params)))) + ;; Results are HTML. + (let ((sketch-canvas-id (concat "ob-" (sha1 sketch-code)))) + (concat "\n ")))) + +(defun org-babel-prep-session:processing (_session _params) + "Return an error if the :session header argument is set. +Processing does not support sessions" + (error "Processing does not support sessions")) + +(defun org-babel-variable-assignments:processing (params) + "Return list of processing statements assigning the block's variables." + (mapcar #'org-babel-processing-var-to-processing + (org-babel--get-vars params))) + +(defun org-babel-processing-var-to-processing (pair) + "Convert an elisp value into a Processing variable. +The elisp value PAIR is converted into Processing code specifying +a variable of the same value." + (let ((var (car pair)) + (val (let ((v (cdr pair))) + (if (symbolp v) (symbol-name v) v)))) + (cond + ((integerp val) + (format "int %S=%S;" var val)) + ((floatp val) + (format "float %S=%S;" var val)) + ((stringp val) + (format "String %S=\"%s\";" var val)) + ((and (listp val) (not (listp (car val)))) + (let* ((type (org-babel-processing-define-type val)) + (fmt (if (eq 'String type) "\"%s\"" "%s")) + (vect (mapconcat (lambda (e) (format fmt e)) val ", "))) + (format "%s[] %S={%s};" type var vect))) + ((listp val) + (let* ((type (org-babel-processing-define-type val)) + (fmt (if (eq 'String type) "\"%s\"" "%s")) + (array (mapconcat (lambda (row) + (concat "{" + (mapconcat (lambda (e) (format fmt e)) + row ", ") + "}")) + val ","))) + (format "%S[][] %S={%s};" type var array)))))) + +(defun org-babel-processing-define-type (data) + "Determine type of DATA. + +DATA is a list. Return type as a symbol. + +The type is `String' if any element in DATA is a string. +Otherwise, it is either `float', if some elements are floats, or +`int'." + (letrec ((type 'int) + (find-type + (lambda (row) + (dolist (e row type) + (cond ((listp e) (setq type (funcall find-type e))) + ((stringp e) (throw 'exit 'String)) + ((floatp e) (setq type 'float))))))) + (catch 'exit (funcall find-type data)))) + +(provide 'ob-processing) + +;;; ob-processing.el ends here diff --git a/lisp/org/ob-python.el b/lisp/org/ob-python.el index dfad47bf9e..302f8bd451 100644 --- a/lisp/org/ob-python.el +++ b/lisp/org/ob-python.el @@ -1,4 +1,4 @@ -;;; ob-python.el --- org-babel functions for python evaluation +;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -28,9 +28,9 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function org-remove-indentation "org" ) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function py-shell "ext:python-mode" (&optional argprompt)) (declare-function py-toggle-shells "ext:python-mode" (arg)) (declare-function run-python "ext:python" (&optional cmd dedicated show)) @@ -48,9 +48,9 @@ :type 'string) (defcustom org-babel-python-mode - (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) + (if (featurep 'python-mode) 'python-mode 'python) "Preferred python mode for use in running python interactively. -This will typically be either 'python or 'python-mode." +This will typically be either `python' or `python-mode'." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") @@ -73,13 +73,16 @@ This will typically be either 'python or 'python-mode." (defun org-babel-execute:python (body params) "Execute a block of Python code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-python-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (let* ((org-babel-python-command + (or (cdr (assq :python params)) + org-babel-python-command)) + (session (org-babel-python-initiate-session + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (return-val (when (and (eq result-type 'value) (not session)) - (cdr (assoc :return params)))) - (preamble (cdr (assoc :preamble params))) + (cdr (assq :return params)))) + (preamble (cdr (assq :preamble params))) (full-body (org-babel-expand-body:generic (concat body (if return-val (format "\nreturn %s" return-val) "")) @@ -88,10 +91,10 @@ This function is called by `org-babel-execute-src-block'." session full-body result-type result-params preamble))) (org-babel-reassemble-table result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) (defun org-babel-prep-session:python (session params) "Prepare SESSION according to the header arguments in PARAMS. @@ -123,7 +126,7 @@ VARS contains resolved variable references" (format "%s=%s" (car pair) (org-babel-python-var-to-python (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-python-var-to-python (var) "Convert an elisp value to a python variable. @@ -131,7 +134,7 @@ Convert an elisp value, VAR, into a string of python source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") - (if (equal var 'hline) + (if (eq var 'hline) org-babel-python-hline-to (format (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") @@ -143,7 +146,7 @@ If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." (let ((res (org-babel-script-escape results))) (if (listp res) - (mapcar (lambda (el) (if (equal el 'None) + (mapcar (lambda (el) (if (eq el 'None) org-babel-python-None-to el)) res) res))) @@ -214,7 +217,7 @@ then create. Return the initialized session." (assq-delete-all session org-babel-python-buffers))) session))) -(defun org-babel-python-initiate-session (&optional session params) +(defun org-babel-python-initiate-session (&optional session _params) "Create a session named SESSION according to PARAMS." (unless (string= session "none") (org-babel-python-session-buffer @@ -222,13 +225,13 @@ then create. Return the initialized session." (defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" "A string to indicate that evaluation has completed.") -(defvar org-babel-python-wrapper-method +(defconst org-babel-python-wrapper-method " def main(): %s open('%s', 'w').write( str(main()) )") -(defvar org-babel-python-pp-wrapper-method +(defconst org-babel-python-pp-wrapper-method " import pprint def main(): @@ -246,42 +249,41 @@ open('%s', 'w').write( pprint.pformat(main()) )") body result-type result-params preamble))) (defun org-babel-python-evaluate-external-process - (body &optional result-type result-params preamble) + (body &optional result-type result-params preamble) "Evaluate BODY in external python process. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (let ((raw - (case result-type - (output (org-babel-eval org-babel-python-command - (concat (if preamble (concat preamble "\n")) - body))) - (value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval - org-babel-python-command - (concat - (if preamble (concat preamble "\n") "") - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - (org-babel-process-file-name tmp-file 'noquote)))) - (org-babel-eval-read-file tmp-file)))))) + (pcase result-type + (`output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n")) + body))) + (`value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval + org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string (org-remove-indentation (org-trim body)) + "[\r\n]") + "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + (org-babel-eval-read-file tmp-file)))))) (org-babel-result-cond result-params raw - (org-babel-python-table-or-string (org-babel-trim raw))))) + (org-babel-python-table-or-string (org-trim raw))))) (defun org-babel-python-evaluate-session (session body &optional result-type result-params) "Pass BODY to the Python process in SESSION. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) (dump-last-value @@ -302,10 +304,10 @@ last statement in BODY, as elisp." (split-string body "[\r\n]")) (funcall send-wait))) (results - (case result-type - (output + (pcase result-type + (`output (mapconcat - #'org-babel-trim + #'org-trim (butlast (org-babel-comint-with-output (session org-babel-python-eoe-indicator t body) @@ -314,7 +316,7 @@ last statement in BODY, as elisp." (insert org-babel-python-eoe-indicator) (funcall send-wait)) 2) "\n")) - (value + (`value (let ((tmp-file (org-babel-temp-file "python-"))) (org-babel-comint-with-output (session org-babel-python-eoe-indicator nil body) @@ -332,9 +334,10 @@ last statement in BODY, as elisp." (org-babel-python-table-or-string results))))) (defun org-babel-python-read-string (string) - "Strip 's from around Python string." - (if (string-match "^'\\([^\000]+\\)'$" string) - (match-string 1 string) + "Strip \\='s from around Python string." + (if (and (string-prefix-p "'" string) + (string-suffix-p "'" string)) + (substring string 1 -1) string)) (provide 'ob-python) diff --git a/lisp/org/ob-ref.el b/lisp/org/ob-ref.el index 1d26403035..f8b9ea4509 100644 --- a/lisp/org/ob-ref.el +++ b/lisp/org/ob-ref.el @@ -1,4 +1,4 @@ -;;; ob-ref.el --- org-babel functions for referencing external data +;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -50,19 +50,20 @@ ;;; Code: (require 'ob-core) -(eval-when-compile - (require 'cl)) - -(declare-function org-remove-if-not "org" (predicate seq)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-count "org" (CL-ITEM CL-SEQ)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) +(require 'cl-lib) + +(declare-function org-babel-lob-get-info "ob-lob" (&optional datum)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-end-of-meta-data "org" (&optional full)) +(declare-function org-find-property "org" (property &optional value)) (declare-function org-id-find-id-file "org-id" (id)) +(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-context "org" (&optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-trim "org" (s &optional keep-lead)) (defvar org-babel-ref-split-regexp "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") @@ -90,35 +91,31 @@ the variable." org-babel-current-src-block-location))) (org-babel-read ref)))) (if (equal out ref) - (if (string-match "^\".*\"$" ref) + (if (and (string-prefix-p "\"" ref) + (string-suffix-p "\"" ref)) (read ref) (org-babel-ref-resolve ref)) out)))))) (defun org-babel-ref-goto-headline-id (id) - (goto-char (point-min)) - (let ((rx (regexp-quote id))) - (or (re-search-forward - (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t) - (let* ((file (org-id-find-id-file id)) - (m (when file (org-id-find-id-in-file id file 'marker)))) - (when (and file m) - (message "file:%S" file) - (org-pop-to-buffer-same-window (marker-buffer m)) - (goto-char m) - (move-marker m nil) - (org-show-context) - t))))) + (or (let ((h (org-find-property "CUSTOM_ID" id))) + (when h (goto-char h))) + (let* ((file (org-id-find-id-file id)) + (m (when file (org-id-find-id-in-file id file 'marker)))) + (when (and file m) + (message "file:%S" file) + (pop-to-buffer-same-window (marker-buffer m)) + (goto-char m) + (move-marker m nil) + (org-show-context) + t)))) (defun org-babel-ref-headline-body () (save-restriction (org-narrow-to-subtree) (buffer-substring (save-excursion (goto-char (point-min)) - (forward-line 1) - (when (looking-at "[ \t]*:PROPERTIES:") - (re-search-forward ":END:" nil) - (forward-char)) + (org-end-of-meta-data) (point)) (point-max)))) @@ -126,89 +123,82 @@ the variable." (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." (save-window-excursion - (save-excursion - (let ((case-fold-search t) - type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col id) - ;; if ref is indexed grab the indices -- beware nested indices - (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) - (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?\( str) (org-count ?\) str)))) - (setq index (match-string 1 ref)) - (setq ref (substring ref 0 (match-beginning 0)))) - ;; assign any arguments to pass to source block - (when (string-match - "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref) - (setq new-refere (match-string 1 ref)) - (setq new-header-args (match-string 3 ref)) - (setq new-referent (match-string 5 ref)) - (when (> (length new-refere) 0) - (when (> (length new-referent) 0) - (setq args (mapcar (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args new-referent)))) - (when (> (length new-header-args) 0) - (setq args (append (org-babel-parse-header-arguments - new-header-args) args))) - (setq ref new-refere))) - (when (string-match "^\\(.+\\):\\(.+\\)$" ref) - (setq split-file (match-string 1 ref)) - (setq split-ref (match-string 2 ref)) - (find-file split-file) (setq ref split-ref)) - (save-restriction - (widen) - (goto-char (point-min)) - (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) - (res-rx (org-babel-named-data-regexp-for-name ref))) - ;; goto ref in the current buffer - (or - ;; check for code blocks - (re-search-forward src-rx nil t) - ;; check for named data - (re-search-forward res-rx nil t) - ;; check for local or global headlines by id - (setq id (org-babel-ref-goto-headline-id ref)) - ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) - org-babel-library-of-babel))))) - (unless (or lob-info id) (goto-char (match-beginning 0))) - ;; ;; TODO: allow searching for names in other buffers - ;; (setq id-loc (org-id-find ref 'marker) - ;; buffer (marker-buffer id-loc) - ;; loc (marker-position id-loc)) - ;; (move-marker id-loc nil) - (error "Reference `%s' not found in this buffer" ref)) - (cond - (lob-info (setq type 'lob)) - (id (setq type 'id)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (or (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (setq type 'source-block)) - (t (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "Reference not found"))))) - (let ((params (append args '((:results . "silent"))))) - (setq result - (case type - (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) - (source-block (org-babel-execute-src-block - nil nil (if org-babel-update-intermediate - nil params))) - (lob (org-babel-execute-src-block - nil lob-info params)) - (id (org-babel-ref-headline-body))))) - (if (symbolp result) - (format "%S" result) - (if (and index (listp result)) - (org-babel-ref-index-list index result) - result))))))) + (with-current-buffer (or org-babel-exp-reference-buffer (current-buffer)) + (save-excursion + (let ((case-fold-search t) + args new-refere new-header-args new-referent split-file split-ref + index) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (cl-count ?\( str) (cl-count ?\) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match + "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\(.*\\))$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-header-args (match-string 3 ref)) + (setq new-referent (match-string 5 ref)) + (when (> (length new-refere) 0) + (when (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + (when (> (length new-header-args) 0) + (setq args (append (org-babel-parse-header-arguments + new-header-args) args))) + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) + (setq ref split-ref)) + (org-with-wide-buffer + (goto-char (point-min)) + (let* ((params (append args '((:results . "silent")))) + (regexp (org-babel-named-data-regexp-for-name ref)) + (result + (catch :found + ;; Check for code blocks or named data. + (while (re-search-forward regexp nil t) + ;; Ignore COMMENTed headings and orphaned + ;; affiliated keywords. + (unless (org-in-commented-heading-p) + (let ((e (org-element-at-point))) + (when (equal (org-element-property :name e) ref) + (goto-char + (org-element-property :post-affiliated e)) + (pcase (org-element-type e) + (`babel-call + (throw :found + (org-babel-execute-src-block + nil (org-babel-lob-get-info e) params))) + (`src-block + (throw :found + (org-babel-execute-src-block + nil nil + (and + (not org-babel-update-intermediate) + params)))) + ((and (let v (org-babel-read-element e)) + (guard v)) + (throw :found v)) + (_ (error "Reference not found"))))))) + ;; Check for local or global headlines by ID. + (when (org-babel-ref-goto-headline-id ref) + (throw :found (org-babel-ref-headline-body))) + ;; Check the Library of Babel. + (let ((info (cdr (assq (intern ref) + org-babel-library-of-babel)))) + (when info + (throw :found + (org-babel-execute-src-block nil info params)))) + (error "Reference `%s' not found in this buffer" ref)))) + (cond + ((symbolp result) (format "%S" result)) + ((and index (listp result)) + (org-babel-ref-index-list index result)) + (t result))))))))) (defun org-babel-ref-index-list (index lis) "Return the subset of LIS indexed by INDEX. @@ -251,21 +241,9 @@ to \"0:-1\"." (defun org-babel-ref-split-args (arg-string) "Split ARG-STRING into top-level arguments of balanced parenthesis." - (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44))) + (mapcar #'org-trim (org-babel-balanced-split arg-string 44))) -(defvar org-bracket-link-regexp) -(defun org-babel-ref-at-ref-p () - "Return the type of reference located at point. -Return nil if none of the supported reference types are found. -Supported reference types are tables and source blocks." - (cond ((org-at-table-p) 'table) - ((org-at-item-p) 'list) - ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) - ((looking-at org-bracket-link-regexp) 'file) - ((looking-at org-babel-result-regexp) 'results-line))) (provide 'ob-ref) - - ;;; ob-ref.el ends here diff --git a/lisp/org/ob-ruby.el b/lisp/org/ob-ruby.el index 88a9987696..d055783514 100644 --- a/lisp/org/ob-ruby.el +++ b/lisp/org/ob-ruby.el @@ -1,4 +1,4 @@ -;;; ob-ruby.el --- org-babel functions for ruby evaluation +;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -37,11 +37,14 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function run-ruby "ext:inf-ruby" (&optional command name)) (declare-function xmp "ext:rcodetools" (&optional option)) +(defvar inf-ruby-default-implementation) +(defvar inf-ruby-implementations) + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) @@ -68,16 +71,16 @@ "Execute a block of Ruby code with Babel. This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-ruby-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) + (cdr (assq :session params)))) + (result-params (cdr (assq :result-params params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:ruby params))) (result (if (member "xmp" result-params) (with-temp-buffer (require 'rcodetools) (insert full-body) - (xmp (cdr (assoc :xmp-option params))) + (xmp (cdr (assq :xmp-option params))) (buffer-string)) (org-babel-ruby-evaluate session full-body result-type result-params)))) @@ -85,10 +88,10 @@ This function is called by `org-babel-execute-src-block'." (org-babel-result-cond result-params result (org-babel-ruby-table-or-string result)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))) (defun org-babel-prep-session:ruby (session params) "Prepare SESSION according to the header arguments specified in PARAMS." @@ -121,7 +124,7 @@ This function is called by `org-babel-execute-src-block'." (format "%s=%s" (car pair) (org-babel-ruby-var-to-ruby (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) + (org-babel--get-vars params))) (defun org-babel-ruby-var-to-ruby (var) "Convert VAR into a ruby variable. @@ -129,7 +132,7 @@ Convert an elisp value into a string of ruby source code specifying a variable of the same value." (if (listp var) (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") - (if (equal var 'hline) + (if (eq var 'hline) org-babel-ruby-hline-to (format "%S" var)))) @@ -139,23 +142,27 @@ If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." (let ((res (org-babel-script-escape results))) (if (listp res) - (mapcar (lambda (el) (if (equal el 'nil) - org-babel-ruby-nil-to el)) + (mapcar (lambda (el) (if (not el) + org-babel-ruby-nil-to el)) res) res))) -(defun org-babel-ruby-initiate-session (&optional session params) +(defun org-babel-ruby-initiate-session (&optional session _params) "Initiate a ruby session. If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." (unless (string= session "none") (require 'inf-ruby) - (let ((session-buffer (save-window-excursion - (run-ruby nil session) (current-buffer)))) + (let* ((cmd (cdr (assoc inf-ruby-default-implementation + inf-ruby-implementations))) + (buffer (get-buffer (format "*%s*" session))) + (session-buffer (or buffer (save-window-excursion + (run-ruby cmd session) + (current-buffer))))) (if (org-babel-comint-buffer-livep session-buffer) (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-ruby-initiate-session session))))) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) (defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" "String to indicate that evaluation has completed.") @@ -185,46 +192,53 @@ end ") (defun org-babel-ruby-evaluate - (buffer body &optional result-type result-params) + (buffer body &optional result-type result-params) "Pass BODY to the Ruby process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then +If RESULT-TYPE equals `output' then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (if (not buffer) ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-ruby-command body)) - (value (let ((tmp-file (org-babel-temp-file "ruby-"))) - (org-babel-eval - org-babel-ruby-command - (format (if (member "pp" result-params) - org-babel-ruby-pp-wrapper-method - org-babel-ruby-wrapper-method) - body (org-babel-process-file-name tmp-file 'noquote))) - (let ((raw (org-babel-eval-read-file tmp-file))) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-ruby-table-or-string raw)))))) + (pcase result-type + (`output (org-babel-eval org-babel-ruby-command body)) + (`value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (org-babel-eval + org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-eval-read-file tmp-file)))) ;; comint session evaluation - (case result-type - (output - (mapconcat - #'identity - (butlast - (split-string - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (buffer org-babel-ruby-eoe-indicator t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (list body org-babel-ruby-eoe-indicator)) - (comint-send-input nil t)) 2) - "\n") "[\r\n]")) "\n")) - (value + (pcase result-type + (`output + (let ((eoe-string (format "puts \"%s\"" org-babel-ruby-eoe-indicator))) + ;; Force the session to be ready before the actual session + ;; code is run. There is some problem in comint that will + ;; sometimes show the prompt after the the input has already + ;; been inserted and that throws off the extraction of the + ;; result for Babel. + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t eoe-string) + (insert eoe-string) (comint-send-input nil t)) + ;; Now we can start the evaluation. + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-trim + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list "conf.echo=false;_org_prompt_mode=conf.prompt_mode;conf.prompt_mode=:NULL" + body + "conf.prompt_mode=_org_prompt_mode;conf.echo=true" + eoe-string))) + "\n") "[\r\n]") 4) "\n"))) + (`value (let* ((tmp-file (org-babel-temp-file "ruby-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) @@ -247,12 +261,6 @@ return the value of the last statement in BODY, as elisp." (comint-send-input nil t)) (org-babel-eval-read-file tmp-file)))))) -(defun org-babel-ruby-read-string (string) - "Strip \\\"s from around a ruby string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - (provide 'ob-ruby) diff --git a/lisp/org/ob-sass.el b/lisp/org/ob-sass.el index 847c144e80..a9a2a9f030 100644 --- a/lisp/org/ob-sass.el +++ b/lisp/org/ob-sass.el @@ -1,4 +1,4 @@ -;;; ob-sass.el --- org-babel functions for the sass css generation language +;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -45,10 +45,9 @@ (defun org-babel-execute:sass (body params) "Execute a block of Sass code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (file (cdr (assoc :file params))) + (let* ((file (cdr (assq :file params))) (out-file (or file (org-babel-temp-file "sass-out-"))) - (cmdline (cdr (assoc :cmdline params))) + (cmdline (cdr (assq :cmdline params))) (in-file (org-babel-temp-file "sass-in-")) (cmd (concat "sass " (or cmdline "") " " (org-babel-process-file-name in-file) @@ -60,7 +59,7 @@ This function is called by `org-babel-execute-src-block'." nil ;; signal that output has already been written to file (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) -(defun org-babel-prep-session:sass (session params) +(defun org-babel-prep-session:sass (_session _params) "Raise an error because sass does not support sessions." (error "Sass does not support sessions")) diff --git a/lisp/org/ob-scala.el b/lisp/org/ob-scala.el index 9bddeed6e6..7d5f299ec6 100644 --- a/lisp/org/ob-scala.el +++ b/lisp/org/ob-scala.el @@ -1,4 +1,4 @@ -;;; ob-scala.el --- org-babel functions for Scala evaluation +;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -31,7 +31,6 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (defvar org-babel-tangle-lang-exts) ;; Autoloaded (add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) @@ -45,9 +44,8 @@ called by `org-babel-execute-src-block'" (message "executing Scala source code block") (let* ((processed-params (org-babel-process-params params)) (session (org-babel-scala-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) + (result-type (cdr (assq :result-type params))) (full-body (org-babel-expand-body:generic body params)) (result (org-babel-scala-evaluate @@ -56,17 +54,9 @@ called by `org-babel-execute-src-block'" (org-babel-reassemble-table result (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - - -(defun org-babel-scala-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) (defvar org-babel-scala-wrapper-method @@ -84,19 +74,19 @@ print(str_result) (defun org-babel-scala-evaluate - (session body &optional result-type result-params) + (session body &optional result-type result-params) "Evaluate BODY in external Scala process. -If RESULT-TYPE equals 'output then return standard output as a string. -If RESULT-TYPE equals 'value then return the value of the last statement +If RESULT-TYPE equals `output' then return standard output as a string. +If RESULT-TYPE equals `value' then return the value of the last statement in BODY as elisp." (when session (error "Sessions are not (yet) supported for Scala")) - (case result-type - (output + (pcase result-type + (`output (let ((src-file (org-babel-temp-file "scala-"))) - (progn (with-temp-file src-file (insert body)) - (org-babel-eval - (concat org-babel-scala-command " " src-file) "")))) - (value + (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-scala-command " " src-file) ""))) + (`value (let* ((src-file (org-babel-temp-file "scala-")) (wrapper (format org-babel-scala-wrapper-method body))) (with-temp-file src-file (insert wrapper)) @@ -104,14 +94,14 @@ in BODY as elisp." (concat org-babel-scala-command " " src-file) ""))) (org-babel-result-cond result-params raw - (org-babel-scala-table-or-string raw))))))) + (org-babel-script-escape raw))))))) -(defun org-babel-prep-session:scala (session params) +(defun org-babel-prep-session:scala (_session _params) "Prepare SESSION according to the header arguments specified in PARAMS." (error "Sessions are not (yet) supported for Scala")) -(defun org-babel-scala-initiate-session (&optional session) +(defun org-babel-scala-initiate-session (&optional _session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session. Sessions are not supported in Scala." diff --git a/lisp/org/ob-scheme.el b/lisp/org/ob-scheme.el index ae77c7c3ed..cd8c3860e2 100644 --- a/lisp/org/ob-scheme.el +++ b/lisp/org/ob-scheme.el @@ -1,4 +1,4 @@ -;;; ob-scheme.el --- org-babel functions for Scheme +;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -56,7 +56,7 @@ (defun org-babel-expand-body:scheme (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if (> (length vars) 0) (concat "(let (" (mapconcat @@ -119,6 +119,22 @@ org-babel-scheme-execute-with-geiser will use a temporary session." (name)))) result)) +(defmacro org-babel-scheme-capture-current-message (&rest body) + "Capture current message in both interactive and noninteractive mode" + `(if noninteractive + (let ((original-message (symbol-function 'message)) + (current-message nil)) + (unwind-protect + (progn + (defun message (&rest args) + (setq current-message (apply original-message args))) + ,@body + current-message) + (fset 'message original-message))) + (progn + ,@body + (current-message)))) + (defun org-babel-scheme-execute-with-geiser (code output impl repl) "Execute code in specified REPL. If the REPL doesn't exist, create it using the given scheme implementation. @@ -143,10 +159,11 @@ is true; otherwise returns the last value." (current-buffer))))) (setq geiser-repl--repl repl-buffer) (setq geiser-impl--implementation nil) - (geiser-eval-region (point-min) (point-max)) + (setq result (org-babel-scheme-capture-current-message + (geiser-eval-region (point-min) (point-max)))) (setq result - (if (equal (substring (current-message) 0 3) "=> ") - (replace-regexp-in-string "^=> " "" (current-message)) + (if (and (stringp result) (equal (substring result 0 3) "=> ")) + (replace-regexp-in-string "^=> " "" result) "\"An error occurred.\"")) (when (not repl) (save-current-buffer (set-buffer repl-buffer) @@ -156,7 +173,7 @@ is true; otherwise returns the last value." (setq result (if (or (string= result "#") (string= result "#")) nil - (read result))))) + result)))) result)) (defun org-babel-execute:scheme (body params) @@ -168,23 +185,23 @@ This function is called by `org-babel-execute-src-block'" (buffer-name source-buffer)))) (save-excursion (org-babel-reassemble-table - (let* ((result-type (cdr (assoc :result-type params))) - (impl (or (when (cdr (assoc :scheme params)) - (intern (cdr (assoc :scheme params)))) + (let* ((result-type (cdr (assq :result-type params))) + (impl (or (when (cdr (assq :scheme params)) + (intern (cdr (assq :scheme params)))) geiser-default-implementation (car geiser-active-implementations))) (session (org-babel-scheme-make-session-name - source-buffer-name (cdr (assoc :session params)) impl)) + source-buffer-name (cdr (assq :session params)) impl)) (full-body (org-babel-expand-body:scheme body params))) (org-babel-scheme-execute-with-geiser full-body ; code (string= result-type "output") ; output? impl ; implementation (and (not (string= session "none")) session))) ; session - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params))))))) (provide 'ob-scheme) diff --git a/lisp/org/ob-screen.el b/lisp/org/ob-screen.el index a15f7f7bd8..554f8c4385 100644 --- a/lisp/org/ob-screen.el +++ b/lisp/org/ob-screen.el @@ -1,4 +1,4 @@ -;;; ob-screen.el --- org-babel support for interactive terminal +;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -48,18 +48,17 @@ In case you want to use a different screen than one selected by your $PATH") \"default\" session is used when none is specified." (message "Sending source code block to interactive terminal session...") (save-window-excursion - (let* ((session (cdr (assoc :session params))) + (let* ((session (cdr (assq :session params))) (socket (org-babel-screen-session-socketname session))) (unless socket (org-babel-prep-session:screen session params)) (org-babel-screen-session-execute-string session (org-babel-expand-body:generic body params))))) -(defun org-babel-prep-session:screen (session params) +(defun org-babel-prep-session:screen (_session params) "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (cdr (assoc :session params))) - (socket (org-babel-screen-session-socketname session)) - (cmd (cdr (assoc :cmd params))) - (terminal (cdr (assoc :terminal params))) + (let* ((session (cdr (assq :session params))) + (cmd (cdr (assq :cmd params))) + (terminal (cdr (assq :terminal params))) (process-name (concat "org-babel: terminal (" session ")"))) (apply 'start-process process-name "*Messages*" terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location @@ -104,7 +103,7 @@ In case you want to use a different screen than one selected by your $PATH") sockets))))) (when match-socket (car (split-string match-socket))))) -(defun org-babel-screen-session-write-temp-file (session body) +(defun org-babel-screen-session-write-temp-file (_session body) "Save BODY in a temp file that is named after SESSION." (let ((tmpfile (org-babel-temp-file "screen-"))) (with-temp-file tmpfile @@ -119,11 +118,10 @@ In case you want to use a different screen than one selected by your $PATH") "Test if the default setup works. The terminal should shortly flicker." (interactive) - (let* ((session "org-babel-testing") - (random-string (format "%s" (random 99999))) + (let* ((random-string (format "%s" (random 99999))) (tmpfile (org-babel-temp-file "ob-screen-test-")) (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) - process tmp-string) + tmp-string) (org-babel-execute:screen body org-babel-default-header-args:screen) ;; XXX: need to find a better way to do the following (while (not (file-readable-p tmpfile)) diff --git a/lisp/org/ob-sed.el b/lisp/org/ob-sed.el new file mode 100644 index 0000000000..733c7e19d3 --- /dev/null +++ b/lisp/org/ob-sed.el @@ -0,0 +1,107 @@ +;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. + +;; Author: Bjarte Johansen +;; Keywords: literate programming, reproducible research +;; Version: 0.1.0 + +;; This file is part of GNU Emacs. + +;;; License: + +;; This program 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, or (at your option) +;; any later version. +;; +;; This program 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: + +;; Provides a way to evaluate sed scripts in Org mode. + +;;; Usage: + +;; Add to your Emacs config: + +;; (org-babel-do-load-languages +;; 'org-babel-load-languages +;; '((sed . t))) + +;; In addition to the normal header arguments, ob-sed also provides +;; :cmd-line and :in-file. :cmd-line allows one to pass other flags to +;; the sed command like the "--in-place" flag which makes sed edit the +;; file pass to it instead of outputting to standard out or to a +;; different file. :in-file is a header arguments that allows one to +;; tell Org Babel which file the sed script to act on. + +;;; Code: +(require 'ob) + +(defvar org-babel-sed-command "sed" + "Name of the sed executable command.") + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("sed" . "sed")) + +(defconst org-babel-header-args:sed + '((:cmd-line . :any) + (:in-file . :any)) + "Sed specific header arguments.") + +(defvar org-babel-default-header-args:sed '() + "Default arguments for evaluating a sed source block.") + +(defun org-babel-execute:sed (body params) + "Execute a block of sed code with Org Babel. +BODY is the source inside a sed source block and PARAMS is an +association list over the source block configurations. This +function is called by `org-babel-execute-src-block'." + (message "executing sed source code block") + (let* ((result-params (cdr (assq :result-params params))) + (cmd-line (cdr (assq :cmd-line params))) + (in-file (cdr (assq :in-file params))) + (code-file (let ((file (org-babel-temp-file "sed-"))) + (with-temp-file file + (insert body)) file)) + (stdin (let ((stdin (cdr (assq :stdin params)))) + (when stdin + (let ((tmp (org-babel-temp-file "sed-stdin-")) + (res (org-babel-ref-resolve stdin))) + (with-temp-file tmp + (insert res)) + tmp)))) + (cmd (mapconcat #'identity + (remq nil + (list org-babel-sed-command + (format "--file=\"%s\"" code-file) + cmd-line + in-file)) + " "))) + (org-babel-reassemble-table + (let ((results + (cond + (stdin (with-temp-buffer + (call-process-shell-command cmd stdin (current-buffer)) + (buffer-string))) + (t (org-babel-eval cmd ""))))) + (when results + (org-babel-result-cond result-params + results + (let ((tmp (org-babel-temp-file "sed-results-"))) + (with-temp-file tmp (insert results)) + (org-babel-import-elisp-from-file tmp))))) + (org-babel-pick-name + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) + (org-babel-pick-name + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) + +(provide 'ob-sed) +;;; ob-sed.el ends here diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el deleted file mode 100644 index 47dbab3f6d..0000000000 --- a/lisp/org/ob-sh.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; ob-sh.el --- org-babel functions for shell evaluation - -;; Copyright (C) 2009-2017 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.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: - -;; Org-Babel support for evaluating shell source code. - -;;; Code: -(require 'ob) -(require 'shell) -(eval-when-compile (require 'cl)) - -(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) -(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function orgtbl-to-generic "org-table" - (table params &optional backend)) - -(defvar org-babel-default-header-args:sh '()) - -(defvar org-babel-sh-command "sh" - "Command used to invoke a shell. -This will be passed to `shell-command-on-region'") - -(defcustom org-babel-sh-var-quote-fmt - "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" - "Format string used to escape variables when passed to shell scripts." - :group 'org-babel - :type 'string) - -(defun org-babel-execute:sh (body params) - "Execute a block of Shell commands with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-sh-initiate-session - (cdr (assoc :session params)))) - (stdin (let ((stdin (cdr (assoc :stdin params)))) - (when stdin (org-babel-sh-var-to-string - (org-babel-ref-resolve stdin))))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:sh params)))) - (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body params stdin) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - -(defun org-babel-prep-session:sh (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-sh-initiate-session session)) - (var-lines (org-babel-variable-assignments:sh params))) - (org-babel-comint-in-buffer session - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) - session)) - -(defun org-babel-load-session:sh (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:sh session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -;; helper functions - -(defun org-babel-variable-assignments:sh (params) - "Return list of shell statements assigning the block's variables." - (let ((sep (cdr (assoc :separator params)))) - (mapcar - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-sh-var-to-sh (cdr pair) sep))) - (mapcar #'cdr (org-babel-get-header params :var))))) - -(defun org-babel-sh-var-to-sh (var &optional sep) - "Convert an elisp value to a shell variable. -Convert an elisp var into a string of shell commands specifying a -var of the same value." - (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep))) - -(defun org-babel-sh-var-to-string (var &optional sep) - "Convert an elisp value to a string." - (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) - (cond - ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) - ((listp var) - (mapconcat echo-var var "\n")) - (t (funcall echo-var var))))) - -(defun org-babel-sh-table-or-results (results) - "Convert RESULTS to an appropriate elisp value. -If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - -(defun org-babel-sh-initiate-session (&optional session params) - "Initiate a session named SESSION according to PARAMS." - (when (and session (not (string= session "none"))) - (save-window-excursion - (or (org-babel-comint-buffer-livep session) - (progn - (shell session) - ;; Needed for Emacs 23 since the marker is initially - ;; undefined and the filter functions try to use it without - ;; checking. - (set-marker comint-last-output-start (point)) - (get-buffer (current-buffer))))))) - -(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" - "String to indicate that evaluation has completed.") -(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" - "String to indicate that evaluation has completed.") - -(defun org-babel-sh-evaluate (session body &optional params stdin) - "Pass BODY to the Shell process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY." - (let ((results - (cond - (stdin ; external shell script w/STDIN - (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (string= "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (with-temp-file stdin-file (insert stdin)) - (with-temp-buffer - (call-process-shell-command - (if shebang - script-file - (format "%s %s" org-babel-sh-command script-file)) - stdin-file - (current-buffer)) - (buffer-string)))) - (session ; session evaluation - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (mapc - (lambda (line) - (insert line) - (comint-send-input nil t) - (while (save-excursion - (goto-char comint-last-input-end) - (not (re-search-forward - comint-prompt-regexp nil t))) - (accept-process-output - (get-buffer-process (current-buffer))))) - (append - (split-string (org-babel-trim body) "\n") - (list org-babel-sh-eoe-indicator)))) - 2)) "\n")) - ('otherwise ; external shell script - (if (and (cdr (assoc :shebang params)) - (> (length (cdr (assoc :shebang params))) 0)) - (let ((script-file (org-babel-temp-file "sh-script-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (equal "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (org-babel-eval script-file "")) - (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) - (when results - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))))) - -(defun org-babel-sh-strip-weird-long-prompt (string) - "Remove prompt cruft from a string of shell output." - (while (string-match "^% +[\r\n$]+ *" string) - (setq string (substring string (match-end 0)))) - string) - -(provide 'ob-sh) - - - -;;; ob-sh.el ends here diff --git a/lisp/org/ob-shell.el b/lisp/org/ob-shell.el new file mode 100644 index 0000000000..3787c26a19 --- /dev/null +++ b/lisp/org/ob-shell.el @@ -0,0 +1,283 @@ +;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*- + +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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: + +;; Org-Babel support for evaluating shell source code. + +;;; Code: +(require 'ob) +(require 'shell) +(require 'cl-lib) + +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body) + t) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body) + t) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-default-header-args:shell '()) +(defvar org-babel-shell-names) + +(defun org-babel-shell-initialize () + "Define execution functions associated to shell names. +This function has to be called whenever `org-babel-shell-names' +is modified outside the Customize interface." + (interactive) + (dolist (name org-babel-shell-names) + (eval `(defun ,(intern (concat "org-babel-execute:" name)) + (body params) + ,(format "Execute a block of %s commands with Babel." name) + (let ((shell-file-name ,name)) + (org-babel-execute:shell body params)))) + (eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name)) + 'org-babel-variable-assignments:shell + ,(format "Return list of %s statements assigning to the block's \ +variables." + name))))) + +(defcustom org-babel-shell-names + '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh") + "List of names of shell supported by babel shell code blocks. +Call `org-babel-shell-initialize' when modifying this variable +outside the Customize interface." + :group 'org-babel + :type '(repeat (string :tag "Shell name: ")) + :set (lambda (symbol value) + (set-default symbol value) + (org-babel-shell-initialize))) + +(defun org-babel-execute:shell (body params) + "Execute a block of Shell commands with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-sh-initiate-session + (cdr (assq :session params)))) + (stdin (let ((stdin (cdr (assq :stdin params)))) + (when stdin (org-babel-sh-var-to-string + (org-babel-ref-resolve stdin))))) + (cmdline (cdr (assq :cmdline params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:shell params)))) + (org-babel-reassemble-table + (org-babel-sh-evaluate session full-body params stdin cmdline) + (org-babel-pick-name + (cdr (assq :colname-names params)) (cdr (assq :colnames params))) + (org-babel-pick-name + (cdr (assq :rowname-names params)) (cdr (assq :rownames params)))))) + +(defun org-babel-prep-session:shell (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-sh-initiate-session session)) + (var-lines (org-babel-variable-assignments:shell params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:shell (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:shell session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + + +;;; Helper functions +(defun org-babel--variable-assignments:sh-generic + (varname values &optional sep hline) + "Returns a list of statements declaring the values as a generic variable." + (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline))) + +(defun org-babel--variable-assignments:bash_array + (varname values &optional sep hline) + "Returns a list of statements declaring the values as a bash array." + (format "unset %s\ndeclare -a %s=( %s )" + varname varname + (mapconcat + (lambda (value) (org-babel-sh-var-to-sh value sep hline)) + values + " "))) + +(defun org-babel--variable-assignments:bash_assoc + (varname values &optional sep hline) + "Returns a list of statements declaring the values as bash associative array." + (format "unset %s\ndeclare -A %s\n%s" + varname varname + (mapconcat + (lambda (items) + (format "%s[%s]=%s" + varname + (org-babel-sh-var-to-sh (car items) sep hline) + (org-babel-sh-var-to-sh (cdr items) sep hline))) + values + "\n"))) + +(defun org-babel--variable-assignments:bash (varname values &optional sep hline) + "Represents the parameters as useful Bash shell variables." + (pcase values + (`((,_ ,_ . ,_) . ,_) ;two-dimensional array + (org-babel--variable-assignments:bash_assoc varname values sep hline)) + (`(,_ . ,_) ;simple list + (org-babel--variable-assignments:bash_array varname values sep hline)) + (_ ;scalar value + (org-babel--variable-assignments:sh-generic varname values sep hline)))) + +(defun org-babel-variable-assignments:shell (params) + "Return list of shell statements assigning the block's variables." + (let ((sep (cdr (assq :separator params))) + (hline (when (string= "yes" (cdr (assq :hlines params))) + (or (cdr (assq :hline-string params)) + "hline")))) + (mapcar + (lambda (pair) + (if (string-suffix-p "bash" shell-file-name) + (org-babel--variable-assignments:bash + (car pair) (cdr pair) sep hline) + (org-babel--variable-assignments:sh-generic + (car pair) (cdr pair) sep hline))) + (org-babel--get-vars params)))) + +(defun org-babel-sh-var-to-sh (var &optional sep hline) + "Convert an elisp value to a shell variable. +Convert an elisp var into a string of shell commands specifying a +var of the same value." + (concat "'" (replace-regexp-in-string + "'" "'\"'\"'" + (org-babel-sh-var-to-string var sep hline)) + "'")) + +(defun org-babel-sh-var-to-string (var &optional sep hline) + "Convert an elisp value to a string." + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) + (cond + ((and (listp var) (or (listp (car var)) (eq (car var) 'hline))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var + :hline hline))) + ((listp var) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) + +(defun org-babel-sh-initiate-session (&optional session _params) + "Initiate a session named SESSION according to PARAMS." + (when (and session (not (string= session "none"))) + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (progn + (shell session) + ;; Needed for Emacs 23 since the marker is initially + ;; undefined and the filter functions try to use it without + ;; checking. + (set-marker comint-last-output-start (point)) + (get-buffer (current-buffer))))))) + +(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" + "String to indicate that evaluation has completed.") +(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" + "String to indicate that evaluation has completed.") + +(defun org-babel-sh-evaluate (session body &optional params stdin cmdline) + "Pass BODY to the Shell process in BUFFER. +If RESULT-TYPE equals `output' then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals `value' then +return the value of the last statement in BODY." + (let ((results + (cond + ((or stdin cmdline) ; external shell script w/STDIN + (let ((script-file (org-babel-temp-file "sh-script-")) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assq :shebang params))) + (padline (not (string= "no" (cdr (assq :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (with-temp-file stdin-file (insert (or stdin ""))) + (with-temp-buffer + (call-process-shell-command + (concat (if shebang script-file + (format "%s %s" shell-file-name script-file)) + (and cmdline (concat " " cmdline))) + stdin-file + (current-buffer)) + (buffer-string)))) + (session ; session evaluation + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) + (comint-send-input nil t) + (while (save-excursion + (goto-char comint-last-input-end) + (not (re-search-forward + comint-prompt-regexp nil t))) + (accept-process-output + (get-buffer-process (current-buffer))))) + (append + (split-string (org-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n")) + ('otherwise ; external shell script + (if (and (cdr (assq :shebang params)) + (> (length (cdr (assq :shebang params))) 0)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assq :shebang params))) + (padline (not (equal "no" (cdr (assq :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval shell-file-name (org-trim body))))))) + (when results + (let ((result-params (cdr (assq :result-params params)))) + (org-babel-result-cond result-params + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))))))) + +(defun org-babel-sh-strip-weird-long-prompt (string) + "Remove prompt cruft from a string of shell output." + (while (string-match "^% +[\r\n$]+ *" string) + (setq string (substring string (match-end 0)))) + string) + +(provide 'ob-shell) + + + +;;; ob-shell.el ends here diff --git a/lisp/org/ob-shen.el b/lisp/org/ob-shen.el index d44a48a638..6bf36c6437 100644 --- a/lisp/org/ob-shen.el +++ b/lisp/org/ob-shen.el @@ -1,4 +1,4 @@ -;;; ob-shen.el --- org-babel functions for Shen +;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -43,7 +43,7 @@ (defun org-babel-expand-body:shen (body params) "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (let ((vars (org-babel--get-vars params))) (if (> (length vars) 0) (concat "(let " (mapconcat (lambda (var) @@ -63,14 +63,13 @@ "Execute a block of Shen code with org-babel. This function is called by `org-babel-execute-src-block'" (require 'inf-shen) - (let* ((result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) + (let* ((result-params (cdr (assq :result-params params))) (full-body (org-babel-expand-body:shen body params))) (let ((results (with-temp-buffer (insert full-body) (call-interactively #'shen-eval-defun)))) - (org-babel-result-cond result-params + (org-babel-result-cond result-params results (condition-case nil (org-babel-script-escape results) (error results)))))) diff --git a/lisp/org/ob-sql.el b/lisp/org/ob-sql.el index 17775829cb..06477d3846 100644 --- a/lisp/org/ob-sql.el +++ b/lisp/org/ob-sql.el @@ -1,4 +1,4 @@ -;;; ob-sql.el --- org-babel functions for sql evaluation +;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -36,6 +36,7 @@ ;; - engine ;; - cmdline ;; - dbhost +;; - dbport ;; - dbuser ;; - dbpassword ;; - database @@ -56,11 +57,11 @@ ;;; Code: (require 'ob) -(eval-when-compile (require 'cl)) (declare-function org-table-import "org-table" (file arg)) (declare-function orgtbl-to-csv "org-table" (table params)) (declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function cygwin-convert-file-name-to-windows "cygw32.c" (file &optional absolute-p)) (defvar org-babel-default-header-args:sql '()) @@ -68,6 +69,7 @@ '((engine . :any) (out-file . :any) (dbhost . :any) + (dbport . :any) (dbuser . :any) (dbpassword . :any) (database . :any)) @@ -76,98 +78,167 @@ (defun org-babel-expand-body:sql (body params) "Expand BODY according to the values of PARAMS." (org-babel-sql-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) + body (org-babel--get-vars params))) -(defun dbstring-mysql (host user password database) +(defun org-babel-sql-dbstring-mysql (host port user password database) "Make MySQL cmd line args for database connection. Pass nil to omit that arg." (combine-and-quote-strings - (remq nil + (delq nil (list (when host (concat "-h" host)) + (when port (format "-P%d" port)) (when user (concat "-u" user)) (when password (concat "-p" password)) (when database (concat "-D" database)))))) +(defun org-babel-sql-dbstring-postgresql (host port user database) + "Make PostgreSQL command line args for database connection. +Pass nil to omit that arg." + (combine-and-quote-strings + (delq nil + (list (when host (concat "-h" host)) + (when port (format "-p%d" port)) + (when user (concat "-U" user)) + (when database (concat "-d" database)))))) + +(defun org-babel-sql-dbstring-oracle (host port user password database) + "Make Oracle command line args for database connection." + (format "%s/%s@%s:%s/%s" user password host port database)) + +(defun org-babel-sql-dbstring-mssql (host user password database) + "Make sqlcmd commmand line args for database connection. +`sqlcmd' is the preferred command line tool to access Microsoft +SQL Server on Windows and Linux platform." + (mapconcat #'identity + (delq nil + (list (when host (format "-S \"%s\"" host)) + (when user (format "-U \"%s\"" user)) + (when password (format "-P \"%s\"" password)) + (when database (format "-d \"%s\"" database)))) + " ")) + +(defun org-babel-sql-convert-standard-filename (file) + "Convert FILE to OS standard file name. +If in Cygwin environment, uses Cygwin specific function to +convert the file name. In a Windows-NT environment, do nothing. +Otherwise, use Emacs' standard conversion function." + (cond ((fboundp 'cygwin-convert-file-name-to-windows) + (format "%S" (cygwin-convert-file-name-to-windows file))) + ((string= "windows-nt" system-type) file) + (t (format "%S" (convert-standard-filename file))))) + (defun org-babel-execute:sql (body params) "Execute a block of Sql code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (cmdline (cdr (assoc :cmdline params))) - (dbhost (cdr (assoc :dbhost params))) - (dbuser (cdr (assoc :dbuser params))) - (dbpassword (cdr (assoc :dbpassword params))) - (database (cdr (assoc :database params))) - (engine (cdr (assoc :engine params))) - (colnames-p (not (equal "no" (cdr (assoc :colnames params))))) + (let* ((result-params (cdr (assq :result-params params))) + (cmdline (cdr (assq :cmdline params))) + (dbhost (cdr (assq :dbhost params))) + (dbport (cdr (assq :dbport params))) + (dbuser (cdr (assq :dbuser params))) + (dbpassword (cdr (assq :dbpassword params))) + (database (cdr (assq :database params))) + (engine (cdr (assq :engine params))) + (colnames-p (not (equal "no" (cdr (assq :colnames params))))) (in-file (org-babel-temp-file "sql-in-")) - (out-file (or (cdr (assoc :out-file params)) + (out-file (or (cdr (assq :out-file params)) (org-babel-temp-file "sql-out-"))) (header-delim "") - (command (case (intern engine) - ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" + (command (pcase (intern engine) + (`dbi (format "dbish --batch %s < %s | sed '%s' > %s" (or cmdline "") (org-babel-process-file-name in-file) "/^+/d;s/^|//;s/(NULL)/ /g;$d" (org-babel-process-file-name out-file))) - ('monetdb (format "mclient -f tab %s < %s > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('msosql (format "osql %s -s \"\t\" -i %s -o %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('mysql (format "mysql %s %s %s < %s > %s" - (dbstring-mysql dbhost dbuser dbpassword database) + (`monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (`mssql (format "sqlcmd %s -s \"\t\" %s -i %s -o %s" + (or cmdline "") + (org-babel-sql-dbstring-mssql + dbhost dbuser dbpassword database) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name in-file)) + (org-babel-sql-convert-standard-filename + (org-babel-process-file-name out-file)))) + (`mysql (format "mysql %s %s %s < %s > %s" + (org-babel-sql-dbstring-mysql + dbhost dbport dbuser dbpassword database) (if colnames-p "" "-N") - (or cmdline "") + (or cmdline "") (org-babel-process-file-name in-file) (org-babel-process-file-name out-file))) - ('postgresql (format - "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (`postgresql (format + "%spsql --set=\"ON_ERROR_STOP=1\" %s -A -P \ +footer=off -F \"\t\" %s -f %s -o %s %s" + (if dbpassword + (format "PGPASSWORD=%s " dbpassword) + "") + (if colnames-p "" "-t") + (org-babel-sql-dbstring-postgresql + dbhost dbport dbuser database) (org-babel-process-file-name in-file) (org-babel-process-file-name out-file) (or cmdline ""))) - (t (error "No support for the %s SQL engine" engine))))) + (`oracle (format + "sqlplus -s %s < %s > %s" + (org-babel-sql-dbstring-oracle + dbhost dbport dbuser dbpassword database) + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + (_ (error "No support for the %s SQL engine" engine))))) (with-temp-file in-file (insert - (case (intern engine) - ('dbi "/format partbox\n") - (t "")) + (pcase (intern engine) + (`dbi "/format partbox\n") + (`oracle "SET PAGESIZE 50000 +SET NEWPAGE 0 +SET TAB OFF +SET SPACE 0 +SET LINESIZE 9999 +SET ECHO OFF +SET FEEDBACK OFF +SET VERIFY OFF +SET HEADING ON +SET MARKUP HTML OFF SPOOL OFF +SET COLSEP '|' + +") + (`mssql "SET NOCOUNT ON + +") + (_ "")) (org-babel-expand-body:sql body params))) - (message command) (org-babel-eval command "") (org-babel-result-cond result-params (with-temp-buffer - (progn (insert-file-contents-literally out-file) (buffer-string))) + (progn (insert-file-contents-literally out-file) (buffer-string))) (with-temp-buffer (cond - ((or (eq (intern engine) 'mysql) - (eq (intern engine) 'dbi) - (eq (intern engine) 'postgresql)) - ;; Add header row delimiter after column-names header in first line - (cond - (colnames-p - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (forward-line 1) - (insert "-\n") - (setq header-delim "-") - (write-file out-file))))) - (t - ;; Need to figure out the delimiter for the header row - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (when (re-search-forward "^\\(-+\\)[^-]" nil t) - (setq header-delim (match-string-no-properties 1))) - (goto-char (point-max)) - (forward-char -1) - (while (looking-at "\n") - (delete-char 1) - (goto-char (point-max)) - (forward-char -1)) - (write-file out-file)))) + ((memq (intern engine) '(dbi mysql postgresql)) + ;; Add header row delimiter after column-names header in first line + (cond + (colnames-p + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (forward-line 1) + (insert "-\n") + (setq header-delim "-") + (write-file out-file))))) + (t + ;; Need to figure out the delimiter for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) + (goto-char (point-max)) + (forward-char -1)) + (write-file out-file)))) (org-table-import out-file '(16)) (org-babel-reassemble-table (mapcar (lambda (x) @@ -175,10 +246,10 @@ This function is called by `org-babel-execute-src-block'." 'hline x)) (org-table-to-lisp)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) + (org-babel-pick-name (cdr (assq :colname-names params)) + (cdr (assq :colnames params))) + (org-babel-pick-name (cdr (assq :rowname-names params)) + (cdr (assq :rownames params)))))))) (defun org-babel-sql-expand-vars (body vars) "Expand the variables held in VARS in BODY." @@ -201,7 +272,7 @@ This function is called by `org-babel-execute-src-block'." vars) body) -(defun org-babel-prep-session:sql (session params) +(defun org-babel-prep-session:sql (_session _params) "Raise an error because Sql sessions aren't implemented." (error "SQL sessions not yet implemented")) diff --git a/lisp/org/ob-sqlite.el b/lisp/org/ob-sqlite.el index 4b165dc476..8094019d5e 100644 --- a/lisp/org/ob-sqlite.el +++ b/lisp/org/ob-sqlite.el @@ -1,4 +1,4 @@ -;;; ob-sqlite.el --- org-babel functions for sqlite database interaction +;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -53,23 +53,22 @@ (defun org-babel-expand-body:sqlite (body params) "Expand BODY according to the values of PARAMS." (org-babel-sqlite-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) + body (org-babel--get-vars params))) (defvar org-babel-sqlite3-command "sqlite3") (defun org-babel-execute:sqlite (body params) "Execute a block of Sqlite code with Babel. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (db (cdr (assoc :db params))) - (separator (cdr (assoc :separator params))) - (nullvalue (cdr (assoc :nullvalue params))) - (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (let ((result-params (split-string (or (cdr (assq :results params)) ""))) + (db (cdr (assq :db params))) + (separator (cdr (assq :separator params))) + (nullvalue (cdr (assq :nullvalue params))) + (headers-p (equal "yes" (cdr (assq :colnames params)))) (others (delq nil (mapcar - (lambda (arg) (car (assoc arg params))) + (lambda (arg) (car (assq arg params))) (list :header :echo :bail :column - :csv :html :line :list)))) - exit-code) + :csv :html :line :list))))) (unless db (error "ob-sqlite: can't evaluate without a database")) (with-temp-buffer (insert @@ -140,7 +139,7 @@ This function is called by `org-babel-execute-src-block'." (equal 1 (length (car result)))) (org-babel-read (caar result)) (mapcar (lambda (row) - (if (equal 'hline row) + (if (eq 'hline row) 'hline (mapcar #'org-babel-string-read row))) result))) @@ -150,7 +149,7 @@ This function is called by `org-babel-execute-src-block'." (cons (car table) (cons 'hline (cdr table))) table)) -(defun org-babel-prep-session:sqlite (session params) +(defun org-babel-prep-session:sqlite (_session _params) "Raise an error because support for SQLite sessions isn't implemented. Prepare SESSION according to the header arguments specified in PARAMS." (error "SQLite sessions not yet implemented")) diff --git a/lisp/org/ob-stan.el b/lisp/org/ob-stan.el new file mode 100644 index 0000000000..40dd0efa38 --- /dev/null +++ b/lisp/org/ob-stan.el @@ -0,0 +1,84 @@ +;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. + +;; Author: Kyle Meyer +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.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: + +;; Org-Babel support for evaluating Stan [1] source code. +;; +;; Evaluating a Stan block can produce two different results. +;; +;; 1) Dump the source code contents to a file. +;; +;; This file can then be used as a variable in other blocks, which +;; allows interfaces like RStan to use the model. +;; +;; 2) Compile the contents to a model file. +;; +;; This provides access to the CmdStan interface. To use this, set +;; `org-babel-stan-cmdstan-directory' and provide a :file argument +;; that does not end in ".stan". +;; +;; For more information and usage examples, visit +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-stan.html +;; +;; [1] http://mc-stan.org/ + +;;; Code: +(require 'ob) +(require 'org-compat) + +(defcustom org-babel-stan-cmdstan-directory nil + "CmdStan source directory. +'make' will be called from this directory to compile the Stan +block. When nil, executing Stan blocks dumps the content to a +plain text file." + :group 'org-babel + :type 'string) + +(defvar org-babel-default-header-args:stan + '((:results . "file"))) + +(defun org-babel-execute:stan (body params) + "Generate Stan file from BODY according to PARAMS. +A :file header argument must be given. If +`org-babel-stan-cmdstan-directory' is non-nil and the file name +does not have a \".stan\" extension, save an intermediate +\".stan\" file and compile the block to the named file. +Otherwise, write the Stan code directly to the named file." + (let ((file (expand-file-name + (or (cdr (assq :file params)) + (user-error "Set :file argument to execute Stan blocks"))))) + (if (or (not org-babel-stan-cmdstan-directory) + (string-match-p "\\.stan\\'" file)) + (with-temp-file file (insert body)) + (with-temp-file (concat file ".stan") (insert body)) + (let ((default-directory org-babel-stan-cmdstan-directory)) + (call-process-shell-command (concat "make " file)))) + nil)) ; Signal that output has been written to file. + +(defun org-babel-prep-session:stan (_session _params) + "Return an error because Stan does not support sessions." + (user-error "Stan does not support sessions")) + +(provide 'ob-stan) +;;; ob-stan.el ends here diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index 1fa9105ee2..4de8936df1 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -1,4 +1,4 @@ -;;; ob-table.el --- support for calling org-babel functions from tables +;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -23,8 +23,8 @@ ;;; Commentary: -;; Should allow calling functions from org-mode tables using the -;; function `org-sbe' as so... +;; Should allow calling functions from Org tables using the function +;; `org-sbe' as so... ;; #+begin_src emacs-lisp :results silent ;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) @@ -47,38 +47,50 @@ ;; | 7 | | ;; | 8 | | ;; | 9 | | -;; #+TBLFM: $2='(org-sbe 'fibbd (n $1)) +;; #+TBLFM: $2='(org-sbe "fibbd" (n $1)) + +;; NOTE: The quotation marks around the function name, 'fibbd' here, +;; are optional. ;;; Code: (require 'ob-core) +(declare-function org-trim "org" (s &optional keep-lead)) + (defun org-babel-table-truncate-at-newline (string) "Replace newline character with ellipses. If STRING ends in a newline character, then remove the newline character and replace it with ellipses." (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) (concat (substring string 0 (match-beginning 0)) - (if (match-string 1 string) "...")) string)) + (when (match-string 1 string) "...")) string)) (defmacro org-sbe (source-block &rest variables) "Return the results of calling SOURCE-BLOCK with VARIABLES. -Each element of VARIABLES should be a two -element list, whose first element is the name of the variable and -second element is a string of its value. The following call to -`org-sbe' would be equivalent to the following source code block. - (org-sbe \\='source-block (n $2) (m 3)) +Each element of VARIABLES should be a list of two elements: the +first element is the name of the variable and second element is a +string of its value. + +So this `org-sbe' construct + + (org-sbe \"source-block\" (n $2) (m 3)) + +is the equivalent of the following source code block: + + #+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent + results + #+end_src -#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent -results -#+end_src +NOTE: The quotation marks around the function name, +'source-block', are optional. -NOTE: by default string variable names are interpreted as +NOTE: By default, string variable names are interpreted as references to source-code blocks, to force interpretation of a cell's value as a string, prefix the identifier a \"$\" (e.g., \"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\"). -NOTE: it is also possible to pass header arguments to the code +NOTE: It is also possible to pass header arguments to the code block. In this case a table cell should hold the string value of the header argument which can then be passed before all variables as shown in the example below. @@ -132,7 +144,7 @@ as shown in the example below. nil (list "emacs-lisp" "results" params) '((:results . "silent")))) ""))) - (org-babel-trim (if (stringp result) result (format "%S" result))))))) + (org-trim (if (stringp result) result (format "%S" result))))))) (provide 'ob-table) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 437e0a296c..3b0533261c 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -1,4 +1,4 @@ -;;; ob-tangle.el --- extract source code from org-mode files +;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -26,22 +26,35 @@ ;; Extract the code from source blocks out into raw source-code files. ;;; Code: + +(require 'cl-lib) (require 'org-src) -(eval-when-compile - (require 'cl)) +(declare-function make-directory "files" (dir &optional parents)) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-babel-update-block-body "ob-core" (new-body)) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-before-first-heading-p "org" ()) (declare-function org-edit-special "org" (&optional arg)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-type "org-element" (element)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-heading-components "org" ()) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-link-escape "org" (text &optional table merge)) -(declare-function org-store-link "org" (arg)) (declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) -(declare-function org-heading-components "org" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-fill-template "org" (template alist)) -(declare-function org-babel-update-block-body "ob-core" (new-body)) -(declare-function make-directory "files" (dir &optional parents)) +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function org-store-link "org" (arg)) +(declare-function org-string-nw-p "org-macs" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) +(declare-function outline-previous-heading "outline" ()) +(declare-function org-id-find "org-id" (id &optional markerp)) + +(defvar org-link-types-re) (defcustom org-babel-tangle-lang-exts - '(("emacs-lisp" . "el")) + '(("emacs-lisp" . "el") + ("elisp" . "el")) "Alist mapping languages to their file extensions. The key is the language name, the value is the string that should be inserted as the extension commonly used to identify files @@ -54,6 +67,11 @@ then the name of the language is used." (string "Language name") (string "File Extension")))) +(defcustom org-babel-tangle-use-relative-file-links t + "Use relative path names in links from tangled source back the Org file." + :group 'org-babel-tangle + :type 'boolean) + (defcustom org-babel-post-tangle-hook nil "Hook run in code files tangled by `org-babel-tangle'." :group 'org-babel @@ -78,9 +96,14 @@ The following format strings can be used to insert special information into the output using `org-fill-template'. %start-line --- the line number at the start of the code block %file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block +%link --------- Org style link to the code block %source-name -- name of the code block +Upon insertion the formatted comment will be commented out, and +followed by a newline. To inhibit this post-insertion processing +set the `org-babel-tangle-uncomment-comments' variable to a +non-nil value. + Whether or not comments are inserted during tangling is controlled by the :comments header argument." :group 'org-babel @@ -93,20 +116,33 @@ The following format strings can be used to insert special information into the output using `org-fill-template'. %start-line --- the line number at the start of the code block %file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block +%link --------- Org style link to the code block %source-name -- name of the code block +Upon insertion the formatted comment will be commented out, and +followed by a newline. To inhibit this post-insertion processing +set the `org-babel-tangle-uncomment-comments' variable to a +non-nil value. + Whether or not comments are inserted during tangling is controlled by the :comments header argument." :group 'org-babel :version "24.1" :type 'string) -(defcustom org-babel-process-comment-text #'org-babel-trim - "Function called to process raw Org-mode text collected to be +(defcustom org-babel-tangle-uncomment-comments nil + "Inhibits automatic commenting and addition of trailing newline +of tangle comments. Use `org-babel-tangle-comment-format-beg' +and `org-babel-tangle-comment-format-end' to customize the format +of tangled comments." + :group 'org-babel + :type 'boolean) + +(defcustom org-babel-process-comment-text 'org-remove-indentation + "Function called to process raw Org text collected to be inserted as comments in tangled source-code files. The function should take a single string argument and return a string -result. The default value is `org-babel-trim'." +result. The default value is `org-remove-indentation'." :group 'org-babel :version "24.1" :type 'function) @@ -153,12 +189,14 @@ Return a list whose CAR is the tangled file name." (save-window-excursion (find-file file) (setq to-be-removed (current-buffer)) - (org-babel-tangle nil target-file lang)) + (mapcar #'expand-file-name (org-babel-tangle nil target-file lang))) (unless visited-p (kill-buffer to-be-removed))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." + (unless (file-exists-p pub-dir) + (make-directory pub-dir t)) (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) ;;;###autoload @@ -176,12 +214,12 @@ used to limit the exported source code blocks by language." (run-hooks 'org-babel-pre-tangle-hook) ;; Possibly Restrict the buffer to the current code block (save-restriction - (when (equal arg '(4)) - (let ((head (org-babel-where-is-src-block-head))) + (save-excursion + (when (equal arg '(4)) + (let ((head (org-babel-where-is-src-block-head))) (if head (goto-char head) (user-error "Point is not in a source code block")))) - (save-excursion (let ((block-counter 0) (org-babel-default-header-args (if target-file @@ -190,7 +228,7 @@ used to limit the exported source code blocks by language." org-babel-default-header-args)) (tangle-file (when (equal arg '(16)) - (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light)))) + (or (cdr (assq :tangle (nth 2 (org-babel-get-src-block-info 'light)))) (user-error "Point is not in a source code block")))) path-collector) (mapc ;; map over all languages @@ -216,7 +254,7 @@ used to limit the exported source code blocks by language." (base-name (cond ((string= "yes" tangle) (file-name-sans-extension - (buffer-file-name))) + (nth 1 spec))) ((string= "no" tangle) nil) ((> (length tangle) 0) tangle))) (file-name (when base-name @@ -243,9 +281,13 @@ used to limit the exported source code blocks by language." ;; We avoid append-to-file as it does not work with tramp. (let ((content (buffer-string))) (with-temp-buffer - (if (file-exists-p file-name) - (insert-file-contents file-name)) + (when (file-exists-p file-name) + (insert-file-contents file-name)) (goto-char (point-max)) + ;; Handle :padlines unless first line in file + (unless (or (string= "no" (cdr (assq :padline (nth 4 spec)))) + (= (point) (point-min))) + (insert "\n")) (insert content) (write-region nil nil file-name)))) ;; if files contain she-bangs, then make the executable @@ -253,10 +295,8 @@ used to limit the exported source code blocks by language." (unless tangle-mode (setq tangle-mode #o755))) ;; update counter (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector - (cons file-name tangle-mode) - nil - (lambda (a b) (equal (car a) (car b)))))))) + (unless (assoc file-name path-collector) + (push (cons file-name tangle-mode) path-collector)))))) specs))) (if (equal arg '(4)) (org-babel-tangle-single-block 1 t) @@ -284,7 +324,7 @@ used to limit the exported source code blocks by language." Call this function inside of a source-code file generated by `org-babel-tangle' to remove all comments inserted automatically by `org-babel-tangle'. Warning, this comment removes any lines -containing constructs which resemble org-mode file links or noweb +containing constructs which resemble Org file links or noweb references." (interactive) (goto-char (point-min)) @@ -303,153 +343,134 @@ code file. This function uses `comment-region' which assumes that the appropriate major-mode is set. SPEC has the form: (start-line file link source-name params body comment)" - (let* ((start-line (nth 0 spec)) - (file (nth 1 spec)) - (link (nth 2 spec)) - (source-name (nth 3 spec)) - (body (nth 5 spec)) - (comment (nth 6 spec)) - (comments (cdr (assoc :comments (nth 4 spec)))) - (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) - (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes") (string= comments "noweb"))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name))) - (insert-comment (lambda (text) - (when (and comments (not (string= comments "no")) - (> (length text) 0)) - (when padline (insert "\n")) - (comment-region (point) (progn (insert text) (point))) - (end-of-line nil) (insert "\n"))))) + (pcase-let* + ((`(,start ,file ,link ,source ,info ,body ,comment) spec) + (comments (cdr (assq :comments info))) + (link? (or (string= comments "both") (string= comments "link") + (string= comments "yes") (string= comments "noweb"))) + (link-data `(("start-line" . ,(number-to-string start)) + ("file" . ,file) + ("link" . ,link) + ("source-name" . ,source))) + (insert-comment (lambda (text) + (when (and comments + (not (string= comments "no")) + (org-string-nw-p text)) + (if org-babel-tangle-uncomment-comments + ;; Plain comments: no processing. + (insert text) + ;; Ensure comments are made to be + ;; comments, and add a trailing newline. + ;; Also ignore invisible characters when + ;; commenting. + (comment-region + (point) + (progn (insert (org-no-properties text)) + (point))) + (end-of-line) + (insert "\n")))))) (when comment (funcall insert-comment comment)) - (when link-p - (funcall - insert-comment - (org-fill-template org-babel-tangle-comment-format-beg link-data))) - (when padline (insert "\n")) - (insert - (format - "%s\n" - (org-unescape-code-in-string - (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) - (when link-p - (funcall - insert-comment - (org-fill-template org-babel-tangle-comment-format-end link-data))))) - -(defvar org-comment-string) ;; Defined in org.el + (when link? + (funcall insert-comment + (org-fill-template + org-babel-tangle-comment-format-beg link-data))) + (insert body "\n") + (when link? + (funcall insert-comment + (org-fill-template + org-babel-tangle-comment-format-end link-data))))) + (defun org-babel-tangle-collect-blocks (&optional language tangle-file) - "Collect source blocks in the current Org-mode file. + "Collect source blocks in the current Org file. Return an association list of source-code block specifications of the form used by `org-babel-spec-to-string' grouped by language. Optional argument LANGUAGE can be used to limit the collected source code blocks by language. Optional argument TANGLE-FILE can be used to limit the collected code blocks by target file." - (let ((block-counter 1) (current-heading "") blocks by-lang) + (let ((counter 0) last-heading-pos blocks) (org-babel-map-src-blocks (buffer-file-name) - (lambda (new-heading) - (if (not (string= new-heading current-heading)) - (progn - (setq block-counter 1) - (setq current-heading new-heading)) - (setq block-counter (+ 1 block-counter)))) - (replace-regexp-in-string "[ \t]" "-" - (condition-case nil - (or (nth 4 (org-heading-components)) - "(dummy for heading without text)") - (error (buffer-file-name)))) - (let* ((info (org-babel-get-src-block-info 'light)) - (src-lang (nth 0 info)) - (src-tfile (cdr (assoc :tangle (nth 2 info))))) - (unless (or (string-match (concat "^" org-comment-string) current-heading) - (string= (cdr (assoc :tangle (nth 2 info))) "no") - (and tangle-file (not (equal tangle-file src-tfile)))) - (unless (and language (not (string= language src-lang))) - ;; Add the spec for this block to blocks under it's language - (setq by-lang (cdr (assoc src-lang blocks))) - (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks (cons - (cons src-lang - (cons - (org-babel-tangle-single-block - block-counter) - by-lang)) blocks)))))) - ;; Ensure blocks are in the correct order - (setq blocks - (mapcar - (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) - blocks)) - blocks)) - -(defun org-babel-tangle-single-block - (block-counter &optional only-this-block) + (let ((current-heading-pos + (org-with-wide-buffer + (org-with-limited-levels (outline-previous-heading))))) + (if (eq last-heading-pos current-heading-pos) (cl-incf counter) + (setq counter 1) + (setq last-heading-pos current-heading-pos))) + (unless (org-in-commented-heading-p) + (let* ((info (org-babel-get-src-block-info 'light)) + (src-lang (nth 0 info)) + (src-tfile (cdr (assq :tangle (nth 2 info))))) + (unless (or (string= src-tfile "no") + (and tangle-file (not (equal tangle-file src-tfile))) + (and language (not (string= language src-lang)))) + ;; Add the spec for this block to blocks under its + ;; language. + (let ((by-lang (assoc src-lang blocks)) + (block (org-babel-tangle-single-block counter))) + (if by-lang (setcdr by-lang (cons block (cdr by-lang))) + (push (cons src-lang (list block)) blocks))))))) + ;; Ensure blocks are in the correct order. + (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks))) + +(defun org-babel-tangle-single-block (block-counter &optional only-this-block) "Collect the tangled source for current block. Return the list of block attributes needed by -`org-babel-tangle-collect-blocks'. -When ONLY-THIS-BLOCK is non-nil, return the full association -list to be used by `org-babel-tangle' directly." +`org-babel-tangle-collect-blocks'. When ONLY-THIS-BLOCK is +non-nil, return the full association list to be used by +`org-babel-tangle' directly." (let* ((info (org-babel-get-src-block-info)) (start-line (save-restriction (widen) (+ 1 (line-number-at-pos (point))))) - (file (buffer-file-name)) + (file (buffer-file-name (buffer-base-buffer))) (src-lang (nth 0 info)) (params (nth 2 info)) (extra (nth 3 info)) (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) (match-string 1 extra)) org-coderef-label-format)) - (link (let ((link (org-no-properties - (org-store-link nil)))) - (and (string-match org-bracket-link-regexp link) - (match-string 1 link)))) + (link (let ((l (org-no-properties (org-store-link nil)))) + (and (string-match org-bracket-link-regexp l) + (match-string 1 l)))) (source-name - (intern (or (nth 4 info) - (format "%s:%d" - (or (ignore-errors (nth 4 (org-heading-components))) - "No heading") - block-counter)))) - (expand-cmd - (intern (concat "org-babel-expand-body:" src-lang))) + (or (nth 4 info) + (format "%s:%d" + (or (ignore-errors (nth 4 (org-heading-components))) + "No heading") + block-counter))) + (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) (assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang))) (body ;; Run the tangle-body-hook. - (let* ((body ;; Expand the body in language specific manner. - (if (org-babel-noweb-p params :tangle) - (org-babel-expand-noweb-references info) - (nth 1 info))) - (body - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) - (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params))))))) - (with-temp-buffer - (insert body) - (when (string-match "-r" extra) - (goto-char (point-min)) - (while (re-search-forward - (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) - (replace-match ""))) - (run-hooks 'org-babel-tangle-body-hook) - (buffer-string)))) + (let ((body (if (org-babel-noweb-p params :tangle) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (with-temp-buffer + (insert + ;; Expand body in language specific manner. + (cond ((assq :no-expand params) body) + ((fboundp expand-cmd) (funcall expand-cmd body params)) + (t + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (when (string-match "-r" extra) + (goto-char (point-min)) + (while (re-search-forward + (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) + (replace-match ""))) + (run-hooks 'org-babel-tangle-body-hook) + (buffer-string)))) (comment - (when (or (string= "both" (cdr (assoc :comments params))) - (string= "org" (cdr (assoc :comments params)))) + (when (or (string= "both" (cdr (assq :comments params))) + (string= "org" (cdr (assq :comments params)))) ;; From the previous heading or code-block end (funcall org-babel-process-comment-text (buffer-substring (max (condition-case nil (save-excursion - (org-back-to-heading t) ; Sets match data + (org-back-to-heading t) ; Sets match data (match-end 0)) (error (point-min))) (save-excursion @@ -459,31 +480,48 @@ list to be used by `org-babel-tangle' directly." (point-min)))) (point))))) (result - (list start-line file link source-name params body comment))) + (list start-line + (if org-babel-tangle-use-relative-file-links + (file-relative-name file) + file) + (if (and org-babel-tangle-use-relative-file-links + (string-match org-link-types-re link) + (string= (match-string 0 link) "file")) + (concat "file:" + (file-relative-name (match-string 1 link) + (file-name-directory + (cdr (assq :tangle params))))) + link) + source-name + params + (org-unescape-code-in-string + (if org-src-preserve-indentation + (org-trim body t) + (org-trim (org-remove-indentation body)))) + comment))) (if only-this-block (list (cons src-lang (list result))) result))) -(defun org-babel-tangle-comment-links ( &optional info) +(defun org-babel-tangle-comment-links (&optional info) "Return a list of begin and end link comments for the code block at point." - (let* ((start-line (org-babel-where-is-src-block-head)) - (file (buffer-file-name)) - (link (org-link-escape (progn (call-interactively 'org-store-link) - (org-no-properties - (car (pop org-stored-links)))))) - (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name)))) + (let ((link-data + `(("start-line" . ,(number-to-string + (org-babel-where-is-src-block-head))) + ("file" . ,(buffer-file-name)) + ("link" . ,(org-link-escape + (progn + (call-interactively #'org-store-link) + (org-no-properties (car (pop org-stored-links)))))) + ("source-name" . + ,(nth 4 (or info (org-babel-get-src-block-info 'light))))))) (list (org-fill-template org-babel-tangle-comment-format-beg link-data) (org-fill-template org-babel-tangle-comment-format-end link-data)))) ;; de-tangling functions (defvar org-bracket-link-analytic-regexp) (defun org-babel-detangle (&optional source-code-file) - "Propagate changes in source file back original to Org-mode file. + "Propagate changes in source file back original to Org file. This requires that code blocks were tangled with link comments which enable the original code blocks to be found." (interactive) @@ -504,18 +542,17 @@ which enable the original code blocks to be found." (prog1 counter (message "Detangled %d code blocks" counter))))) (defun org-babel-tangle-jump-to-org () - "Jump from a tangled code file to the related Org-mode file." + "Jump from a tangled code file to the related Org mode file." (interactive) (let ((mid (point)) - start body-start end done + start body-start end target-buffer target-char link path block-name body) (save-window-excursion (save-excursion (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) (not ; ever wider searches until matching block comments - (and (setq start (point-at-eol)) - (setq body-start (save-excursion - (forward-line 2) (point-at-bol))) + (and (setq start (line-beginning-position)) + (setq body-start (line-beginning-position 2)) (setq link (match-string 0)) (setq path (match-string 3)) (setq block-name (match-string 5)) @@ -524,32 +561,37 @@ which enable the original code blocks to be found." (re-search-forward (concat " " (regexp-quote block-name) " ends here") nil t) - (setq end (point-at-bol)))))))) + (setq end (line-beginning-position)))))))) (unless (and start (< start mid) (< mid end)) (error "Not in tangled code")) - (setq body (org-babel-trim (buffer-substring start end)))) + (setq body (buffer-substring body-start end))) (when (string-match "::" path) (setq path (substring path 0 (match-beginning 0)))) - (find-file path) (setq target-buffer (current-buffer)) - (goto-char start) (org-open-link-from-string link) + (find-file (or (car (org-id-find path)) path)) + (setq target-buffer (current-buffer)) + ;; Go to the beginning of the relative block in Org file. + (org-open-link-from-string link) (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) - (org-babel-next-src-block - (string-to-number (match-string 1 block-name))) + (let ((n (string-to-number (match-string 1 block-name)))) + (if (org-before-first-heading-p) (goto-char (point-min)) + (org-back-to-heading t)) + ;; Do not skip the first block if it begins at point min. + (cond ((or (org-at-heading-p) + (not (eq (org-element-type (org-element-at-point)) + 'src-block))) + (org-babel-next-src-block n)) + ((= n 1)) + (t (org-babel-next-src-block (1- n))))) (org-babel-goto-named-src-block block-name)) - ;; position at the beginning of the code block body (goto-char (org-babel-where-is-src-block-head)) + ;; Preserve location of point within the source code in tangled + ;; code file. (forward-line 1) - ;; Use org-edit-special to isolate the code. - (org-edit-special) - ;; Then move forward the correct number of characters in the - ;; code buffer. (forward-char (- mid body-start)) - ;; And return to the Org-mode buffer with the point in the right - ;; place. - (org-edit-src-exit) (setq target-char (point))) (org-src-switch-to-buffer target-buffer t) - (prog1 body (goto-char target-char)))) + (goto-char target-char) + body)) (provide 'ob-tangle) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index b0c3d521c5..736f58879b 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -1,4 +1,4 @@ -;;; ob.el --- working with code blocks in org-mode +;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index 153e3772b0..f90dd53bb0 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -24,7 +24,7 @@ ;; ;;; Commentary: -;; This file contains the code for creating and using the Agenda for Org-mode. +;; This file contains the code for creating and using the Agenda for Org. ;; ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and ;; `org-batch-store-agenda-views' are implemented as macros to provide @@ -45,10 +45,9 @@ ;;; Code: +(require 'cl-lib) (require 'org) (require 'org-macs) -(eval-when-compile - (require 'cl)) (declare-function diary-add-to-list "diary-lib" (date string specifier &optional marker globcolor literal)) @@ -69,6 +68,7 @@ (declare-function calendar-persian-date-string "cal-persia" (&optional date)) (declare-function calendar-check-holidays "holidays" (date)) +(declare-function org-columns-remove-overlays "org-colview" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-columns-quit "org-colview" ()) @@ -79,16 +79,15 @@ (declare-function org-is-habit-p "org-habit" (&optional pom)) (declare-function org-habit-parse-todo "org-habit" (&optional pom)) (declare-function org-habit-get-priority "org-habit" (habit &optional moment)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) (declare-function org-agenda-columns "org-colview" ()) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-capture "org-capture" (&optional goto keys)) -(defvar calendar-mode-map) ; defined in calendar.el -(defvar org-clock-current-task nil) ; defined in org-clock.el -(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el -(defvar org-habit-show-habits) ; defined in org-habit.el +(defvar calendar-mode-map) +(defvar org-clock-current-task) +(defvar org-current-tag-alist) +(defvar org-mobile-force-id-on-agenda-items) +(defvar org-habit-show-habits) (defvar org-habit-show-habits-only-for-today) (defvar org-habit-show-all-today) @@ -96,8 +95,8 @@ (defvar org-agenda-buffer-name "*Org Agenda*") (defvar org-agenda-overriding-header nil) (defvar org-agenda-title-append nil) -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el (defvar original-date) ; dynamically scoped, calendar.el does scope this (defvar org-agenda-undo-list nil @@ -135,7 +134,7 @@ addresses the separator between the current and the previous block." (string))) (defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." + "Options concerning exporting agenda views in Org mode." :tag "Org Agenda Export" :group 'org-agenda) @@ -152,7 +151,7 @@ before assigned to the variables. So make sure to quote values you do *not* want evaluated, for example (setq org-agenda-exporter-settings - '((ps-print-color-p 'black-white)))" + \\='((ps-print-color-p \\='black-white)))" :group 'org-agenda-export :type '(repeat (list @@ -237,7 +236,7 @@ you can \"misuse\" it to also add other text to the header." :type 'boolean) (defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." + "Options concerning agenda views in Org mode." :tag "Org Agenda Custom Commands" :group 'org-agenda) @@ -261,8 +260,8 @@ you can \"misuse\" it to also add other text to the header." ;; Keep custom values for `org-agenda-filter-preset' compatible with ;; the new variable `org-agenda-tag-filter-preset'. -(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) -(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter) +(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(defvaralias 'org-agenda-filter 'org-agenda-tag-filter) (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) "List of types searched for when creating the daily/weekly agenda. @@ -360,6 +359,12 @@ the daily/weekly agenda, see `org-agenda-skip-function'.") (const :format "" quote) (repeat (string :tag "+tag or -tag")))) + (list :tag "Effort filter preset" + (const org-agenda-effort-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+=10 or -=10 or +<10 or ->10")))) (list :tag "Regexp filter preset" (const org-agenda-regexp-filter-preset) (list @@ -435,8 +440,9 @@ This will be spliced into the custom type of (defcustom org-agenda-custom-commands '(("n" "Agenda and all TODOs" ((agenda "") (alltodo "")))) "Custom commands for the agenda. +\\ These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: +agenda dispatcher `\\[org-agenda]'. Each entry is a list like this: (key desc type match settings files) @@ -463,8 +469,8 @@ match What to search for: settings A list of option settings, similar to that in a let form, so like this: ((opt1 val1) (opt2 val2) ...). The values will be evaluated at the moment of execution, so quote them when needed. -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. +files A list of files to write the produced agenda buffer to with + the command `org-store-agenda-views'. If a file name ends in \".html\", an HTML version of the buffer is written out. If it ends in \".ps\", a postscript version is produced. Otherwise, only the plain text is written to the file. @@ -601,23 +607,17 @@ subtree to see if any of the subtasks have project status. See also the variable `org-tags-match-list-sublevels' which applies to projects matched by this search as well. -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." +After defining this variable, you may use `\\[org-agenda-list-stuck-projects]' +\(bound to `C-c a #') to produce the list." :group 'org-agenda-custom-commands :type '(list (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) - -(defcustom org-agenda-filter-effort-default-operator "<" - "The default operator for effort estimate filtering. -If you select an effort estimate limit without first pressing an operator, -this one will be used." - :group 'org-agenda-custom-commands - :type '(choice (const :tag "less or equal" "<") - (const :tag "greater or equal"">") - (const :tag "equal" "="))) + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TODO keyword any of" (string)) + (repeat :tag "Projects are *not* stuck if they have an entry with \ +TAG being any of" (string)) + (regexp :tag "Projects are *not* stuck if this regexp matches inside \ +the subtree"))) (defgroup org-agenda-skip nil "Options concerning skipping parts of agenda files." @@ -769,10 +769,12 @@ to make his option also apply to the tags-todo list." (defcustom org-agenda-todo-ignore-deadlines nil "Non-nil means ignore some deadline TODO items when making TODO list. + There are different motivations for using different values, please think carefully when configuring this variable. -This applies when creating the global todo list. +This applies when creating the global TODO list. + Valid values are: near Don't show near deadline entries. A deadline is near when it is @@ -780,8 +782,8 @@ near Don't show near deadline entries. A deadline is near when it is is that such items will appear in the agenda anyway. far Don't show TODO entries where a deadline has been defined, but - the deadline is not near. This is useful if you don't want to - use the todo list to figure out what to do now. + is not going to happen anytime soon. This is useful if you want to use + the TODO list to figure out what to do now. past Don't show entries with a deadline timestamp for today or in the past. @@ -842,10 +844,9 @@ restricted to unfinished TODO entries only." (defcustom org-agenda-skip-scheduled-if-done nil "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list. And -it applies only to the actual date of the scheduling. Warnings about -an item with a past scheduling dates are always turned off when the item -is DONE." +This is relevant for the daily/weekly agenda, not for the TODO list. It +applies only to the actual date of the scheduling. Warnings about an item +with a past scheduling dates are always turned off when the item is DONE." :group 'org-agenda-skip :group 'org-agenda-daily/weekly :type 'boolean) @@ -894,8 +895,8 @@ several times." (defcustom org-agenda-skip-deadline-if-done nil "Non-nil means don't show deadlines when the corresponding item is done. When nil, the deadline is still shown and should give you a happy feeling. -This is relevant for the daily/weekly agenda. And it applied only to the -actually date of the deadline. Warnings about approaching and past-due +This is relevant for the daily/weekly agenda. It applies only to the +actual date of the deadline. Warnings about approaching and past-due deadlines are always turned off when the item is DONE." :group 'org-agenda-skip :group 'org-agenda-daily/weekly @@ -1001,8 +1002,6 @@ you want to use two-columns display (see `org-agenda-menu-two-columns')." :version "24.1" :type 'boolean) -(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") - (defcustom org-agenda-menu-two-columns nil "Non-nil means, use two columns to show custom commands in the dispatcher. If you use this, you probably want to set `org-agenda-menu-show-matcher' @@ -1011,7 +1010,6 @@ to nil." :version "24.1" :type 'boolean) -(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") (defcustom org-agenda-finalize-hook nil "Hook run just before displaying an agenda buffer. The buffer is still writable when the hook is called. @@ -1024,8 +1022,8 @@ headlines as the agenda display heavily relies on them." (defcustom org-agenda-mouse-1-follows-link nil "Non-nil means mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." +A longer mouse click will still set point. Needs to be set +before org.el is loaded." :group 'org-agenda-startup :type 'boolean) @@ -1054,9 +1052,9 @@ current item's tree, in an indirect buffer." (defcustom org-agenda-entry-text-maxlines 5 "Number of text lines to be added when `E' is pressed in the agenda. -Note that this variable only used during agenda display. Add add entry text +Note that this variable only used during agenda display. To add entry text when exporting the agenda, configure the variable -`org-agenda-add-entry-ext-maxlines'." +`org-agenda-add-entry-text-maxlines'." :group 'org-agenda :type 'integer) @@ -1097,6 +1095,7 @@ Possible values for this option are: current-window Show agenda in the current window, keeping all other windows. other-window Use `switch-to-buffer-other-window' to display agenda. +only-window Show agenda, deleting all other windows. reorganize-frame Show only two windows on the current frame, the current window and the agenda. other-frame Use `switch-to-buffer-other-frame' to display agenda. @@ -1107,6 +1106,7 @@ See also the variable `org-agenda-restore-windows-after-quit'." (const current-window) (const other-frame) (const other-window) + (const only-window) (const reorganize-frame))) (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) @@ -1126,16 +1126,6 @@ option will be ignored." :group 'org-agenda-windows :type 'boolean) -(defcustom org-agenda-ndays nil - "Number of days to include in overview display. -Should be 1 or 7. -Obsolete, see `org-agenda-span'." - :group 'org-agenda-daily/weekly - :type '(choice (const nil) - (integer))) - -(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") - (defcustom org-agenda-span 'week "Number of days to include in overview display. Can be day, week, month, year, or any number of days. @@ -1211,7 +1201,7 @@ For example, 9:30am would become 09:30 rather than 9:30." :type 'boolean) (defun org-agenda-time-of-day-to-ampm (time) - "Convert TIME of a string like `13:45' to an AM/PM style time string." + "Convert TIME of a string like \"13:45\" to an AM/PM style time string." (let* ((hour-number (string-to-number (substring time 0 -3))) (minute (substring time -2)) (ampm "am")) @@ -1284,20 +1274,22 @@ shown, either today or the nearest into the future." (defcustom org-scheduled-past-days 10000 "Number of days to continue listing scheduled items not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." +When an item is scheduled on a date, it shows up in the agenda on +this day and will be listed until it is marked done or for the +number of days given here." :group 'org-agenda-daily/weekly :type 'integer) (defcustom org-agenda-log-mode-items '(closed clock) "List of items that should be shown in agenda log mode. +\\\ This list may contain the following symbols: closed Show entries that have been closed on that day. clock Show entries that have received clocked time on that day. state Show all logged state changes. -Note that instead of changing this variable, you can also press `C-u l' in +Note that instead of changing this variable, you can also press \ +`\\[universal-argument] \\[org-agenda-log-mode]' in the agenda to display all available LOG items temporarily." :group 'org-agenda-daily/weekly :type '(set :greedy t (const closed) (const clock) (const state))) @@ -1413,7 +1405,7 @@ boolean search." :version "24.1" :type 'boolean) -(org-defvaralias 'org-agenda-search-view-search-words-only +(defvaralias 'org-agenda-search-view-search-words-only 'org-agenda-search-view-always-boolean) (defcustom org-agenda-search-view-force-full-words nil @@ -1434,7 +1426,7 @@ value, don't limit agenda view by outline level." :type 'integer) (defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." + "Options concerning the time grid in the Org Agenda." :tag "Org Agenda Time Grid" :group 'org-agenda) @@ -1506,7 +1498,7 @@ a grid line." :type 'string) (defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." + "Options concerning sorting in the Org Agenda." :tag "Org Agenda Sorting" :group 'org-agenda) @@ -1612,7 +1604,7 @@ When nil, such items are sorted as 0 minutes effort." :type 'boolean) (defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." + "Options concerning the entry prefix in the Org agenda display." :tag "Org Agenda Line Format" :group 'org-agenda) @@ -1792,17 +1784,18 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." (defcustom org-agenda-show-inherited-tags t "Non-nil means show inherited tags in each agenda line. -When this option is set to 'always, it take precedences over +When this option is set to `always', it takes precedence over `org-agenda-use-tag-inheritance' and inherited tags are shown in every agenda. When this option is set to t (the default), inherited tags are shown when they are available, i.e. when the value of -`org-agenda-use-tag-inheritance' has been taken into account. +`org-agenda-use-tag-inheritance' enables tag inheritance for the +given agenda type. This can be set to a list of agenda types in which the agenda -must display the inherited tags. Available types are 'todo, -'agenda, 'search and 'timeline. +must display the inherited tags. Available types are `todo', +`agenda', `search' and `timeline'. When set to nil, never show inherited tags in agenda lines." :group 'org-agenda-line-format @@ -1823,10 +1816,10 @@ controlled by `org-use-tag-inheritance'. In other agenda types, agenda entries. Still, you may want the agenda to be aware of the inherited tags anyway, e.g. for later tag filtering. -Allowed value are 'todo, 'search, 'timeline and 'agenda. +Allowed value are `todo', `search', `timeline' and `agenda'. This variable has no effect if `org-agenda-show-inherited-tags' -is set to 'always. In that case, the agenda is aware of those +is set to `always'. In that case, the agenda is aware of those tags. The default value sets tags in every agenda type. Setting this @@ -1858,10 +1851,10 @@ When this is the symbol `prefix', only remove tags when (const :tag "Never" nil) (const :tag "When prefix format contains %T" prefix))) -(org-defvaralias 'org-agenda-remove-tags-when-in-prefix +(defvaralias 'org-agenda-remove-tags-when-in-prefix 'org-agenda-remove-tags) -(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) +(defcustom org-agenda-tags-column -80 "Shift tags in agenda items to this column. If this number is positive, it specifies the column. If it is negative, it means that the tags should be flushright to that column. For example, @@ -1869,7 +1862,7 @@ it means that the tags should be flushright to that column. For example, :group 'org-agenda-line-format :type 'integer) -(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) +(defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) (defcustom org-agenda-fontify-priorities 'cookies "Non-nil means highlight low and high priorities in agenda. @@ -1948,6 +1941,14 @@ category, you can use: :tag "Org Agenda Column View" :group 'org-agenda) +(defcustom org-agenda-view-columns-initially nil + "When non-nil, switch to columns view right after creating the agenda." + :group 'org-agenda-column-view + :type 'boolean + :version "26.1" + :package-version '(Org . "9.0") + :safe #'booleanp) + (defcustom org-agenda-columns-show-summaries t "Non-nil means show summaries for columns displayed in the agenda view." :group 'org-agenda-column-view @@ -1975,7 +1976,8 @@ estimate." :type 'boolean) (defcustom org-agenda-auto-exclude-function nil - "A function called with a tag to decide if it is filtered on `/ RET'. + "A function called with a tag to decide if it is filtered on \ +\\`\\[org-agenda-filter-by-tag] RET'. The sole argument to the function, which is called once for each possible tag, is a string giving the name of the tag. The function should return either nil if the tag should be included @@ -1990,13 +1992,13 @@ the lower-case version of all tags." "Alist of characters and custom functions for bulk actions. For example, this value makes those two functions available: - ((?R set-category) - (?C bulk-cut)) + \\='((?R set-category) + (?C bulk-cut)) With selected entries in an agenda buffer, `B R' will call the custom function `set-category' on the selected entries. Note that functions in this alist don't need to be quoted." - :type 'alist + :type '(alist :key-type character :value-type (group function)) :version "24.1" :group 'org-agenda) @@ -2006,7 +2008,7 @@ If STRING is non-nil, the text property will be fetched from position 0 in that string. If STRING is nil, it will be fetched from the beginning of the current line." (org-with-gensyms (marker) - `(let ((,marker (get-text-property (if string 0 (point-at-bol)) + `(let ((,marker (get-text-property (if ,string 0 (point-at-bol)) 'org-hd-marker ,string))) (with-current-buffer (marker-buffer ,marker) (save-excursion @@ -2027,7 +2029,7 @@ works you probably want to add it to `org-agenda-custom-commands' for good." (defvar org-agenda-mode-map (make-sparse-keymap) "Keymap for `org-agenda-mode'.") -(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map) +(defvaralias 'org-agenda-keymap 'org-agenda-mode-map) (defvar org-agenda-menu) ; defined later in this file. (defvar org-agenda-restrict nil) ; defined later in this file. @@ -2044,6 +2046,8 @@ The buffer is still writable when this hook is called.") (defvar org-agenda-force-single-file nil) (defvar org-agenda-bulk-marked-entries nil "List of markers that refer to marked entries in the agenda.") +(defvar org-agenda-current-date nil + "Active date when building the agenda.") ;;; Multiple agenda buffers support @@ -2064,13 +2068,13 @@ When nil, `q' will kill the single agenda buffer." (> (prefix-numeric-value arg) 0) (not org-agenda-sticky)))) (if (equal new-value org-agenda-sticky) - (and (org-called-interactively-p 'interactive) + (and (called-interactively-p 'interactive) (message "Sticky agenda was already %s" (if org-agenda-sticky "enabled" "disabled"))) (setq org-agenda-sticky new-value) (org-agenda-kill-all-agenda-buffers) - (and (org-called-interactively-p 'interactive) - (message "Sticky agenda was %s" + (and (called-interactively-p 'interactive) + (message "Sticky agenda %s" (if org-agenda-sticky "enabled" "disabled")))))) (defvar org-agenda-buffer nil @@ -2080,6 +2084,8 @@ When nil, `q' will kill the single agenda buffer." (defvar org-agenda-this-buffer-name nil) (defvar org-agenda-doing-sticky-redo nil) (defvar org-agenda-this-buffer-is-sticky nil) +(defvar org-agenda-last-indirect-buffer nil + "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.") (defconst org-agenda-local-vars '(org-agenda-this-buffer-name @@ -2101,8 +2107,10 @@ When nil, `q' will kill the single agenda buffer." org-agenda-category-filter org-agenda-top-headline-filter org-agenda-regexp-filter + org-agenda-effort-filter org-agenda-markers org-agenda-last-search-view-search-was-boolean + org-agenda-last-indirect-buffer org-agenda-filtered-by-category org-agenda-filter-form org-agenda-cycle-counter @@ -2110,7 +2118,7 @@ When nil, `q' will kill the single agenda buffer." "Variables that must be local in agenda buffers to allow multiple buffers.") (defun org-agenda-mode () - "Mode for time-sorted view on action items in Org-mode files. + "Mode for time-sorted view on action items in Org files. The following commands are available: @@ -2123,42 +2131,41 @@ The following commands are available: ;; while letting `kill-all-local-variables' kill the rest (let ((save (buffer-local-variables))) (kill-all-local-variables) - (mapc 'make-local-variable org-agenda-local-vars) + (mapc #'make-local-variable org-agenda-local-vars) (dolist (elem save) - (let ((var (car elem)) - (val (cdr elem))) - (when (and val - (member var org-agenda-local-vars)) - (set var val))))) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (pcase elem + (`(,var . ,val) ;ignore unbound variables + (when (and val (memq var org-agenda-local-vars)) + (set var val)))))) + (setq-local org-agenda-this-buffer-is-sticky t)) (org-agenda-sticky ;; Creating a sticky Agenda buffer for the first time (kill-all-local-variables) (mapc 'make-local-variable org-agenda-local-vars) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (setq-local org-agenda-this-buffer-is-sticky t)) (t ;; Creating a non-sticky agenda buffer (kill-all-local-variables) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) + (setq-local org-agenda-this-buffer-is-sticky nil))) (setq org-agenda-undo-list nil org-agenda-pending-undo-list nil org-agenda-bulk-marked-entries nil) (setq major-mode 'org-agenda-mode) ;; Keep global-font-lock-mode from turning on font-lock-mode - (org-set-local 'font-lock-global-modes (list 'not major-mode)) + (setq-local font-lock-global-modes (list 'not major-mode)) (setq mode-name "Org-Agenda") (setq indent-tabs-mode nil) (use-local-map org-agenda-mode-map) (easy-menu-add org-agenda-menu) (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'line-move-visual nil) - (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) - (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) + (setq-local line-move-visual nil) + (add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) + (add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text - (org-add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (substring-no-properties (funcall fun start end delete))) - nil t) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete))) + nil t) (unless org-agenda-keep-modes (setq org-agenda-follow-mode org-agenda-start-with-follow-mode org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode)) @@ -2309,9 +2316,9 @@ The following commands are available: (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) +(org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort) (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) -(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) (org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively) (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) @@ -2322,6 +2329,10 @@ The following commands are available: (org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) (org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) + +(define-key org-agenda-mode-map [remap forward-paragraph] 'org-agenda-forward-block) +(define-key org-agenda-mode-map [remap backward-paragraph] 'org-agenda-backward-block) + (when org-agenda-mouse-1-follows-link (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" @@ -2346,7 +2357,7 @@ The following commands are available: ["Fortnight View" org-agenda-fortnight-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'fortnight) - :keys "v f"] + :keys "v t"] ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'month) @@ -2387,7 +2398,7 @@ The following commands are available: ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) ["Write view to file" org-agenda-write t] ["Rebuild buffer" org-agenda-redo t] - ["Save all Org-mode Buffers" org-save-all-org-buffers t] + ["Save all Org buffers" org-save-all-org-buffers t] "--" ["Show original entry" org-agenda-show t] ["Go To (other window)" org-agenda-goto t] @@ -2538,7 +2549,7 @@ For example, if you have a custom agenda command \"p\" and you want this command to be accessible only from plain text files, use this: - \\='((\"p\" ((in-file . \"\\.txt\")))) + \\='((\"p\" ((in-file . \"\\\\.txt\\\\'\")))) Here are the available contexts definitions: @@ -2556,7 +2567,7 @@ accessible if there is at least one valid check. You can also bind a key to another agenda custom command depending on contextual rules. - \\='((\"p\" \"q\" ((in-file . \"\\.txt\")))) + \\='((\"p\" \"q\" ((in-file . \"\\\\.txt\\\\'\")))) Here it means: in .txt files, use \"p\" as the key for the agenda command otherwise associated with \"q\". (The command @@ -2656,6 +2667,7 @@ to limit entries to in this type." (const timeline)) (integer :tag "Max number of minutes"))))) +(defvar org-agenda-keep-restricted-file-list nil) (defvar org-keys nil) (defvar org-match nil) ;;;###autoload @@ -2688,9 +2700,9 @@ More commands can be added by configuring the variable `org-agenda-custom-commands'. In particular, specific tags and TODO keyword searches can be pre-defined in this way. -If the current buffer is in Org-mode and visiting a file, you can also +If the current buffer is in Org mode and visiting a file, you can also first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. +\(until the next use of `\\[org-agenda]') restricted to the current file. Pressing `<' twice means to restrict to the current subtree or region \(if active)." (interactive "P") @@ -2722,7 +2734,7 @@ Pressing `<' twice means to restrict to the current subtree or region entry key type org-match lprops ans) ;; Turn off restriction unless there is an overriding one, (unless org-agenda-overriding-restriction - (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) + (unless org-agenda-keep-restricted-file-list ;; There is a request to keep the file list in place (put 'org-agenda-files 'org-restrict nil)) (setq org-agenda-restrict nil) @@ -2819,7 +2831,7 @@ Pressing `<' twice means to restrict to the current subtree or region ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) ((equal org-keys "?") (org-tags-view nil "+FLAGGED") - (org-add-hook + (add-hook 'post-command-hook (lambda () (unless (current-message) @@ -2836,7 +2848,7 @@ Pressing `<' twice means to restrict to the current subtree or region t t)) ((equal org-keys "L") (unless (derived-mode-p 'org-mode) - (user-error "This is not an Org-mode file")) + (user-error "This is not an Org file")) (unless restriction (put 'org-agenda-files 'org-restrict (list bfn)) (org-call-with-arg 'org-timeline arg))) @@ -2928,7 +2940,7 @@ L Timeline for current buffer # List stuck projects (!=configure) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) - (pushnew (string-to-char key) prefixes :test #'equal) + (cl-pushnew (string-to-char key) prefixes :test #'equal) (setq line (format "%-4s%-14s" @@ -3034,7 +3046,7 @@ L Timeline for current buffer # List stuck projects (!=configure) (call-interactively 'org-toggle-sticky-agenda) (sit-for 2)) ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) - (message "Restriction is only possible in Org-mode buffers") + (message "Restriction is only possible in Org buffers") (ding) (sit-for 1)) ((eq c ?1) (org-agenda-remove-restriction-lock 'noupdate) @@ -3067,10 +3079,13 @@ L Timeline for current buffer # List stuck projects (!=configure) "Fit the window to the buffer size." (and (memq org-agenda-window-setup '(reorganize-frame)) (fboundp 'fit-window-to-buffer) - (org-fit-window-to-buffer - nil - (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) - (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) + (if (and (= (cdr org-agenda-window-frame-fractions) 1.0) + (= (car org-agenda-window-frame-fractions) 1.0)) + (delete-other-windows) + (org-fit-window-to-buffer + nil + (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) + (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))) (defvar org-cmd nil) (defvar org-agenda-overriding-cmd nil) @@ -3089,9 +3104,9 @@ L Timeline for current buffer # List stuck projects (!=configure) match ;; The byte compiler incorrectly complains about this. Keep it! org-cmd type lprops) (while (setq org-cmd (pop cmds)) - (setq type (car org-cmd) - match (eval (nth 1 org-cmd)) - lprops (nth 2 org-cmd)) + (setq type (car org-cmd)) + (setq match (eval (nth 1 org-cmd))) + (setq lprops (nth 2 org-cmd)) (let ((org-agenda-overriding-arguments (if (eq org-agenda-overriding-cmd org-cmd) (or org-agenda-overriding-arguments @@ -3144,7 +3159,7 @@ Parameters are alternating variable names and values that will be bound before running the agenda command." (org-eval-in-environment (org-make-parameter-alist parameters) (let (org-agenda-sticky) - (if (> (length cmd-key) 2) + (if (> (length cmd-key) 1) (org-tags-view nil cmd-key) (org-agenda nil cmd-key)))) (set-buffer org-agenda-buffer-name) @@ -3232,7 +3247,7 @@ This ensures the export commands can easily use it." (setq tmp (replace-match "" t t tmp))) (when (and (setq re (plist-get props 'org-todo-regexp)) (setq re (concat "\\`\\.*" re " ?")) - (string-match re tmp)) + (let ((case-fold-search nil)) (string-match re tmp))) (plist-put props 'todo (match-string 1 tmp)) (setq tmp (replace-match "" t t tmp))) (plist-put props 'txt tmp))) @@ -3245,9 +3260,7 @@ This ensures the export commands can easily use it." ((not res) "") ((stringp res) res) (t (prin1-to-string res)))) - (while (string-match "," res) - (setq res (replace-match ";" t t res))) - (org-trim res))) + (org-trim (replace-regexp-in-string "," ";" res nil t)))) ;;;###autoload (defun org-store-agenda-views (&rest parameters) @@ -3306,39 +3319,42 @@ This ensures the export commands can easily use it." (defvar org-agenda-write-buffer-name "Agenda View") (defun org-agenda-write (file &optional open nosettings agenda-bufname) "Write the current buffer (an agenda view) as a file. + Depending on the extension of the file name, plain text (.txt), HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. -If the extension is .ics, run icalendar export over all files used -to construct the agenda and limit the export to entries listed in the -agenda now. -If the extension is .org, collect all subtrees corresponding to the -agenda entries and add them in an .org file. -With prefix argument OPEN, open the new file immediately. -If NOSETTINGS is given, do not scope the settings of -`org-agenda-exporter-settings' into the export commands. This is used when -the settings have already been scoped and we do not wish to overrule other, -higher priority settings. -If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." +If the extension is .ics, translate visible agenda into iCalendar +format. If the extension is .org, collect all subtrees +corresponding to the agenda entries and add them in an .org file. + +With prefix argument OPEN, open the new file immediately. If +NOSETTINGS is given, do not scope the settings of +`org-agenda-exporter-settings' into the export commands. This is +used when the settings have already been scoped and we do not +wish to overrule other, higher priority settings. If +AGENDA-BUFFER-NAME is provided, use this as the buffer name for +the agenda to write." (interactive "FWrite agenda to file: \nP") (if (or (not (file-writable-p file)) (and (file-exists-p file) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) (user-error "Cannot write agenda to file %s" file)) (org-let (if nosettings nil org-agenda-exporter-settings) '(save-excursion (save-window-excursion - (let ((bs (copy-sequence (buffer-string))) beg content) + (let ((bs (copy-sequence (buffer-string))) + (extension (file-name-extension file)) + beg content) (with-temp-buffer (rename-buffer org-agenda-write-buffer-name t) (set-buffer-modified-p nil) (insert bs) - (org-agenda-remove-marked-text 'org-filtered) + (org-agenda-remove-marked-text 'invisible 'org-filtered) (run-hooks 'org-agenda-before-write-hook) (cond - ((org-bound-and-true-p org-mobile-creating-agendas) + ((bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) - ((string-match "\\.org\\'" file) + ((string= "org" extension) (let (content p m message-log-max) (goto-char (point-min)) (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) @@ -3357,7 +3373,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (write-file file) (kill-buffer (current-buffer)) (message "Org file written to %s" file))) - ((string-match "\\.html?\\'" file) + ((member extension '("html" "htm")) (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) (when org-agenda-export-html-style @@ -3369,11 +3385,11 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (write-file file) (kill-buffer (current-buffer)) (message "HTML written to %s" file)) - ((string-match "\\.ps\\'" file) + ((string= "ps" extension) (require 'ps-print) (ps-print-buffer-with-faces file) (message "Postscript written to %s" file)) - ((string-match "\\.pdf\\'" file) + ((string= "pdf" extension) (require 'ps-print) (ps-print-buffer-with-faces (concat (file-name-sans-extension file) ".ps")) @@ -3383,7 +3399,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (expand-file-name file)) (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) - ((string-match "\\.ics\\'" file) + ((string= "ics" extension) (require 'ox-icalendar) (org-icalendar-export-current-agenda (expand-file-name file))) (t @@ -3395,7 +3411,7 @@ If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." (kill-buffer (current-buffer)) (message "Plain text written to %s" file)))))))) (set-buffer (or agenda-bufname - (and (org-called-interactively-p 'any) (buffer-name)) + (and (called-interactively-p 'any) (buffer-name)) org-agenda-buffer-name))) (when open (org-open-file file))) @@ -3416,7 +3432,7 @@ This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the entry text following headings shown in the agenda. Drawers will be excluded, also the line with scheduling/deadline info." (when (and (> org-agenda-add-entry-text-maxlines 0) - (not (org-bound-and-true-p org-mobile-creating-agendas))) + (not (bound-and-true-p org-mobile-creating-agendas))) (let (m txt) (goto-char (point-min)) (while (not (eobp)) @@ -3441,85 +3457,83 @@ removed from the entry content. Currently only `planning' is allowed here." (with-current-buffer (marker-buffer marker) (if (not (derived-mode-p 'org-mode)) (setq txt "") - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (end-of-line 1) - (setq txt (buffer-substring - (min (1+ (point)) (point-max)) - (progn (outline-next-heading) (point))) - drawer-re org-drawer-regexp - kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp - ".*\n?")) - (with-temp-buffer - (insert txt) - (when org-agenda-add-entry-text-descriptive-links - (goto-char (point-min)) - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp (point-max) t) - (set-text-properties (match-beginning 0) (match-end 0) - nil)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (delete-region - (match-beginning 0) - (progn (re-search-forward - "^[ \t]*:END:.*\n?" nil 'move) - (point)))) - (unless (member 'planning keep) - (goto-char (point-min)) - (while (re-search-forward kwd-time-re nil t) - (replace-match ""))) - (goto-char (point-min)) - (when org-agenda-entry-text-exclude-regexps - (let ((re-list org-agenda-entry-text-exclude-regexps) re) - (while (setq re (pop re-list)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match ""))))) - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (if (looking-at "[ \t\n]+\\'") (replace-match "")) - - ;; find and remove min common indentation - (goto-char (point-min)) - (untabify (point-min) (point-max)) - (setq ind (org-get-indentation)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (setq ind (min ind (org-get-indentation)))) - (beginning-of-line 2)) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (move-to-column ind) - (delete-region (point-at-bol) (point))) - (beginning-of-line 2)) - - (run-hooks 'org-agenda-entry-text-cleanup-hook) - - (goto-char (point-min)) - (when indent - (while (and (not (eobp)) (re-search-forward "^" nil t)) - (replace-match indent t t))) - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (goto-char (point-max)) - (when (> (org-current-line) - n-lines) - (org-goto-line (1+ n-lines)) - (backward-char 1)) - (setq txt (buffer-substring (point-min) (point))))))))) + (org-with-wide-buffer + (goto-char marker) + (end-of-line 1) + (setq txt (buffer-substring + (min (1+ (point)) (point-max)) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (unless (member 'planning keep) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match ""))) + (goto-char (point-min)) + (when org-agenda-entry-text-exclude-regexps + (let ((re-list org-agenda-entry-text-exclude-regexps) re) + (while (setq re (pop re-list)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match ""))))) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (if (looking-at "[ \t\n]+\\'") (replace-match "")) + + ;; find and remove min common indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (org-get-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (org-get-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + + (run-hooks 'org-agenda-entry-text-cleanup-hook) + + (goto-char (point-min)) + (when indent + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match indent t t))) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + n-lines) + (org-goto-line (1+ n-lines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point)))))))) txt)) (defun org-check-for-org-mode () "Make sure current buffer is in org-mode. Error if not." (or (derived-mode-p 'org-mode) - (error "Cannot execute org-mode agenda command on buffer in %s" + (error "Cannot execute Org agenda command on buffer in %s" major-mode))) ;;; Agenda prepare and finalize @@ -3531,6 +3545,7 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-tag-filter nil) (defvar org-agenda-category-filter nil) (defvar org-agenda-regexp-filter nil) +(defvar org-agenda-effort-filter nil) (defvar org-agenda-top-headline-filter nil) (defvar org-agenda-tag-filter-preset nil "A preset of the tags filter used for secondary agenda filtering. @@ -3562,6 +3577,16 @@ the entire agenda view. In a block agenda, it will not work reliably to define a filter for one of the individual blocks. You need to set it in the global options and expect it to be applied to the entire view.") +(defvar org-agenda-effort-filter-preset nil + "A preset of the effort condition used for secondary agenda filtering. +This must be a list of strings, each string must be a single regexp +preceded by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") + (defun org-agenda-use-sticky-p () "Return non-nil if an agenda buffer named `org-agenda-buffer-name' exists and should be shown instead of @@ -3593,30 +3618,37 @@ FILTER-ALIST is an alist of filters we need to apply when ((equal (current-buffer) abuf) nil) (awin (select-window awin)) ((not (setq wconf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) + ((eq org-agenda-window-setup 'current-window) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'other-window) (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) + ((eq org-agenda-window-setup 'other-frame) (switch-to-buffer-other-frame abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) + ((eq org-agenda-window-setup 'only-window) + (delete-other-windows) + (pop-to-buffer-same-window abuf)) + ((eq org-agenda-window-setup 'reorganize-frame) (delete-other-windows) (org-switch-to-buffer-other-window abuf))) - (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist))) - (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist))) - (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist))) + (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist))) + (setq org-agenda-category-filter (cdr (assq 'cat filter-alist))) + (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist))) + (setq org-agenda-regexp-filter (cdr (assq 're filter-alist))) ;; Additional test in case agenda is invoked from within agenda ;; buffer via elisp link. (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf)) + (pop-to-buffer-same-window abuf)) (setq org-agenda-pre-window-conf - (or org-agenda-pre-window-conf wconf)))) + (or wconf org-agenda-pre-window-conf)))) (defun org-agenda-prepare (&optional name) (let ((filter-alist (if org-agenda-persistent-filter - (list `(tag . ,org-agenda-tag-filter) - `(re . ,org-agenda-regexp-filter) - `(car . ,org-agenda-category-filter))))) + (with-current-buffer + (get-buffer-create org-agenda-buffer-name) + (list `(tag . ,org-agenda-tag-filter) + `(re . ,org-agenda-regexp-filter) + `(effort . ,org-agenda-effort-filter) + `(cat . ,org-agenda-category-filter)))))) (if (org-agenda-use-sticky-p) (progn (put 'org-agenda-tag-filter :preset-filter nil) @@ -3629,13 +3661,14 @@ FILTER-ALIST is an alist of filters we need to apply when (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) (setq org-todo-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) (put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset) (put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset) (put 'org-agenda-regexp-filter :preset-filter org-agenda-regexp-filter-preset) + (put 'org-agenda-effort-filter :preset-filter + org-agenda-effort-filter-preset) (if org-agenda-multi (progn (setq buffer-read-only nil) @@ -3649,7 +3682,6 @@ FILTER-ALIST is an alist of filters we need to apply when "\n")) (narrow-to-region (point) (point-max))) (setq org-done-keywords-for-agenda nil) - ;; Setting any org variables that are in org-agenda-local-vars ;; list need to be done after the prepare call (org-agenda-prepare-window @@ -3666,11 +3698,10 @@ FILTER-ALIST is an alist of filters we need to apply when (org-uniquify org-todo-keywords-for-agenda)) (setq org-done-keywords-for-agenda (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) (setq org-agenda-last-prefix-arg current-prefix-arg) (setq org-agenda-this-buffer-name org-agenda-buffer-name) (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) + (setq-local org-agenda-name name))) (setq buffer-read-only nil)))) (defvar org-agenda-overriding-columns-format) ; From org-colview.el @@ -3681,11 +3712,7 @@ FILTER-ALIST is an alist of filters we need to apply when (let ((inhibit-read-only t)) (goto-char (point-min)) (save-excursion - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (save-excursion - (while (org-activate-plain-links (point-max)) + (while (org-activate-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link)))) (unless (eq org-agenda-remove-tags t) @@ -3694,8 +3721,8 @@ FILTER-ALIST is an alist of filters we need to apply when (remove-text-properties (point-min) (point-max) '(face nil))) (if (and (boundp 'org-agenda-overriding-columns-format) org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format - org-agenda-overriding-columns-format)) + (setq-local org-agenda-overriding-columns-format + org-agenda-overriding-columns-format)) (if (and (boundp 'org-agenda-view-columns-initially) org-agenda-view-columns-initially) (org-agenda-columns)) @@ -3733,10 +3760,10 @@ FILTER-ALIST is an alist of filters we need to apply when (org-agenda-filter-top-headline-apply org-agenda-top-headline-filter)) (when org-agenda-tag-filter - (org-agenda-filter-apply org-agenda-tag-filter 'tag)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag t)) (when (get 'org-agenda-tag-filter :preset-filter) (org-agenda-filter-apply - (get 'org-agenda-tag-filter :preset-filter) 'tag)) + (get 'org-agenda-tag-filter :preset-filter) 'tag t)) (when org-agenda-category-filter (org-agenda-filter-apply org-agenda-category-filter 'category)) (when (get 'org-agenda-category-filter :preset-filter) @@ -3747,13 +3774,18 @@ FILTER-ALIST is an alist of filters we need to apply when (when (get 'org-agenda-regexp-filter :preset-filter) (org-agenda-filter-apply (get 'org-agenda-regexp-filter :preset-filter) 'regexp)) - (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) + (when org-agenda-effort-filter + (org-agenda-filter-apply org-agenda-effort-filter 'effort)) + (when (get 'org-agenda-effort-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-effort-filter :preset-filter) 'effort)) + (add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) (defun org-agenda-mark-clocking-task () "Mark the current clock entry in the agenda if it is present." ;; We need to widen when `org-agenda-finalize' is called from ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in') - (when org-clock-current-task + (when (bound-and-true-p org-clock-current-task) (save-restriction (widen) (org-agenda-unmark-clocking-task) @@ -3782,7 +3814,7 @@ FILTER-ALIST is an alist of filters we need to apply when "Make highest priority lines bold, and lowest italic." (interactive) (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) - (delete-overlay o))) + (delete-overlay o))) (overlays-in (point-min) (point-max))) (save-excursion (let (b e p ov h l) @@ -3800,16 +3832,17 @@ FILTER-ALIST is an alist of filters we need to apply when ov (make-overlay b e)) (overlay-put ov 'face - (cons (cond ((org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-priority-faces)))) - ((and (listp org-agenda-fontify-priorities) - (org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-agenda-fontify-priorities))))) - ((equal p l) 'italic) - ((equal p h) 'bold)) - 'org-priority)) + (let ((special-face + (cond ((org-face-from-face-or-color + 'priority 'org-priority + (cdr (assoc p org-priority-faces)))) + ((and (listp org-agenda-fontify-priorities) + (org-face-from-face-or-color + 'priority 'org-priority + (cdr (assoc p org-agenda-fontify-priorities))))) + ((equal p l) 'italic) + ((equal p h) 'bold)))) + (if special-face (list special-face 'org-priority) 'org-priority))) (overlay-put ov 'org-type 'org-priority))))) (defvar org-depend-tag-blocked) @@ -3819,39 +3852,39 @@ FILTER-ALIST is an alist of filters we need to apply when When INVISIBLE is non-nil, hide currently blocked TODO instead of dimming them." (interactive "P") - (when (org-called-interactively-p 'interactive) + (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...")) - (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) - (delete-overlay o))) - (overlays-in (point-min) (point-max))) + (dolist (o (overlays-in (point-min) (point-max))) + (when (eq (overlay-get o 'org-type) 'org-blocked-todo) + (delete-overlay o))) (save-excursion (let ((inhibit-read-only t) (org-depend-tag-blocked nil) - (invis (or (not (null invisible)) - (eq org-agenda-dim-blocked-tasks 'invisible))) - org-blocked-by-checkboxes - invis1 b e p ov h l) + org-blocked-by-checkboxes) (goto-char (point-min)) - (while (let ((pos (next-single-property-change (point) 'todo-state))) - (and pos (goto-char (1+ pos)))) - (setq org-blocked-by-checkboxes nil invis1 invis) + (while (let ((pos (text-property-not-all + (point) (point-max) 'todo-state nil))) + (when pos (goto-char pos))) + (setq org-blocked-by-checkboxes nil) (let ((marker (org-get-at-bol 'org-hd-marker))) - (when (and marker + (when (and (markerp marker) (with-current-buffer (marker-buffer marker) (save-excursion (goto-char marker) (org-entry-blocked-p)))) - (if org-blocked-by-checkboxes (setq invis1 nil)) - (setq b (if invis1 - (max (point-min) (1- (point-at-bol))) - (point-at-bol)) - e (point-at-eol) - ov (make-overlay b e)) - (if invis1 - (progn (overlay-put ov 'invisible t) - (overlay-put ov 'intangible t)) - (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (overlay-put ov 'org-type 'org-blocked-todo)))))) - (when (org-called-interactively-p 'interactive) + ;; Entries blocked by checkboxes cannot be made invisible. + ;; See `org-agenda-dim-blocked-tasks' for details. + (let* ((really-invisible + (and (not org-blocked-by-checkboxes) + (or invisible (eq org-agenda-dim-blocked-tasks + 'invisible)))) + (ov (make-overlay (if really-invisible (line-end-position 0) + (line-beginning-position)) + (line-end-position)))) + (if really-invisible (overlay-put ov 'invisible t) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo)))) + (forward-line)))) + (when (called-interactively-p 'interactive) (message "Dim or hide blocked tasks...done"))) (defvar org-agenda-skip-function nil @@ -3908,9 +3941,9 @@ functions do." (defun org-agenda-new-marker (&optional pos) "Return a new agenda marker. -Org-mode keeps a list of these markers and resets them when they are -no longer in use." - (let ((m (copy-marker (or pos (point))))) +Maker is at point, or at POS if non-nil. Org mode keeps a list of +these markers and resets them when they are no longer in use." + (let ((m (copy-marker (or pos (point)) t))) (setq org-agenda-last-marker-time (float-time)) (if org-agenda-buffer (with-current-buffer org-agenda-buffer @@ -3972,13 +4005,12 @@ This check for agenda markers in all agenda buffers currently active." (defun org-agenda-get-day-face (date) "Return the face DATE should be displayed with." - (or (and (functionp org-agenda-day-face-function) - (funcall org-agenda-day-face-function date)) - (cond ((org-agenda-todayp date) - 'org-agenda-date-today) - ((member (calendar-day-of-week date) org-agenda-weekend-days) - 'org-agenda-date-weekend) - (t 'org-agenda-date)))) + (cond ((and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date))) + ((org-agenda-today-p date) 'org-agenda-date-today) + ((memq (calendar-day-of-week date) org-agenda-weekend-days) + 'org-agenda-date-weekend) + (t 'org-agenda-date))) ;;; Agenda timeline @@ -3986,12 +4018,16 @@ This check for agenda markers in all agenda buffers currently active." (defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defun org-timeline (&optional dotodo) - "Show a time-sorted view of the entries in the current org file. -Only entries with a time stamp of today or later will be listed. With -\\[universal-argument] prefix, all unfinished TODO items will also be shown, + "Show a time-sorted view of the entries in the current Org file. + +Only entries with a time stamp of today or later will be listed. + +With `\\[universal-argument]' prefix, all unfinished TODO items will also be \ +shown, under the current date. -If the buffer contains an active region, only check the region for -dates." + +If the buffer contains an active region, only check the region +for dates." (interactive "P") (let* ((dopast t) (org-agenda-show-log-scoped org-agenda-show-log) @@ -4160,13 +4196,14 @@ items if they have an hour specification like [h]h:mm." (catch 'exit (setq org-agenda-buffer-name (or org-agenda-buffer-tmp-name + (and org-agenda-doing-sticky-redo org-agenda-buffer-name) (if org-agenda-sticky (cond ((and org-keys (stringp org-match)) (format "*Org Agenda(%s:%s)*" org-keys org-match)) (org-keys (format "*Org Agenda(%s)*" org-keys)) (t "*Org Agenda(a)*"))) - org-agenda-buffer-name)) + "*Org Agenda*")) (org-agenda-prepare "Day/Week") (setq start-day (or start-day org-agenda-start-day)) (if (stringp start-day) @@ -4174,8 +4211,7 @@ items if they have an hour specification like [h]h:mm." (setq start-day (time-to-days (org-read-date nil t start-day)))) (org-compile-prefix-format 'agenda) (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) + (let* ((span (org-agenda-ndays-to-span (or span org-agenda-span))) (today (org-today)) (sd (or start-day today)) (ndays (org-agenda-span-to-ndays span sd)) @@ -4205,9 +4241,9 @@ items if they have an hour specification like [h]h:mm." (setq day-numbers (nreverse day-numbers)) (setq clocktable-start (car day-numbers) clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (setq-local org-starting-day (car day-numbers)) + (setq-local org-arg-loc arg) + (setq-local org-agenda-current-span (org-agenda-ndays-to-span span)) (unless org-agenda-compact-blocks (let* ((d1 (car day-numbers)) (d2 (org-last day-numbers)) @@ -4353,10 +4389,10 @@ START-DAY is an absolute time value." ((eq span 'fortnight) 14) ((eq span 'month) (let ((date (calendar-gregorian-from-absolute start-day))) - (calendar-last-day-of-month (car date) (caddr date)))) + (calendar-last-day-of-month (car date) (cl-caddr date)))) ((eq span 'year) (let ((date (calendar-gregorian-from-absolute start-day))) - (if (calendar-leap-year-p (caddr date)) 366 365))))) + (if (calendar-leap-year-p (cl-caddr date)) 366 365))))) (defun org-agenda-span-name (span) "Return a SPAN name." @@ -4371,7 +4407,7 @@ START-DAY is an absolute time value." (defvar org-agenda-search-history nil) (defvar org-search-syntax-table nil - "Special syntax table for org-mode search. + "Special syntax table for Org search. In this table, we have single quotes not as word constituents, to that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") @@ -4444,7 +4480,7 @@ in `org-agenda-text-search-extra-files'." (full-words org-agenda-search-view-force-full-words) (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) regexp rtn rtnall files file pos inherited-tags - marker category category-pos level tags c neg re boolean + marker category level tags c neg re boolean ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) (unless (and (not edit-at) (stringp string) @@ -4576,7 +4612,7 @@ in `org-agenda-text-search-extra-files'." (> (org-reduced-level (org-outline-level)) org-agenda-search-view-max-outline-level) (forward-line -1) - (outline-back-to-heading t))) + (org-back-to-heading t))) (skip-chars-forward "* ") (setq beg (point-at-bol) beg1 (point) @@ -4611,7 +4647,6 @@ in `org-agenda-text-search-extra-files'." (setq marker (org-agenda-new-marker (point)) category (org-get-category) level (make-string (org-reduced-level (org-outline-level)) ? ) - category-pos (get-text-property (point) 'org-category-position) inherited-tags (or (eq org-agenda-show-inherited-tags 'always) (and (listp org-agenda-show-inherited-tags) @@ -4630,8 +4665,7 @@ in `org-agenda-text-search-extra-files'." 'org-todo-regexp org-todo-regexp 'level level 'org-complex-heading-regexp org-complex-heading-regexp - 'priority 1000 'org-category category - 'org-category-position category-pos + 'priority 1000 'type "search") (push txt ee) (goto-char (1- end)))))))))) @@ -4648,8 +4682,12 @@ in `org-agenda-text-search-extra-files'." (add-text-properties pos (1- (point)) (list 'face 'org-warning)) (setq pos (point)) (unless org-agenda-multi - (insert (substitute-command-keys - "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")) + (insert (substitute-command-keys "\ +Press `\\[org-agenda-manipulate-query-add]', \ +`\\[org-agenda-manipulate-query-subtract]' to add/sub word, \ +`\\[org-agenda-manipulate-query-add-re]', \ +`\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \ +`\\[universal-argument] \\[org-agenda-redo]' to edit\n")) (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))) (org-agenda-mark-header-line (point-min)) @@ -4686,7 +4724,7 @@ in `org-agenda-text-search-extra-files'." (defun org-todo-list (&optional arg) "Show all (not done) TODO entries from all agenda file in a single list. The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted +the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in `org-todo-keywords-1'." (interactive "P") @@ -4704,8 +4742,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in rtn rtnall files file pos) (when (equal arg '(4)) (setq org-select-this-todo-keyword - (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) + (completing-read "Keyword (or KWD1|K2D2|...): " + (mapcar #'list kwds) nil nil))) (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) (catch 'exit (if org-agenda-sticky @@ -4743,7 +4781,8 @@ for a keyword. A numeric prefix directly selects the Nth keyword in org-select-this-todo-keyword)) (setq pos (point)) (unless org-agenda-multi - (insert (substitute-command-keys "Available with `N r': (0)[ALL]")) + (insert (substitute-command-keys "Available with \ +`N \\[org-agenda-redo]': (0)[ALL]")) (let ((n 0) s) (mapc (lambda (x) (setq s (format "(%d)%s" (setq n (1+ n)) x)) @@ -4779,6 +4818,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) + (org--matcher-tags-todo-only todo-only) rtn rtnall files file pos matcher buffer) (when (and (stringp match) (not (string-match "\\S-" match))) @@ -4794,13 +4834,15 @@ The prefix arg TODO-ONLY limits the search to TODO entries." ;; expanding tags within `org-make-tags-matcher' (org-agenda-prepare (concat "TAGS " match)) (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) + match (car matcher) + matcher (cdr matcher)) (org-compile-prefix-format 'tags) (org-set-sorting-strategy 'tags) (setq org-agenda-query-string match) (setq org-agenda-redo-command - (list 'org-tags-view `(quote ,todo-only) - (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) + (list 'org-tags-view + `(quote ,org--matcher-tags-todo-only) + `(if current-prefix-arg nil ,org-agenda-query-string))) (setq files (org-agenda-files nil 'ifmode) rtnall nil) (while (setq file (pop files)) @@ -4823,7 +4865,9 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (narrow-to-region org-agenda-restrict-begin org-agenda-restrict-end) (widen)) - (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtn (org-scan-tags 'agenda + matcher + org--matcher-tags-todo-only)) (setq rtnall (append rtnall rtn)))))))) (if org-agenda-overriding-header (insert (org-add-props (copy-sequence org-agenda-overriding-header) @@ -4839,18 +4883,21 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (setq pos (point)) (unless org-agenda-multi (insert (substitute-command-keys - "Press `C-u r' to search again with new search string\n"))) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + "Press `\\[universal-argument] \\[org-agenda-redo]' \ +to search again with new search string\n"))) + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure))) (org-agenda-mark-header-line (point-min)) (when rtnall (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) (goto-char (point-min)) (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type tags - org-last-args (,todo-only ,match) - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,org--matcher-tags-todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) (org-agenda-finalize) (setq buffer-read-only t)))) @@ -5038,50 +5085,53 @@ Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable `org-stuck-projects'." (interactive) - (let* ((org-agenda-skip-function - 'org-agenda-skip-entry-when-regexp-matches-in-subtree) - ;; We could have used org-agenda-skip-if here. - (org-agenda-overriding-header + (let* ((org-agenda-overriding-header (or org-agenda-overriding-header "List of stuck projects: ")) (matcher (nth 0 org-stuck-projects)) (todo (nth 1 org-stuck-projects)) - (todo-wds (if (member "*" todo) - (progn - (org-agenda-prepare-buffers (org-agenda-files - nil 'ifmode)) - (org-delete-all - org-done-keywords-for-agenda - (copy-sequence org-todo-keywords-for-agenda))) - todo)) - (todo-re (concat "^\\*+[ \t]+\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) (tags (nth 2 org-stuck-projects)) - (tags-re (if (member "*" tags) - (concat org-outline-regexp-bol - (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) - (if tags - (concat org-outline-regexp-bol - ".*:\\(" - (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) - (gen-re (nth 3 org-stuck-projects)) - (re-list - (delq nil - (list - (if todo todo-re) - (if tags tags-re) - (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) - gen-re))))) - (setq org-agenda-skip-regexp - (if re-list - (mapconcat 'identity re-list "\\|") - (error "No information how to identify unstuck projects"))) + (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) + (todo-wds + (if (not (member "*" todo)) todo + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (org-delete-all org-done-keywords-for-agenda + (copy-sequence org-todo-keywords-for-agenda)))) + (todo-re (and todo + (format "^\\*+[ \t]+\\(%s\\)\\>" + (mapconcat #'identity todo-wds "\\|")))) + (tags-re (cond ((null tags) nil) + ((member "*" tags) + (eval-when-compile + (concat org-outline-regexp-bol + ".*:[[:alnum:]_@#%]+:[ \t]*$"))) + (tags (concat org-outline-regexp-bol + ".*:\\(" + (mapconcat #'identity tags "\\|") + "\\):[[:alnum:]_@#%:]*[ \t]*$")) + (t nil))) + (re-list (delq nil (list todo-re tags-re gen-re))) + (skip-re + (if (null re-list) + (error "Missing information to identify unstuck projects") + (mapconcat #'identity re-list "\\|"))) + (org-agenda-skip-function + ;; Skip entry if `org-agenda-skip-regexp' matches anywhere + ;; in the subtree. + `(lambda () + (and (save-excursion + (let ((case-fold-search nil)) + (re-search-forward + ,skip-re (save-excursion (org-end-of-subtree t)) t))) + (progn (outline-next-heading) (point)))))) (org-tags-view nil matcher) (setq org-agenda-buffer-name (buffer-name)) (with-current-buffer org-agenda-buffer-name (setq org-agenda-redo-command - `(org-agenda-list-stuck-projects ,current-prefix-arg))))) + `(org-agenda-list-stuck-projects ,current-prefix-arg)) + (let ((inhibit-read-only t)) + (add-text-properties + (point-min) (point-max) + `(org-redo-cmd ,org-agenda-redo-command)))))) ;;; Diary integration @@ -5159,7 +5209,7 @@ date. It also removes lines that contain only whitespace." (while (re-search-forward "^ +\n" nil t) (replace-match "")) (goto-char (point-min)) - (if (re-search-forward "^Org-mode dummy\n?" nil t) + (if (re-search-forward "^Org mode dummy\n?" nil t) (replace-match "")) (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) @@ -5177,7 +5227,7 @@ date. It also removes lines that contain only whitespace." (setq string (org-modify-diary-entry-string string)))))) (defun org-modify-diary-entry-string (string) - "Add text properties to string, allowing org-mode to act on it." + "Add text properties to string, allowing Org to act on it." (org-add-props string nil 'mouse-face 'highlight 'help-echo (if buffer-file-name @@ -5193,9 +5243,9 @@ Needed to avoid empty dates which mess up holiday display." ;; Catch the error if dealing with the new add-to-diary-alist (when org-disable-agenda-to-diary (condition-case nil - (org-add-to-diary-list original-date "Org-mode dummy" "") + (org-add-to-diary-list original-date "Org mode dummy" "") (error - (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) + (org-add-to-diary-list original-date "Org mode dummy" "" nil))))) (defun org-add-to-diary-list (&rest args) (if (fboundp 'diary-add-to-list) @@ -5265,67 +5315,77 @@ function from a program - use `org-agenda-get-day-entries' instead." ;;; Agenda entry finders +(defun org-agenda--timestamp-to-absolute (&rest args) + "Call `org-time-string-to-absolute' with ARGS. +However, throw `:skip' whenever an error is raised." + (condition-case e + (apply #'org-time-string-to-absolute args) + (org-diary-sexp-no-match (throw :skip nil)) + (error + (message "%s; Skipping entry" (error-message-string e)) + (throw :skip nil)))) + (defun org-agenda-get-day-entries (file date &rest args) "Does the work for `org-diary' and `org-agenda'. FILE is the path to a file to be checked for entries. DATE is date like the one returned by `calendar-current-date'. ARGS are symbols indicating which kind of entries should be extracted. For details about these, see the documentation of `org-diary'." - (setq args (or args org-agenda-entry-types)) (let* ((org-startup-folded nil) (org-startup-align-all-tables nil) - (buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - arg results rtn deadline-results) + (buffer (if (file-exists-p file) (org-get-agenda-file-buffer file) + (error "No such file %s" file)))) (if (not buffer) - ;; If file does not exist, make sure an error message ends up in diary + ;; If file does not exist, signal it in diary nonetheless. (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) (with-current-buffer buffer (unless (derived-mode-p 'org-mode) (error "Agenda file %s is not in `org-mode'" file)) (setq org-agenda-buffer (or org-agenda-buffer buffer)) - (let ((case-fold-search nil)) - (save-excursion - (save-restriction - (if (eq buffer org-agenda-restrict) - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - ;; The way we repeatedly append to `results' makes it O(n^2) :-( - (while (setq arg (pop args)) - (cond - ((and (eq arg :todo) - (equal date (calendar-gregorian-from-absolute - (org-today)))) - (setq rtn (org-agenda-get-todos)) - (setq results (append results rtn))) - ((eq arg :timestamp) - (setq rtn (org-agenda-get-blocks)) - (setq results (append results rtn)) - (setq rtn (org-agenda-get-timestamps deadline-results)) - (setq results (append results rtn))) - ((eq arg :sexp) - (setq rtn (org-agenda-get-sexps)) - (setq results (append results rtn))) - ((eq arg :scheduled) - (setq rtn (org-agenda-get-scheduled deadline-results)) - (setq results (append results rtn))) - ((eq arg :scheduled*) - (setq rtn (org-agenda-get-scheduled deadline-results t)) - (setq results (append results rtn))) - ((eq arg :closed) - (setq rtn (org-agenda-get-progress)) - (setq results (append results rtn))) - ((eq arg :deadline) - (setq rtn (org-agenda-get-deadlines)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn))) - ((eq arg :deadline*) - (setq rtn (org-agenda-get-deadlines t)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn)))))))) - results)))) + (setf org-agenda-current-date date) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + ;; Rationalize ARGS. Also make sure `:deadline' comes + ;; first in order to populate DEADLINES before passing it. + ;; + ;; We use `delq' since `org-uniquify' duplicates ARGS, + ;; guarding us from modifying `org-agenda-entry-types'. + (setf args (org-uniquify (or args org-agenda-entry-types))) + (when (and (memq :scheduled args) (memq :scheduled* args)) + (setf args (delq :scheduled* args))) + (cond + ((memq :deadline args) + (setf args (cons :deadline + (delq :deadline (delq :deadline* args))))) + ((memq :deadline* args) + (setf args (cons :deadline* (delq :deadline* args))))) + ;; Collect list of headlines. Return them flattened. + (let ((case-fold-search nil) results deadlines) + (dolist (arg args (apply #'nconc (nreverse results))) + (pcase arg + ((and :todo (guard (org-agenda-today-p date))) + (push (org-agenda-get-todos) results)) + (:timestamp + (push (org-agenda-get-blocks) results) + (push (org-agenda-get-timestamps deadlines) results)) + (:sexp + (push (org-agenda-get-sexps) results)) + (:scheduled + (push (org-agenda-get-scheduled deadlines) results)) + (:scheduled* + (push (org-agenda-get-scheduled deadlines t) results)) + (:closed + (push (org-agenda-get-progress) results)) + (:deadline + (setf deadlines (org-agenda-get-deadlines)) + (push deadlines results)) + (:deadline* + (setf deadlines (org-agenda-get-deadlines t)) + (push deadlines results))))))))))) (defsubst org-em (x y list) "Is X or Y a member of LIST?" @@ -5334,6 +5394,40 @@ the documentation of `org-diary'." (defvar org-heading-keyword-regexp-format) ; defined in org.el (defvar org-agenda-sorting-strategy-selected nil) +(defun org-agenda-entry-get-agenda-timestamp (pom) + "Retrieve timestamp information for sorting agenda views. +Given a point or marker POM, returns a cons cell of the timestamp +and the timestamp type relevant for the sorting strategy in +`org-agenda-sorting-strategy-selected'." + (let (ts ts-date-type) + (save-match-data + (cond ((org-em 'scheduled-up 'scheduled-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "SCHEDULED") + ts-date-type " scheduled")) + ((org-em 'deadline-up 'deadline-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "DEADLINE") + ts-date-type " deadline")) + ((org-em 'ts-up 'ts-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "TIMESTAMP") + ts-date-type " timestamp")) + ((org-em 'tsia-up 'tsia-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get pom "TIMESTAMP_IA") + ts-date-type " timestamp_ia")) + ((org-em 'timestamp-up 'timestamp-down + org-agenda-sorting-strategy-selected) + (setq ts (or (org-entry-get pom "SCHEDULED") + (org-entry-get pom "DEADLINE") + (org-entry-get pom "TIMESTAMP") + (org-entry-get pom "TIMESTAMP_IA")) + ts-date-type "")) + (t (setq ts-date-type ""))) + (cons (when ts (ignore-errors (org-time-string-to-absolute ts))) + ts-date-type)))) + (defun org-agenda-get-todos () "Return the TODO information for agenda display." (let* ((props (list 'face nil @@ -5345,6 +5439,7 @@ the documentation of `org-diary'." 'help-echo (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) + (case-fold-search nil) (regexp (format org-heading-keyword-regexp-format (cond ((and org-select-this-todo-keyword @@ -5358,7 +5453,8 @@ the documentation of `org-diary'." "|") "\\|") "\\)")) (t org-not-done-regexp)))) - marker priority category category-pos level tags todo-state ts-date ts-date-type + marker priority category level tags todo-state + ts-date ts-date-type ts-date-pair ee txt beg end inherited-tags todo-state-end-pos) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5378,36 +5474,10 @@ the documentation of `org-diary'." (goto-char (match-beginning 2)) (setq marker (org-agenda-new-marker (match-beginning 0)) category (org-get-category) - ts-date (let (ts) - (save-match-data - (cond ((org-em 'scheduled-up 'scheduled-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "SCHEDULED") - ts-date-type " scheduled")) - ((org-em 'deadline-up 'deadline-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "DEADLINE") - ts-date-type " deadline")) - ((org-em 'ts-up 'ts-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "TIMESTAMP") - ts-date-type " timestamp")) - ((org-em 'tsia-up 'tsia-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "TIMESTAMP_IA") - ts-date-type " timestamp_ia")) - ((org-em 'timestamp-up 'timestamp-down - org-agenda-sorting-strategy-selected) - (setq ts (or (org-entry-get (point) "SCHEDULED") - (org-entry-get (point) "DEADLINE") - (org-entry-get (point) "TIMESTAMP") - (org-entry-get (point) "TIMESTAMP_IA")) - ts-date-type "")) - (t (setq ts-date-type ""))) - (when ts (ignore-errors (org-time-string-to-absolute ts))))) - category-pos (get-text-property (point) 'org-category-position) - txt (org-trim - (buffer-substring (match-beginning 2) (match-end 0))) + ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) + ts-date (car ts-date-pair) + ts-date-type (cdr ts-date-pair) + txt (org-trim (buffer-substring (match-beginning 2) (match-end 0))) inherited-tags (or (eq org-agenda-show-inherited-tags 'always) (and (listp org-agenda-show-inherited-tags) @@ -5421,10 +5491,9 @@ the documentation of `org-diary'." priority (1+ (org-get-priority txt))) (org-add-props txt props 'org-marker marker 'org-hd-marker marker - 'priority priority 'org-category category + 'priority priority 'level level 'ts-date ts-date - 'org-category-position category-pos 'type (concat "todo" ts-date-type) 'todo-state todo-state) (push txt ee) (if org-agenda-todo-list-sublevels @@ -5473,7 +5542,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (cond ((memq org-agenda-todo-ignore-deadlines '(t all)) t) ((eq org-agenda-todo-ignore-deadlines 'far) - (not (org-deadline-close (match-string 1)))) + (not (org-deadline-close-p (match-string 1)))) ((eq org-agenda-todo-ignore-deadlines 'future) (> (org-time-stamp-to-now (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) @@ -5483,7 +5552,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', ((numberp org-agenda-todo-ignore-deadlines) (org-agenda-todo-custom-ignore-p (match-string 1) org-agenda-todo-ignore-deadlines)) - (t (org-deadline-close (match-string 1))))) + (t (org-deadline-close-p (match-string 1))))) (and org-agenda-todo-ignore-timestamp (let ((buffer (current-buffer)) (regexp @@ -5512,24 +5581,27 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (match-string 1) org-agenda-todo-ignore-timestamp)) (t)))))))))) -(defun org-agenda-get-timestamps (&optional deadline-results) - "Return the date stamp information for agenda display." +(defun org-agenda-get-timestamps (&optional deadlines) + "Return the date stamp information for agenda display. +Optional argument DEADLINES is a list of deadline items to be +displayed in agenda view." (let* ((props (list 'face 'org-agenda-calendar-event 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'mouse-face 'highlight 'help-echo - (format "mouse-2 or RET jump to org file %s" + (format "mouse-2 or RET jump to Org file %s" (abbreviate-file-name buffer-file-name)))) - (d1 (calendar-absolute-from-gregorian date)) - mm + (current (calendar-absolute-from-gregorian date)) + (today (org-today)) (deadline-position-alist - (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) - deadline-results)) - (remove-re org-ts-regexp) + (mapcar (lambda (d) + (let ((m (get-text-property 0 'org-hd-marker d))) + (and m (marker-position m)))) + deadlines)) + ;; Match time-stamps set to current date, time-stamps with + ;; a repeater, and S-exp time-stamps. (regexp (concat (if org-agenda-include-inactive-timestamps "[[<]" "<") @@ -5537,97 +5609,106 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (substring (format-time-string (car org-time-stamp-formats) - (apply 'encode-time ; DATE bound by calendar + (apply #'encode-time ; DATE bound by calendar (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)) "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) - marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category category-pos level ee txt timestr tags - b0 b3 e3 head todo-state end-of-match show-all warntime habitp - inherited-tags ts-date) + timestamp-items) (goto-char (point-min)) - (while (setq end-of-match (re-search-forward regexp nil t)) - (setq b0 (match-beginning 0) - b3 (match-beginning 3) e3 (match-end 3) - todo-state (save-match-data (ignore-errors (org-get-todo-state))) - habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p))) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all))) + (while (re-search-forward regexp nil t) + ;; Skip date ranges, scheduled and deadlines, which are handled + ;; specially. Also skip time-stamps before first headline as + ;; there would be no entry to add to the agenda. Eventually, + ;; ignore clock entries. (catch :skip - (and (org-at-date-range-p) (throw :skip nil)) - (org-agenda-skip) - (if (and (match-end 1) - (not (= d1 (org-time-string-to-absolute - (match-string 1) d1 nil show-all - (current-buffer) b0)))) - (throw :skip nil)) - (if (and e3 - (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) + (save-match-data + (when (or (org-at-date-range-p) + (org-at-planning-p) + (org-before-first-heading-p) + (and org-agenda-include-inactive-timestamps + (org-at-clock-log-p))) (throw :skip nil)) - (setq tmp (buffer-substring (max (point-min) - (- b0 org-ds-keyword-length)) - b0) - timestr (if b3 "" (buffer-substring b0 (point-at-eol))) - inactivep (= (char-after b0) ?\[) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - closedp (and org-agenda-include-inactive-timestamps - (string-match org-closed-string tmp)) - clockp (and org-agenda-include-inactive-timestamps - (or (string-match org-clock-string tmp) - (string-match "]-+\\'" tmp))) - warntime (get-text-property (point) 'org-appt-warntime) - donep (member todo-state org-done-keywords)) - (if (or scheduledp deadlinep closedp clockp - (and donep org-agenda-skip-timestamp-if-done)) + (org-agenda-skip)) + (let* ((pos (match-beginning 0)) + (repeat (match-string 1)) + (sexp-entry (match-string 3)) + (time-stamp (if (or repeat sexp-entry) (match-string 0) + (save-excursion + (goto-char pos) + (looking-at org-ts-regexp-both) + (match-string 0)))) + (todo-state (org-get-todo-state)) + (show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + (warntime (get-text-property (point) 'org-appt-warntime)) + (done? (member todo-state org-done-keywords))) + ;; Possibly skip done tasks. + (when (and done? org-agenda-skip-timestamp-if-done) (throw :skip t)) - (if (string-match ">" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (setq marker (org-agenda-new-marker b0) - category (org-get-category b0) - category-pos (get-text-property b0 'org-category-position)) - (save-excursion - (if (not (re-search-backward org-outline-regexp-bol nil t)) - (throw :skip nil) - (goto-char (match-beginning 0)) - (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) - (assoc (point) deadline-position-alist)) - (throw :skip nil)) - (setq hdmarker (org-agenda-new-marker) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (or (match-string 1) "")) - (setq txt (org-agenda-format-item - (if inactivep org-agenda-inactive-leader nil) - head level category tags timestr - remove-re habitp))) - (setq priority (org-get-priority txt)) - (org-add-props txt props 'priority priority - 'org-marker marker 'org-hd-marker hdmarker - 'org-category category 'date date - 'level level - 'ts-date - (ignore-errors (org-time-string-to-absolute timestr)) - 'org-category-position category-pos - 'todo-state todo-state - 'warntime warntime - 'type "timestamp") - (push txt ee)) - (if org-agenda-skip-additional-timestamps-same-entry - (outline-next-heading) - (goto-char end-of-match)))) - (nreverse ee))) + ;; S-exp entry doesn't match current day: skip it. + (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date))) + (throw :skip nil)) + ;; When time-stamp doesn't match CURRENT but has a repeater, + ;; make sure it repeats on CURRENT. Furthermore, if + ;; SHOW-ALL is nil, ensure that repeats are only the first + ;; before and the first after today. + (when (and repeat + (if show-all + (/= current + (org-agenda--timestamp-to-absolute + repeat current 'future (current-buffer) pos)) + (and (/= current + (org-agenda--timestamp-to-absolute + repeat today 'past (current-buffer) pos)) + (/= current + (org-agenda--timestamp-to-absolute + repeat today 'future (current-buffer) pos))))) + (throw :skip nil)) + (save-excursion + (re-search-backward org-outline-regexp-bol nil t) + ;; Possibly skip time-stamp when a deadline is set. + (when (and org-agenda-skip-timestamp-if-deadline-is-shown + (assq (point) deadline-position-alist)) + (throw :skip nil)) + (let* ((category (org-get-category pos)) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (consp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags-at nil (not inherited-tags))) + (level (make-string (org-reduced-level (org-outline-level)) + ?\s)) + (head (and (looking-at "\\*+[ \t]+\\(.*\\)") + (match-string 1))) + (inactive? (= (char-after pos) ?\[)) + (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p))) + (item + (org-agenda-format-item + (and inactive? org-agenda-inactive-leader) + head level category tags time-stamp org-ts-regexp habit?))) + (org-add-props item props + 'priority (if habit? + (org-habit-get-priority (org-habit-parse-todo)) + (org-get-priority item)) + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker) + 'date date + 'level level + 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat) + current) + 'todo-state todo-state + 'warntime warntime + 'type "timestamp") + (push item timestamp-items)))) + (when org-agenda-skip-additional-timestamps-same-entry + (outline-next-heading)))) + (nreverse timestamp-items))) (defun org-agenda-get-sexps () "Return the sexp information for agenda display." @@ -5638,7 +5719,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (format "mouse-2 or RET jump to org file %s" (abbreviate-file-name buffer-file-name)))) (regexp "^&?%%(") - marker category extra category-pos level ee txt tags entry + marker category extra level ee txt tags entry result beg b sexp sexp-entry todo-state warntime inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5657,7 +5738,6 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq marker (org-agenda-new-marker beg) level (make-string (org-reduced-level (org-outline-level)) ? ) category (org-get-category beg) - category-pos (get-text-property beg 'org-category-position) inherited-tags (or (eq org-agenda-show-inherited-tags 'always) (and (listp org-agenda-show-inherited-tags) @@ -5682,38 +5762,33 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (setq txt "SEXP entry returned empty string")) (setq txt (org-agenda-format-item extra txt level category tags 'time)) (org-add-props txt props 'org-marker marker - 'org-category category 'date date 'todo-state todo-state - 'org-category-position category-pos - 'level level - 'type "sexp" 'warntime warntime) + 'date date 'todo-state todo-state + 'level level 'type "sexp" 'warntime warntime) (push txt ee))))) (nreverse ee))) ;; Calendar sanity: define some functions that are independent of ;; `calendar-date-style'. -;; Normally I would like to use ISO format when calling the diary functions, -;; but to make sure we still have Emacs 22 compatibility we bind -;; also `european-calendar-style' and use european format (defun org-anniversary (year month day &optional mark) "Like `diary-anniversary', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-anniversary day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-anniversary year month day mark)))) (defun org-cyclic (N year month day &optional mark) "Like `diary-cyclic', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-cyclic N day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-cyclic N year month day mark)))) (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) "Like `diary-block', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-block D1 M1 Y1 D2 M2 Y2 mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-block Y1 M1 D1 Y2 M2 D2 mark)))) (defun org-date (year month day &optional mark) "Like `diary-date', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-date day month year mark)))) + (with-no-warnings + (let ((calendar-date-style 'iso)) + (diary-date year month day mark)))) ;; Define the `org-class' function (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) @@ -5740,26 +5815,6 @@ then those holidays will be skipped." (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) entry))) -(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) - "Like `org-class', but honor `calendar-date-style'. -The order of the first 2 times 3 arguments depends on the variable -`calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for American calendars, give this as MONTH DAY YEAR, for European as -DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. -DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS -is any number of ISO weeks in the block period for which the item should -be skipped. - -This function is here only for backward compatibility and it is deprecated, -please use `org-class' instead." - (let* ((date1 (org-order-calendar-date-args m1 d1 y1)) - (date2 (org-order-calendar-date-args m2 d2 y2))) - (org-class - (nth 2 date1) (car date1) (nth 1 date1) - (nth 2 date2) (car date2) (nth 1 date2) - dayname skip-weeks))) -(make-obsolete 'org-diary-class 'org-class "") - (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." @@ -5794,7 +5849,7 @@ please use `org-class' instead." (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) 1 11)))) (org-agenda-search-headline-for-time nil) - marker hdmarker priority category category-pos level tags closedp + marker hdmarker priority category level tags closedp statep clockp state ee txt extra timestr rest clocked inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -5806,7 +5861,6 @@ please use `org-class' instead." clockp (not (or closedp statep)) state (and statep (match-string 2)) category (org-get-category (match-beginning 0)) - category-pos (get-text-property (match-beginning 0) 'org-category-position) timestr (buffer-substring (match-beginning 0) (point-at-eol))) (when (string-match "\\]" timestr) ;; substring should only run to end of time stamp @@ -5858,9 +5912,7 @@ please use `org-class' instead." (setq priority 100000) (org-add-props txt props 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done - 'priority priority 'org-category category - 'org-category-position category-pos - 'level level + 'priority priority 'level level 'type "closed" 'date date 'undone-face 'org-warning 'done-face 'org-agenda-done) (push txt ee)) @@ -5876,7 +5928,7 @@ See also the user option `org-agenda-clock-consistency-checks'." (re (concat "^[ \t]*" org-clock-string "[ \t]+" - "\\(\\[.*?\\]\\)" ; group 1 is first stamp + "\\(\\[.*?\\]\\)" ; group 1 is first stamp "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second (tlstart 0.) (tlend 0.) @@ -5913,9 +5965,9 @@ See also the user option `org-agenda-clock-consistency-checks'." (setq ts (match-string 1) te (match-string 3) ts (float-time - (apply 'encode-time (org-parse-time-string ts))) + (apply #'encode-time (org-parse-time-string ts))) te (float-time - (apply 'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te))) dt (- te ts)))) (cond ((> dt (* 60 maxtime)) @@ -6001,312 +6053,348 @@ specification like [h]h:mm." (regexp (if with-hour org-deadline-time-hour-regexp org-deadline-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - (dl0 (car org-agenda-deadline-leaders)) - (dl1 (nth 1 org-agenda-deadline-leaders)) - (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) - d2 diff dfrac wdays pos pos1 category category-pos level - tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr warntime inherited-tags ts-date) + (today (org-today)) + (today? (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + deadline-items) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1)) - (setq suppress-prewarning - (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled - (let ((item (buffer-substring (point-at-bol) - (point-at-eol)))) - (save-match-data - (and (string-match - org-scheduled-time-regexp item) - (match-string 1 item))))))) - (cond - ((not ds) nil) - ;; The current item has a scheduled date (in ds), so - ;; evaluate its prewarning lead time. - ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) - ;; Use global prewarning-restart lead time. - org-agenda-skip-deadline-prewarning-if-scheduled) - ((eq org-agenda-skip-deadline-prewarning-if-scheduled - 'pre-scheduled) - ;; Set prewarning to no earlier than scheduled. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-deadline-warning-days)) - ;; Set prewarning to deadline. - (t 0)))) - (setq wdays (if suppress-prewarning - (let ((org-deadline-warning-days suppress-prewarning)) - (org-get-wdays s)) - (org-get-wdays s)) - dfrac (- 1 (/ (* 1.0 diff) (max wdays 1))) - upcomingp (and todayp (> diff 0))) - ;; When to show a deadline in the calendar: - ;; If the expiration is within wdays warning time. - ;; Past-due deadlines are only shown on the current date - (if (and (or (and (<= diff wdays) - (and todayp (not org-agenda-only-exact-dates))) - (= diff 0))) - (save-excursion - ;; (setq todo-state (org-get-todo-state)) - (setq donep (member todo-state org-done-keywords)) - (if (and donep - (or org-agenda-skip-deadline-if-done - (not (= diff 0)))) - (setq txt nil) - (setq category (org-get-category) - warntime (get-text-property (point) 'org-appt-warntime) - category-pos (get-text-property (point) 'org-category-position)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at pos1 (not inherited-tags))) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (cond ((= diff 0) dl0) - ((> diff 0) - (if (functionp dl1) - (funcall dl1 diff date) - (format dl1 diff))) - (t - (if (functionp dl2) - (funcall dl2 diff date) - (format dl2 (if (string= dl2 dl1) - diff (abs diff)))))) - head level category tags - (if (not (= diff 0)) nil timestr))))) - (when txt - (setq face (org-agenda-deadline-face dfrac)) - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'warntime warntime - 'level level - 'ts-date d2 - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- diff) - (org-get-priority txt)) - 'org-category category - 'org-category-position category-pos - 'todo-state todo-state - 'type (if upcomingp "upcoming-deadline" "deadline") - 'date (if upcomingp date d2) - 'face (if donep 'org-agenda-done face) - 'undone-face face 'done-face 'org-agenda-done) - (push txt ee)))))) - (nreverse ee))) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (done? (member todo-state org-done-keywords)) + (show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + (sexp? (string-prefix-p "%%" s)) + ;; DEADLINE is the bare deadline date, i.e., without + ;; any repeater, or the last repeat if SHOW-ALL is + ;; non-nil. REPEAT is closest repeat after CURRENT, if + ;; all repeated time stamps are to be shown, or after + ;; TODAY otherwise. REPEAT only applies to future + ;; dates. + (deadline (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + (show-all (org-agenda--timestamp-to-absolute s)) + (t (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)))) + (repeat (cond (sexp? deadline) + ((< current today) deadline) + (t + (org-agenda--timestamp-to-absolute + s (if show-all current today) 'future + (current-buffer) pos)))) + (diff (- deadline current)) + (suppress-prewarning + (let ((scheduled + (and org-agenda-skip-deadline-prewarning-if-scheduled + (org-entry-get nil "SCHEDULED")))) + (cond + ((not scheduled) nil) + ;; The current item has a scheduled date, so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set pre-warning to no earlier than SCHEDULED. + (min (- deadline + (org-agenda--timestamp-to-absolute scheduled)) + org-deadline-warning-days)) + ;; Set pre-warning to deadline. + (t 0)))) + (wdays (if suppress-prewarning + (let ((org-deadline-warning-days suppress-prewarning)) + (org-get-wdays s)) + (org-get-wdays s)))) + ;; When to show a deadline in the calendar: if the + ;; expiration is within WDAYS warning time. Past-due + ;; deadlines are only shown on today agenda. + (when (cond ((= current deadline) nil) + ((< deadline today) + (and (not today?) + (or (< current today) (/= repeat current)))) + ((> deadline current) + (or (not today?) (> diff wdays))) + (t (/= repeat current))) + (throw :skip nil)) + ;; Possibly skip done tasks. + (when (and done? + (or org-agenda-skip-deadline-if-done + (/= deadline current))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (level + (make-string (org-reduced-level (org-outline-level)) ?\s)) + (head (buffer-substring (point) (line-end-position))) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags-at nil (not inherited-tags))) + (time + (cond + ;; No time of day designation if it is only + ;; a reminder. + ((and (/= current deadline) (/= current repeat)) nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + ;; Insert appropriate suffixes before deadlines. + (pcase-let ((`(,now ,future ,past) + org-agenda-deadline-leaders)) + (cond + ;; Future (i.e., repeated) deadlines are + ;; displayed as new headlines. + ((> current today) now) + ;; When SHOW-ALL is nil, prefer repeated + ;; deadlines over reminders of past deadlines. + ((and (not show-all) (= repeat today)) now) + ((= deadline current) now) + ((< deadline current) (format past (- diff))) + (t (format future diff)))) + head level category tags + (and (or (= repeat current) (= deadline current)) + time))) + (face (org-agenda-deadline-face + (- 1 (/ (float (- deadline current)) (max wdays 1))))) + (upcoming? (and today? (> deadline today))) + (warntime (get-text-property (point) 'org-appt-warntime))) + (org-add-props item props + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) + 'warntime warntime + 'level level + 'ts-date deadline + 'priority + ;; Adjust priority to today reminders about deadlines. + ;; Overdue deadlines get the highest priority + ;; increase, then imminent deadlines and eventually + ;; more distant deadlines. + (let ((adjust (cond ((not today?) 0) + ((and (not show-all) (= repeat current)) 0) + (t (- diff))))) + (+ adjust (org-get-priority item))) + 'todo-state todo-state + 'type (if upcoming? "upcoming-deadline" "deadline") + 'date (if upcoming? date deadline) + 'face (if done? 'org-agenda-done face) + 'undone-face face + 'done-face 'org-agenda-done) + (push item deadline-items)))))) + (nreverse deadline-items))) (defun org-agenda-deadline-face (fraction) "Return the face to displaying a deadline item. FRACTION is what fraction of the head-warning time has passed." - (let ((faces org-agenda-deadline-faces) f) - (catch 'exit - (while (setq f (pop faces)) - (if (>= fraction (car f)) (throw 'exit (cdr f))))))) + (assoc-default fraction org-agenda-deadline-faces #'<=)) -(defun org-agenda-get-scheduled (&optional deadline-results with-hour) +(defun org-agenda-get-scheduled (&optional deadlines with-hour) "Return the scheduled information for agenda display. -When WITH-HOUR is non-nil, only return scheduled items with -an hour specification like [h]h:mm." +Optional argument DEADLINES is a list of deadline items to be +displayed in agenda view. When WITH-HOUR is non-nil, only return +scheduled items with an hour specification like [h]h:mm." (let* ((props (list 'org-not-done-regexp org-not-done-regexp 'org-todo-regexp org-todo-regexp 'org-complex-heading-regexp org-complex-heading-regexp 'done-face 'org-agenda-done 'mouse-face 'highlight 'help-echo - (format "mouse-2 or RET jump to org file %s" + (format "mouse-2 or RET jump to Org file %s" (abbreviate-file-name buffer-file-name)))) (regexp (if with-hour org-scheduled-time-hour-regexp org-scheduled-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - mm - (deadline-position-alist - (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) - deadline-results)) - d2 diff pos pos1 category category-pos level tags donep - ee txt head pastschedp todo-state face timestr s habitp show-all - did-habit-check-p warntime inherited-tags ts-date suppress-delay - ddays) + (today (org-today)) + (todayp (org-agenda-today-p date)) ; DATE bound by calendar. + (current (calendar-absolute-from-gregorian date)) + (deadline-pos + (mapcar (lambda (d) + (let ((m (get-text-property 0 'org-hd-marker d))) + (and m (marker-position m)))) + deadlines)) + scheduled-items) (goto-char (point-min)) (while (re-search-forward regexp nil t) (catch :skip + (unless (save-match-data (org-at-planning-p)) (throw :skip nil)) (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1) - warntime (get-text-property (point) 'org-appt-warntime)) - (setq pastschedp (and todayp (< diff 0))) - (setq did-habit-check-p nil) - (setq suppress-delay - (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline - (let ((item (buffer-substring (point-at-bol) (point-at-eol)))) - (save-match-data - (and (string-match - org-deadline-time-regexp item) - (match-string 1 item))))))) + (let* ((s (match-string 1)) + (pos (1- (match-beginning 1))) + (todo-state (save-match-data (org-get-todo-state))) + (donep (member todo-state org-done-keywords)) + (show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + (sexp? (string-prefix-p "%%" s)) + ;; SCHEDULE is the bare scheduled date, i.e., without + ;; any repeater if non-nil, or last repeat if SHOW-ALL + ;; is nil. REPEAT is the closest repeat after CURRENT, + ;; if all repeated time stamps are to be shown, or + ;; after TODAY otherwise. REPEAT only applies to + ;; future dates. + (schedule (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + (show-all (org-agenda--timestamp-to-absolute s)) + (t (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)))) + (repeat (cond + (sexp? schedule) + ((< current today) schedule) + (t + (org-agenda--timestamp-to-absolute + s (if show-all current today) 'future + (current-buffer) pos)))) + (diff (- current schedule)) + (warntime (get-text-property (point) 'org-appt-warntime)) + (pastschedp (< schedule today)) + (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p))) + (suppress-delay + (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline + (org-entry-get nil "DEADLINE")))) + (cond + ((not deadline) nil) + ;; The current item has a deadline date, so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than DEADLINE. + (min (- schedule + (org-agenda--timestamp-to-absolute deadline)) + org-scheduled-delay-days)) + (t 0)))) + (ddays (cond - ((not ds) nil) - ;; The current item has a deadline date (in ds), so - ;; evaluate its delay time. - ((integerp org-agenda-skip-scheduled-delay-if-deadline) - ;; Use global delay time. - (- org-agenda-skip-scheduled-delay-if-deadline)) - ((eq org-agenda-skip-scheduled-delay-if-deadline - 'post-deadline) - ;; Set delay to no later than deadline. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-scheduled-delay-days)) - (t 0)))) - (setq ddays (if suppress-delay - (let ((org-scheduled-delay-days suppress-delay)) - (org-get-wdays s t t)) - (org-get-wdays s t))) - ;; Use a delay of 0 when there is a repeater and the delay is - ;; of the form --3d - (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s)) - (< (org-time-string-to-absolute s) - (org-time-string-to-absolute - s d2 'past nil (current-buffer) pos))) - (setq ddays 0)) - ;; When to show a scheduled item in the calendar: - ;; If it is on or past the date. - (when (or (and (> ddays 0) (= diff (- ddays))) - (and (zerop ddays) (= diff 0)) - (and (< (+ diff ddays) 0) - (< (abs diff) org-scheduled-past-days) - (and todayp (not org-agenda-only-exact-dates))) - ;; org-is-habit-p uses org-entry-get, which is expansive - ;; so we go extra mile to only call it once - (and todayp - (boundp 'org-habit-show-all-today) - org-habit-show-all-today - (setq did-habit-check-p t) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))))) - (save-excursion - (setq donep (member todo-state org-done-keywords)) - (if (and donep + ;; Nullify delay when a repeater triggered already + ;; and the delay is of the form --Xd. + ((and (string-match-p "--[0-9]+[hdwmy]" s) + (> current schedule)) + 0) + (suppress-delay + (let ((org-scheduled-delay-days suppress-delay)) + (org-get-wdays s t t))) + (t (org-get-wdays s t))))) + ;; Display scheduled items at base date (SCHEDULE), today if + ;; scheduled before the current date, and at any repeat past + ;; today. However, skip delayed items and items that have + ;; been displayed for more than `org-scheduled-past-days'. + (unless (and todayp + habitp + (bound-and-true-p org-habit-show-all-today)) + (when (or (and (> ddays 0) (< diff ddays)) + (> diff org-scheduled-past-days) + (> schedule current) + (and (< schedule current) + (not todayp) + (/= repeat current))) + (throw :skip nil))) + ;; Possibly skip done tasks. + (when (and donep (or org-agenda-skip-scheduled-if-done - (not (= diff 0)) - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq txt nil) - (setq habitp (if did-habit-check-p habitp - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq category (org-get-category) - category-pos (get-text-property (point) 'org-category-position)) - (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown - 'repeated-after-deadline) - (org-get-deadline-time (point)) - (<= 0 (- d2 (time-to-days (org-get-deadline-time (point)))))) - (throw :skip nil)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (if habitp - (if (or (not org-habit-show-habits) - (and (not todayp) - (boundp 'org-habit-show-habits-only-for-today) - org-habit-show-habits-only-for-today)) - (throw :skip nil)) - (if (and - (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) - (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today) - pastschedp)) - (setq mm (assoc pos1 deadline-position-alist))) - (throw :skip nil))) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - - tags (org-get-tags-at nil (not inherited-tags))) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (if (= diff 0) - (car org-agenda-scheduled-leaders) - (format (nth 1 org-agenda-scheduled-leaders) - (- 1 diff))) - head level category tags - (if (not (= diff 0)) nil timestr) - nil habitp)))) - (when txt - (setq face + (/= schedule current))) + (throw :skip nil)) + ;; Skip entry if it already appears as a deadline, per + ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This + ;; doesn't apply to habits. + (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown + ((guard + (or (not (memq (line-beginning-position 0) deadline-pos)) + habitp)) + nil) + (`repeated-after-deadline + (>= repeat (time-to-days (org-get-deadline-time (point))))) + (`not-today pastschedp) + (`t t) + (_ nil)) + (throw :skip nil)) + ;; Skip habits if `org-habit-show-habits' is nil, or if we + ;; only show them for today. Also skip done habits. + (when (and habitp + (or donep + (not (bound-and-true-p org-habit-show-habits)) + (and (not todayp) + (bound-and-true-p + org-habit-show-habits-only-for-today)))) + (throw :skip nil)) + (save-excursion + (re-search-backward "^\\*+[ \t]+" nil t) + (goto-char (match-end 0)) + (let* ((category (org-get-category)) + (inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda + org-agenda-use-tag-inheritance))))) + (tags (org-get-tags-at nil (not inherited-tags))) + (level + (make-string (org-reduced-level (org-outline-level)) ?\s)) + (head (buffer-substring (point) (line-end-position))) + (time (cond - ((and (not habitp) pastschedp) - 'org-scheduled-previously) - (todayp 'org-scheduled-today) - (t 'org-scheduled)) - habitp (and habitp (org-habit-parse-todo))) - (org-add-props txt props + ;; No time of day designation if it is only + ;; a reminder. + ((and (/= current schedule) (/= current repeat)) nil) + ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (concat (substring s (match-beginning 1)) " ")) + (t 'time))) + (item + (org-agenda-format-item + (pcase-let ((`(,first ,next) org-agenda-scheduled-leaders)) + (cond + ;; If CURRENT is in the future, don't use past + ;; scheduled prefix. + ((> current today) first) + ;; SHOW-ALL focuses on future repeats. If one + ;; such repeat happens today, ignore late + ;; schedule reminder. However, still report + ;; such reminders when repeat happens later. + ((and (not show-all) (= repeat today)) first) + ;; Initial report. + ((= schedule current) first) + ;; Subsequent reminders. Count from base + ;; schedule. + (t (format next diff)))) + head level category tags time nil habitp)) + (face (cond ((and (not habitp) pastschedp) + 'org-scheduled-previously) + (todayp 'org-scheduled-today) + (t 'org-scheduled))) + (habitp (and habitp (org-habit-parse-todo)))) + (org-add-props item props 'undone-face face 'face (if donep 'org-agenda-done face) 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) + 'org-hd-marker (org-agenda-new-marker (line-beginning-position)) 'type (if pastschedp "past-scheduled" "scheduled") - 'date (if pastschedp d2 date) - 'ts-date d2 + 'date (if pastschedp schedule date) + 'ts-date schedule 'warntime warntime 'level level - 'priority (if habitp - (org-habit-get-priority habitp) - (+ 94 (- 5 diff) (org-get-priority txt))) - 'org-category category - 'category-position category-pos + 'priority (if habitp (org-habit-get-priority habitp) + (+ 99 diff (org-get-priority item))) 'org-habit-p habitp 'todo-state todo-state) - (push txt ee)))))) - (nreverse ee))) + (push item scheduled-items)))))) + (nreverse scheduled-items))) (defun org-agenda-get-blocks () "Return the date-range information for agenda display." @@ -6320,7 +6408,7 @@ an hour specification like [h]h:mm." (abbreviate-file-name buffer-file-name)))) (regexp org-tr-regexp) (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 category category-pos + marker hdmarker ee txt d1 d2 s1 s2 category level todo-state tags pos head donep inherited-tags) (goto-char (point-min)) (while (re-search-forward regexp nil t) @@ -6341,9 +6429,8 @@ an hour specification like [h]h:mm." (setq donep (member todo-state org-done-keywords)) (if (and donep org-agenda-skip-timestamp-if-done) (throw :skip t)) - (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category) - category-pos (get-text-property (point) 'org-category-position)) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category)) (if (not (re-search-backward org-outline-regexp-bol nil t)) (throw :skip nil) (goto-char (match-beginning 0)) @@ -6358,7 +6445,7 @@ an hour specification like [h]h:mm." tags (org-get-tags-at nil (not inherited-tags))) (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (looking-at "\\*+[ \t]+\\(.*\\)") (setq head (match-string 1)) (let ((remove-re (if org-agenda-remove-timeranges-from-blocks @@ -6385,8 +6472,7 @@ an hour specification like [h]h:mm." 'type "block" 'date date 'level level 'todo-state todo-state - 'priority (org-get-priority txt) 'org-category category - 'org-category-position category-pos) + 'priority (org-get-priority txt)) (push txt ee)))) (goto-char pos))) ;; Sort the entries by expiration date. @@ -6413,11 +6499,11 @@ The flag is set if the currently compiled format contains a `%b'.") (defun org-agenda-get-category-icon (category) "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." - (dolist (entry org-agenda-category-icon-alist) - (when (org-string-match-p (car entry) category) + (cl-dolist (entry org-agenda-category-icon-alist) + (when (string-match-p (car entry) category) (if (listp (cadr entry)) - (return (cadr entry)) - (return (apply 'create-image (cdr entry))))))) + (cl-return (cadr entry)) + (cl-return (apply #'create-image (cdr entry))))))) (defun org-agenda-format-item (extra txt &optional level category tags dotime remove-re habitp) @@ -6444,8 +6530,8 @@ Any match of REMOVE-RE will be removed from TXT." ;; buffer (let* ((bindings (car org-prefix-format-compiled)) (formatter (cadr org-prefix-format-compiled))) - (loop for (var value) in bindings - do (set var value)) + (cl-loop for (var value) in bindings + do (set var value)) (save-match-data ;; Diary entries sometimes have extra whitespace at the beginning (setq txt (org-trim txt)) @@ -6457,9 +6543,6 @@ Any match of REMOVE-RE will be removed from TXT." org-agenda-hide-tags-regexp)) (let* ((category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) (if buffer-file-name (file-name-sans-extension (file-name-nondirectory buffer-file-name)) @@ -6468,15 +6551,17 @@ Any match of REMOVE-RE will be removed from TXT." (category-icon (if category-icon (propertize " " 'display category-icon) "")) + (effort (and (not (string= txt "")) + (get-text-property 1 'effort txt))) ;; time, tag, effort are needed for the eval of the prefix format (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort + time (ts (if dotime (concat (if (stringp dotime) dotime "") (and org-agenda-search-headline-for-time txt)))) (time-of-day (and dotime (org-get-time-of-day ts))) stamp plain s0 s1 s2 rtn srp l - duration thecategory breadcrumbs) + duration breadcrumbs) (and (derived-mode-p 'org-mode) buffer-file-name (add-to-list 'org-agenda-contributing-files buffer-file-name)) (when (and dotime time-of-day) @@ -6516,8 +6601,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-hh:mm-string-to-minutes s2) (org-hh:mm-string-to-minutes s1))))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) + (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) (and org-agenda-remove-tags @@ -6527,16 +6611,6 @@ Any match of REMOVE-RE will be removed from TXT." (concat (make-string (max (- 50 (length txt)) 1) ?\ ) (match-string 2 txt)) t t txt)))) - (when (derived-mode-p 'org-mode) - (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))) - - ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as - ;; current buffer, so move this check outside of above - (if effort - (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))) - ;; prevent erroring out with %e format when there is no effort - (setq effort "")) (when remove-re (while (string-match remove-re txt) @@ -6563,7 +6637,6 @@ Any match of REMOVE-RE will be removed from TXT." (t "")) extra (or (and (not habitp) extra) "") category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category) level (or level "")) (if (string-match org-bracket-link-regexp category) (progn @@ -6584,14 +6657,12 @@ Any match of REMOVE-RE will be removed from TXT." ;; And finally add the text properties (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) + 'org-category category 'tags (mapcar 'org-downcase-keep-props tags) 'org-highest-priority org-highest-priority 'org-lowest-priority org-lowest-priority 'time-of-day time-of-day 'duration duration - 'effort effort - 'effort-minutes neffort 'breadcrumbs breadcrumbs 'txt txt 'level level @@ -6605,7 +6676,7 @@ Any match of REMOVE-RE will be removed from TXT." The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) + (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) (setq txt (substring txt 0 (match-beginning 0)))) (setq tags (delq nil @@ -6710,12 +6781,12 @@ and stored in the variable `org-prefix-format-compiled'." c (or (match-string 3 s) "") opt (match-beginning 1) start (1+ (match-beginning 0))) - (if (equal var 'time) (setq org-prefix-has-time t)) - (if (equal var 'tag) (setq org-prefix-has-tag t)) - (if (equal var 'effort) (setq org-prefix-has-effort t)) - (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) + (if (eq var 'time) (setq org-prefix-has-time t)) + (if (eq var 'tag) (setq org-prefix-has-tag t)) + (if (eq var 'effort) (setq org-prefix-has-effort t)) + (if (eq var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) (setq f (concat "%" (match-string 2 s) "s")) - (when (equal var 'category) + (when (eq var 'category) (setq org-prefix-category-length (floor (abs (string-to-number (match-string 2 s))))) (setq org-prefix-category-max-length @@ -6727,10 +6798,13 @@ and stored in the variable `org-prefix-format-compiled'." (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) (if opt (setq varform - `(if (equal "" ,var) + `(if (or (equal "" ,var) (equal nil ,var)) "" - (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) - (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) + (format ,f (concat ,var ,c)))) + (setq varform + `(format ,f (if (or (equal ,var "") + (equal ,var nil)) "" + (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) (setq s (replace-match "%s" t nil s)) (push varform vars)) (setq vars (nreverse vars)) @@ -6817,7 +6891,7 @@ The optional argument TYPE tells the agenda type." (t org-agenda-max-tags))) (max-entries (cond ((listp org-agenda-max-entries) (cdr (assoc type org-agenda-max-entries))) - (t org-agenda-max-entries))) l) + (t org-agenda-max-entries)))) (when org-agenda-before-sorting-filter-function (setq list (delq nil @@ -6827,7 +6901,9 @@ The optional argument TYPE tells the agenda type." list (mapcar 'identity (sort list 'org-entries-lessp))) (when max-effort (setq list (org-agenda-limit-entries - list 'effort-minutes max-effort 'identity))) + list 'effort-minutes max-effort + (lambda (e) (or e (if org-sort-agenda-noeffort-is-high + 32767 -1)))))) (when max-todo (setq list (org-agenda-limit-entries list 'todo-state max-todo))) (when max-tags @@ -6845,26 +6921,39 @@ The optional argument TYPE tells the agenda type." (delq nil (mapcar (lambda (e) - (let ((pval (funcall fun (get-text-property 1 prop e)))) + (let ((pval (funcall + fun (get-text-property (1- (length e)) + prop e)))) (if pval (setq lim (+ lim pval))) (cond ((and pval (<= lim (abs limit))) e) ((and include (not pval)) e)))) list))) list))) -(defun org-agenda-limit-interactively () +(defun org-agenda-limit-interactively (remove) "In agenda, interactively limit entries to various maximums." - (interactive) - (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) - (num (string-to-number (read-from-minibuffer "How many? ")))) - (cond ((equal max ?e) - (let ((org-agenda-max-entries num)) (org-agenda-redo))) - ((equal max ?t) - (let ((org-agenda-max-todos num)) (org-agenda-redo))) - ((equal max ?T) - (let ((org-agenda-max-tags num)) (org-agenda-redo))) - ((equal max ?E) - (let ((org-agenda-max-effort num)) (org-agenda-redo))))) + (interactive "P") + (if remove + (progn (setq org-agenda-max-entries nil + org-agenda-max-todos nil + org-agenda-max-tags nil + org-agenda-max-effort nil) + (org-agenda-redo)) + (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) + (msg (cond ((= max ?E) "How many minutes? ") + ((= max ?e) "How many entries? ") + ((= max ?t) "How many TODO entries? ") + ((= max ?T) "How many tagged entries? ") + (t (user-error "Wrong input")))) + (num (string-to-number (read-from-minibuffer msg)))) + (cond ((equal max ?e) + (let ((org-agenda-max-entries num)) (org-agenda-redo))) + ((equal max ?t) + (let ((org-agenda-max-todos num)) (org-agenda-redo))) + ((equal max ?T) + (let ((org-agenda-max-tags num)) (org-agenda-redo))) + ((equal max ?E) + (let ((org-agenda-max-effort num)) (org-agenda-redo)))))) (org-agenda-fit-window-to-buffer)) (defun org-agenda-highlight-todo (x) @@ -6910,25 +6999,31 @@ The optional argument TYPE tells the agenda type." (substring x (match-end 3))))))) x))) -(defsubst org-cmp-priority (a b) - "Compare the priorities of string A and B." - (let ((pa (or (get-text-property 1 'priority a) 0)) - (pb (or (get-text-property 1 'priority b) 0))) +(defsubst org-cmp-values (a b property) + "Compare the numeric value of text PROPERTY for string A and B." + (let ((pa (or (get-text-property (1- (length a)) property a) 0)) + (pb (or (get-text-property (1- (length b)) property b) 0))) (cond ((> pa pb) +1) ((< pa pb) -1)))) (defsubst org-cmp-effort (a b) "Compare the effort values of string A and B." (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) - (ea (or (get-text-property 1 'effort-minutes a) def)) - (eb (or (get-text-property 1 'effort-minutes b) def))) + ;; `effort-minutes' property is not directly accessible from + ;; the strings, but is stored as a property in `txt'. + (ea (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt a)) + def)) + (eb (or (get-text-property + 0 'effort-minutes (get-text-property 0 'txt b)) + def))) (cond ((> ea eb) +1) ((< ea eb) -1)))) (defsubst org-cmp-category (a b) "Compare the string values of categories of strings A and B." - (let ((ca (or (get-text-property 1 'org-category a) "")) - (cb (or (get-text-property 1 'org-category b) ""))) + (let ((ca (or (get-text-property (1- (length a)) 'org-category a) "")) + (cb (or (get-text-property (1- (length b)) 'org-category b) ""))) (cond ((string-lessp ca cb) -1) ((string-lessp cb ca) +1)))) @@ -6959,7 +7054,8 @@ The optional argument TYPE tells the agenda type." (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) (plb (text-property-any 0 (length b) 'org-heading t b)) (ta (and pla (substring a pla))) - (tb (and plb (substring b plb)))) + (tb (and plb (substring b plb))) + (case-fold-search nil)) (when pla (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) @@ -7038,8 +7134,11 @@ their type." (time-up (and (org-em 'time-up 'time-down ss) (org-cmp-time a b))) (time-down (if time-up (- time-up) nil)) + (stats-up (and (org-em 'stats-up 'stats-down ss) + (org-cmp-values a b 'org-stats))) + (stats-down (if stats-up (- stats-up) nil)) (priority-up (and (org-em 'priority-up 'priority-down ss) - (org-cmp-priority a b))) + (org-cmp-values a b 'priority))) (priority-down (if priority-up (- priority-up) nil)) (effort-up (and (org-em 'effort-up 'effort-down ss) (org-cmp-effort a b))) @@ -7080,15 +7179,16 @@ their type." 'face 'org-agenda-restriction-lock) (overlay-put org-agenda-restriction-lock-overlay 'help-echo "Agendas are currently limited to this subtree.") -(org-detach-overlay org-agenda-restriction-lock-overlay) +(delete-overlay org-agenda-restriction-lock-overlay) ;;;###autoload (defun org-agenda-set-restriction-lock (&optional type) "Set restriction lock for agenda, to current subtree or file. -Restriction will be the file if TYPE is `file', or if TYPE is the -universal prefix `(4)', or if the cursor is before the first headline +Restriction will be the file if TYPE is `file', or if type is the +universal prefix \\='(4), or if the cursor is before the first headline in the file. Otherwise, restriction will be to the current subtree." (interactive "P") + (org-agenda-remove-restriction-lock 'noupdate) (and (equal type '(4)) (setq type 'file)) (setq type (cond (type type) @@ -7125,8 +7225,8 @@ in the file. Otherwise, restriction will be to the current subtree." (defun org-agenda-remove-restriction-lock (&optional noupdate) "Remove the agenda restriction lock." (interactive "P") - (org-detach-overlay org-agenda-restriction-lock-overlay) - (org-detach-overlay org-speedbar-restriction-lock-overlay) + (delete-overlay org-agenda-restriction-lock-overlay) + (delete-overlay org-speedbar-restriction-lock-overlay) (setq org-agenda-overriding-restriction nil) (setq org-agenda-restrict nil) (put 'org-agenda-files 'org-restrict nil) @@ -7138,7 +7238,9 @@ in the file. Otherwise, restriction will be to the current subtree." (defun org-agenda-maybe-redo () "If there is any window showing the agenda view, update it." - (let ((w (get-buffer-window org-agenda-buffer-name t)) + (let ((w (get-buffer-window (or org-agenda-this-buffer-name + org-agenda-buffer-name) + t)) (w0 (selected-window))) (when w (select-window w) @@ -7154,7 +7256,7 @@ in the file. Otherwise, restriction will be to the current subtree." (defun org-agenda-check-type (error &rest types) "Check if agenda buffer is of allowed type. If ERROR is non-nil, throw an error, otherwise just return nil. -Allowed types are 'agenda 'timeline 'todo 'tags 'search." +Allowed types are `agenda' `timeline' `todo' `tags' `search'." (if (not org-agenda-type) (error "No Org agenda currently displayed") (if (memq org-agenda-type types) @@ -7164,77 +7266,76 @@ Allowed types are 'agenda 'timeline 'todo 'tags 'search." nil)))) (defun org-agenda-Quit () - "Exit the agenda and kill buffers loaded by `org-agenda'. -Also restore the window configuration." + "Exit the agenda, killing the agenda buffer. +Like `org-agenda-quit', but kill the buffer even when +`org-agenda-sticky' is non-nil." (interactive) - (if org-agenda-columns-active - (org-columns-quit) - (let ((buf (current-buffer))) - (if (eq org-agenda-window-setup 'other-frame) - (progn - (org-agenda-reset-markers) - (kill-buffer buf) - (org-columns-remove-overlays) - (setq org-agenda-archives-mode nil) - (delete-frame)) - (and (not (eq org-agenda-window-setup 'current-window)) - (not (one-window-p)) - (delete-window)) - (org-agenda-reset-markers) - (kill-buffer buf) - (org-columns-remove-overlays) - (setq org-agenda-archives-mode nil))) - (setq org-agenda-buffer nil) - ;; Maybe restore the pre-agenda window configuration. - (and org-agenda-restore-windows-after-quit - (not (eq org-agenda-window-setup 'other-frame)) - org-agenda-pre-window-conf - (set-window-configuration org-agenda-pre-window-conf) - (setq org-agenda-pre-window-conf nil)))) + (org-agenda--quit)) (defun org-agenda-quit () - "Exit the agenda and restore the window configuration. -When `org-agenda-sticky' is non-nil, only bury the agenda." + "Exit the agenda. + +When `org-agenda-sticky' is non-nil, bury the agenda buffer +instead of killing it. + +When `org-agenda-restore-windows-after-quit' is non-nil, restore +the pre-agenda window configuration. + +When column view is active, exit column view instead of the +agenda." (interactive) - (if (and (eq org-indirect-buffer-display 'other-window) - org-last-indirect-buffer) - (let ((org-last-indirect-window - (get-buffer-window org-last-indirect-buffer))) - (if org-last-indirect-window - (delete-window org-last-indirect-window)))) + (org-agenda--quit org-agenda-sticky)) + +(defun org-agenda--quit (&optional bury) (if org-agenda-columns-active (org-columns-quit) - (if org-agenda-sticky - (let ((buf (current-buffer))) - (if (eq org-agenda-window-setup 'other-frame) - (progn - (delete-frame)) - (and (not (eq org-agenda-window-setup 'current-window)) - (not (one-window-p)) - (delete-window))) + (let ((wconf org-agenda-pre-window-conf) + (buf (current-buffer)) + (org-agenda-last-indirect-window + (and (eq org-indirect-buffer-display 'other-window) + org-agenda-last-indirect-buffer + (get-buffer-window org-agenda-last-indirect-buffer)))) + (cond + ((eq org-agenda-window-setup 'other-frame) + (delete-frame)) + ((and org-agenda-restore-windows-after-quit + wconf) + ;; Maybe restore the pre-agenda window configuration. Reset + ;; `org-agenda-pre-window-conf' before running + ;; `set-window-configuration', which loses the current buffer. + (setq org-agenda-pre-window-conf nil) + (set-window-configuration wconf)) + (t + (when org-agenda-last-indirect-window + (delete-window org-agenda-last-indirect-window)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window)))) + (if bury + ;; Set the agenda buffer as the current buffer instead of + ;; passing it as an argument to `bury-buffer' so that + ;; `bury-buffer' removes it from the window. (with-current-buffer buf - (bury-buffer) - ;; Maybe restore the pre-agenda window configuration. - (and org-agenda-restore-windows-after-quit - (not (eq org-agenda-window-setup 'other-frame)) - org-agenda-pre-window-conf - (set-window-configuration org-agenda-pre-window-conf) - (setq org-agenda-pre-window-conf nil)))) - (org-agenda-Quit)))) + (bury-buffer)) + (kill-buffer buf) + (setq org-agenda-archives-mode nil + org-agenda-buffer nil))))) (defun org-agenda-exit () - "Exit the agenda and restore the window configuration. -Also kill Org-mode buffers loaded by `org-agenda'. Org-mode -buffers visited directly by the user will not be touched." + "Exit the agenda, killing Org buffers loaded by the agenda. +Like `org-agenda-Quit', but kill any buffers that were created by +the agenda. Org buffers visited directly by the user will not be +touched. Also, exit the agenda even if it is in column view." (interactive) + (when org-agenda-columns-active + (org-columns-quit)) (org-release-buffers org-agenda-new-buffers) (setq org-agenda-new-buffers nil) (org-agenda-Quit)) (defun org-agenda-kill-all-agenda-buffers () "Kill all buffers in `org-agenda-mode'. -This is used when toggling sticky agendas. -You can also explicitly invoke it with `C-c a C-k'." +This is used when toggling sticky agendas." (interactive) (let (blist) (dolist (buf (buffer-list)) @@ -7267,6 +7368,9 @@ in the agenda." (cat-preset (get 'org-agenda-category-filter :preset-filter)) (re-filter org-agenda-regexp-filter) (re-preset (get 'org-agenda-regexp-filter :preset-filter)) + (effort-filter org-agenda-effort-filter) + (effort-preset (get 'org-agenda-effort-filter :preset-filter)) + (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) (window-line (- line (org-current-line (window-start)))) @@ -7284,6 +7388,7 @@ in the agenda." (put 'org-agenda-tag-filter :preset-filter nil) (put 'org-agenda-category-filter :preset-filter nil) (put 'org-agenda-regexp-filter :preset-filter nil) + (put 'org-agenda-effort-filter :preset-filter nil) (and cols (org-columns-quit)) (message "Rebuilding agenda buffer...") (if series-redo-cmd @@ -7294,19 +7399,23 @@ in the agenda." org-agenda-tag-filter tag-filter org-agenda-category-filter cat-filter org-agenda-regexp-filter re-filter + org-agenda-effort-filter effort-filter org-agenda-top-headline-filter top-hl-filter) (message "Rebuilding agenda buffer...done") (put 'org-agenda-tag-filter :preset-filter tag-preset) (put 'org-agenda-category-filter :preset-filter cat-preset) (put 'org-agenda-regexp-filter :preset-filter re-preset) + (put 'org-agenda-effort-filter :preset-filter effort-preset) (let ((tag (or tag-filter tag-preset)) (cat (or cat-filter cat-preset)) - (re (or re-filter re-preset))) - (when tag (org-agenda-filter-apply tag 'tag)) + (effort (or effort-filter effort-preset)) + (re (or re-filter re-preset))) + (when tag (org-agenda-filter-apply tag 'tag t)) (when cat (org-agenda-filter-apply cat 'category)) + (when effort (org-agenda-filter-apply effort 'effort)) (when re (org-agenda-filter-apply re 'regexp))) (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) - (and cols (org-called-interactively-p 'any) (org-agenda-columns)) + (and cols (called-interactively-p 'any) (org-agenda-columns)) (org-goto-line line) (recenter window-line))) @@ -7315,32 +7424,36 @@ in the agenda." (defvar org-agenda-filtered-by-category nil) (defun org-agenda-filter-by-category (strip) - "Keep only those lines in the agenda buffer that have a specific category. -The category is that of the current line." + "Filter lines in the agenda buffer that have a specific category. +The category is that of the current line. +Without prefix argument, keep only the lines of that category. +With a prefix argument, exclude the lines of that category. +" (interactive "P") (if (and org-agenda-filtered-by-category org-agenda-category-filter) (org-agenda-filter-show-all-cat) - (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) + (let ((cat (org-no-properties (org-get-at-eol 'org-category 1)))) (cond ((and cat strip) (org-agenda-filter-apply (push (concat "-" cat) org-agenda-category-filter) 'category)) - ((and cat) + (cat (org-agenda-filter-apply (setq org-agenda-category-filter (list (concat "+" cat))) 'category)) (t (error "No category at point")))))) (defun org-find-top-headline (&optional pos) - "Find the topmost parent headline and return it." + "Find the topmost parent headline and return it. +POS when non-nil is the marker or buffer position to start the +search from." (save-excursion - (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) - (if pos (goto-char pos)) - ;; Skip up to the topmost parent - (while (ignore-errors (outline-up-heading 1) t)) - (ignore-errors - (nth 4 (org-heading-components)))))) + (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) + (when pos (goto-char pos)) + ;; Skip up to the topmost parent. + (while (org-up-heading-safe)) + (ignore-errors (nth 4 (org-heading-components)))))) (defvar org-agenda-filtered-by-top-headline nil) (defun org-agenda-filter-by-top-headline (strip) @@ -7375,6 +7488,49 @@ With two prefix arguments, remove the regexp filters." (org-agenda-filter-show-all-re) (message "Regexp filter removed"))) +(defvar org-agenda-effort-filter nil) +(defun org-agenda-filter-by-effort (strip) + "Filter agenda entries by effort. +With no prefix argument, keep entries matching the effort condition. +With one prefix argument, filter out entries matching the condition. +With two prefix arguments, remove the effort filters." + (interactive "P") + (cond + ((member strip '(nil 4)) + (let* ((efforts (split-string + (or (cdr (assoc (concat org-effort-property "_ALL") + org-global-properties)) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) + ;; XXX: the following handles only up to 10 different + ;; effort values. + (allowed-keys (if (null efforts) nil + (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 + (number-sequence 1 (length efforts))))) + (op nil)) + (while (not (memq op '(?< ?> ?=))) + (setq op (read-char-exclusive "Effort operator? (> = or <)"))) + ;; Select appropriate duration. Ignore non-digit characters. + (let ((prompt + (apply #'format + (concat "Effort %c " + (mapconcat (lambda (s) (concat "[%d]" s)) + efforts + " ")) + op allowed-keys)) + (eff -1)) + (while (not (memq eff allowed-keys)) + (message prompt) + (setq eff (- (read-char-exclusive) 48))) + (setq org-agenda-effort-filter + (list (concat (if strip "-" "+") + (char-to-string op) + ;; Numbering is 1 2 3 ... 9 0, but we want + ;; 0 1 2 ... 8 9. + (nth (mod (1- eff) 10) efforts))))) + (org-agenda-filter-apply org-agenda-effort-filter 'effort))) + (t (org-agenda-filter-show-all-effort) + (message "Effort filter removed")))) + (defun org-agenda-filter-remove-all () "Remove all filters from the current agenda buffer." (interactive) @@ -7386,15 +7542,24 @@ With two prefix arguments, remove the regexp filters." (org-agenda-filter-show-all-re)) (when org-agenda-top-headline-filter (org-agenda-filter-show-all-top-filter)) + (when org-agenda-effort-filter + (org-agenda-filter-show-all-effort)) (org-agenda-finalize)) -(defun org-agenda-filter-by-tag (strip &optional char narrow) +(defun org-agenda-filter-by-tag (arg &optional char exclude) "Keep only those lines in the agenda buffer that have a specific tag. + The tag is selected with its fast selection letter, as configured. -With prefix argument STRIP, remove all lines that do have the tag. -A lisp caller can specify CHAR. NARROW means that the new tag should be -used to narrow the search - the interactive user can also press `-' or `+' -to switch to narrowing." + +With a `\\[universal-argument]' prefix, exclude the agenda search. + +With a `\\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \ +i.e. don't +filter on all its group members. + +A lisp caller can specify CHAR. EXCLUDE means that the new tag +should be used to exclude the search - the interactive user can +also press `-' or `+' to switch between filtering and excluding." (interactive "P") (let* ((alist org-tag-alist-for-agenda) (tag-chars (mapconcat @@ -7402,54 +7567,34 @@ to switch to narrowing." (cdr x)) (char-to-string (cdr x)) "")) - alist "")) - (efforts (org-split-string - (or (cdr (assoc (concat org-effort-property "_ALL") - org-global-properties)) - "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" - ""))) - (effort-op org-agenda-filter-effort-default-operator) - (effort-prompt "") + org-tag-alist-for-agenda "")) + (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q) + (string-to-list tag-chars))) + (exclude (or exclude (equal arg '(4)))) + (expand (not (equal arg '(16)))) (inhibit-read-only t) (current org-agenda-tag-filter) - maybe-refresh a n tag) + a n tag) (unless char - (message - "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>==<]:effort: " tag-chars) - (setq char (read-char-exclusive))) - (when (member char '(?< ?> ?= ??)) - ;; An effort operator - (setq effort-op (char-to-string char)) - (setq alist nil) ; to make sure it will be interpreted as effort. - (unless (equal char ??) - (loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) - (message "Effort%s: %s " effort-op effort-prompt) + (while (not (memq char valid-char-list)) + (message + "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit" + (if exclude "Exclude" "Filter") tag-chars + (if org-agenda-auto-exclude-function "[RET], " "") + (if expand "" ", no grouptag expand")) (setq char (read-char-exclusive)) - (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort")))) - (when (equal char ?\t) + ;; Excluding or filtering down + (cond ((eq char ?-) (setq exclude t)) + ((eq char ?+) (setq exclude nil))))) + (when (eq char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) - (org-set-local 'org-global-tags-completion-table - (org-global-tags-completion-table))) + (setq-local org-global-tags-completion-table + (org-global-tags-completion-table))) (let ((completion-ignore-case t)) - (setq tag (org-icompleting-read + (setq tag (completing-read "Tag: " org-global-tags-completion-table)))) (cond - ((equal char ?\r) + ((eq char ?\r) (org-agenda-filter-show-all-tag) (when org-agenda-auto-exclude-function (setq org-agenda-tag-filter nil) @@ -7458,39 +7603,27 @@ to switch to narrowing." (if modifier (push modifier org-agenda-tag-filter)))) (if (not (null org-agenda-tag-filter)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - (setq maybe-refresh t)) - ((equal char ?/) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))) + ((eq char ?/) (org-agenda-filter-show-all-tag) (when (get 'org-agenda-tag-filter :preset-filter) - (org-agenda-filter-apply org-agenda-tag-filter 'tag)) - (setq maybe-refresh t)) - ((equal char ?. ) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))) + ((eq char ?.) (setq org-agenda-tag-filter (mapcar (lambda(tag) (concat "+" tag)) (org-get-at-bol 'tags))) - (org-agenda-filter-apply org-agenda-tag-filter 'tag) - (setq maybe-refresh t)) - ((or (equal char ?\ ) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) + ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...) + ((or (eq char ?\s) (setq a (rassoc char alist)) - (and (>= char ?0) (<= char ?9) - (setq n (if (= char ?0) 9 (- char ?0 1)) - tag (concat effort-op (nth n efforts)) - a (cons tag nil))) - (and (= char ??) - (setq tag "?eff") - a (cons tag nil)) (and tag (setq a (cons tag nil)))) (org-agenda-filter-show-all-tag) (setq tag (car a)) (setq org-agenda-tag-filter - (cons (concat (if strip "-" "+") tag) - (if narrow current nil))) - (org-agenda-filter-apply org-agenda-tag-filter 'tag) - (setq maybe-refresh t)) - (t (error "Invalid tag selection character %c" char))) - (when maybe-refresh - (org-agenda-redo)))) + (cons (concat (if exclude "-" "+") tag) + current)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)) + (t (error "Invalid tag selection character %c" char))))) (defun org-agenda-get-represented-tags () "Get a list of all tags currently represented in the agenda." @@ -7503,13 +7636,11 @@ to switch to narrowing." (get-text-property (point) 'tags)))) tags)) -(defun org-agenda-filter-by-tag-refine (strip &optional char) - "Refine the current filter. See `org-agenda-filter-by-tag'." - (interactive "P") - (org-agenda-filter-by-tag strip char 'refine)) -(defun org-agenda-filter-make-matcher (filter type) - "Create the form that tests a line for agenda filter." +(defun org-agenda-filter-make-matcher (filter type &optional expand) + "Create the form that tests a line for agenda filter. Optional +argument EXPAND can be used for the TYPE tag and will expand the +tags in the FILTER if any of the tags in FILTER are grouptags." (let (f f1) (cond ;; Tag filter @@ -7519,28 +7650,11 @@ to switch to narrowing." (append (get 'org-agenda-tag-filter :preset-filter) filter))) (dolist (x filter) - (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1 - (ffunc - (lambda (nf0 nf01 fltr notgroup op) - (dolist (x fltr) - (if (member x '("-" "+")) - (setq nf01 (if (equal x "-") 'tags '(not tags))) - (if (string-match "[<=>?]" x) - (setq nf01 (org-agenda-filter-effort-form x)) - (setq nf01 (list 'member (downcase (substring x 1)) - 'tags))) - (when (equal (string-to-char x) ?-) - (setq nf01 (list 'not nf01)) - (when (not notgroup) (setq op 'and)))) - (push nf01 nf0)) - (if notgroup - (push (cons 'and nf0) f) - (push (cons (or op 'or) nf0) f))))) - (cond ((equal filter '("+")) - (setq f (list (list 'not 'tags)))) - ((equal nfilter filter) - (funcall ffunc f1 f filter t nil)) - (t (funcall ffunc nf1 nf nfilter nil nil)))))) + (let ((op (string-to-char x))) + (if expand (setq x (org-agenda-filter-expand-tags (list x) t)) + (setq x (list x))) + (setq f1 (org-agenda-filter-make-matcher-tag-exp x op)) + (push f1 f)))) ;; Category filter ((eq type 'category) (setq filter @@ -7562,9 +7676,35 @@ to switch to narrowing." (if (equal "-" (substring x 0 1)) (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) (setq f1 (list 'string-match (substring x 1) 'txt))) - (push f1 f)))) + (push f1 f))) + ;; Effort filter + ((eq type 'effort) + (setq filter + (delete-dups + (append (get 'org-agenda-effort-filter :preset-filter) + filter))) + (dolist (x filter) + (push (org-agenda-filter-effort-form x) f)))) (cons 'and (nreverse f)))) +(defun org-agenda-filter-make-matcher-tag-exp (tags op) + "Return a form associated to tag-expression TAGS. +Build a form testing a line for agenda filter for +tag-expressions. OP is an operator of type CHAR that allows the +function to set the right switches in the returned form." + (let (form) + ;; Any of the expressions can match if OP is +, all must match if + ;; the operator is -. + (dolist (x tags (cons (if (eq op ?-) 'and 'or) form)) + (let* ((tag (substring x 1)) + (f (cond + ((string= "" tag) '(not tags)) + ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag)) + ;; TAG is a regexp. + (list 'org-match-any-p (substring tag 1 -1) 'tags)) + (t (list 'member (downcase tag) 'tags))))) + (push (if (eq op ?-) (list 'not f) f) form))))) + (defun org-agenda-filter-effort-form (e) "Return the form to compare the effort of the current line with what E says. E looks like \"+<2:25\"." @@ -7581,11 +7721,12 @@ E looks like \"+<2:25\"." (defun org-agenda-compare-effort (op value) "Compare the effort of the current line with VALUE, using OP. If the line does not have an effort defined, return nil." - (let ((eff (org-get-at-bol 'effort-minutes))) - (if (equal op ??) - (not eff) - (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) - value)))) + ;; `effort-minutes' property cannot be extracted directly from + ;; current line but is stored as a property in `txt'. + (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) + (funcall op + (or effort (if org-sort-agenda-noeffort-is-high 32767 -1)) + value))) (defun org-agenda-filter-expand-tags (filter &optional no-operator) "Expand group tags in FILTER for the agenda. @@ -7605,12 +7746,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." (reverse rtn)) filter)) -(defun org-agenda-filter-apply (filter type) - "Set FILTER as the new agenda filter and apply it." +(defun org-agenda-filter-apply (filter type &optional expand) + "Set FILTER as the new agenda filter and apply it. Optional +argument EXPAND can be used for the TYPE tag and will expand the +tags in the FILTER if any of the tags in FILTER are grouptags." ;; Deactivate `org-agenda-entry-text-mode' when filtering (if org-agenda-entry-text-mode (org-agenda-entry-text-mode)) (let (tags cat txt) - (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type)) + (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand)) ;; Only set `org-agenda-filtered-by-category' to t when a unique ;; category is used as the filter: (setq org-agenda-filtered-by-category @@ -7622,13 +7765,9 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." (while (not (eobp)) (if (org-get-at-bol 'org-marker) (progn - (setq tags ; used in eval - (apply 'append - (mapcar (lambda (f) - (org-agenda-filter-expand-tags (list f) t)) - (org-get-at-bol 'tags))) - cat (get-text-property (point) 'org-category) - txt (get-text-property (point) 'txt)) + (setq tags (org-get-at-bol 'tags) + cat (org-get-at-eol 'org-category 1) + txt (org-get-at-bol 'txt)) (if (not (eval org-agenda-filter-form)) (org-agenda-filter-hide-line type)) (beginning-of-line 2)) @@ -7681,6 +7820,8 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." (org-agenda-remove-filter 'tag)) (defun org-agenda-filter-show-all-re nil (org-agenda-remove-filter 'regexp)) +(defun org-agenda-filter-show-all-effort nil + (org-agenda-remove-filter 'effort)) (defun org-agenda-filter-show-all-cat nil (org-agenda-remove-filter 'category)) (defun org-agenda-filter-show-all-top-filter nil @@ -7779,7 +7920,7 @@ Negative selection means regexp must not match for selection of an entry." (tdpos (goto-char tdpos)) ((eq org-agenda-type 'agenda) (let* ((sd (org-agenda-compute-starting-span - (org-today) (or curspan org-agenda-ndays org-agenda-span))) + (org-today) (or curspan org-agenda-span))) (org-agenda-overriding-arguments args)) (setf (nth 1 org-agenda-overriding-arguments) sd) (org-agenda-redo) @@ -7792,27 +7933,40 @@ Negative selection means regexp must not match for selection of an entry." (text-property-any (point-min) (point-max) 'org-today t) (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) (and (get-text-property (min (1- (point-max)) (point)) 'org-series) - (org-agenda-goto-block-beginning)) + (org-agenda-backward-block)) (point-min)))) -(defun org-agenda-goto-block-beginning () - "Go the agenda block beginning." +(defun org-agenda-backward-block () + "Move backward by one agenda block." (interactive) - (if (not (derived-mode-p 'org-agenda-mode)) - (error "Cannot execute this command outside of org-agenda-mode buffers") - (let (dest) - (save-excursion - (unless (looking-at "\\'") - (forward-char)) - (let* ((prop 'org-agenda-structural-header) - (p (previous-single-property-change (point) prop)) - (n (next-single-property-change (or (and (looking-at "\\`") 1) - (1- (point))) prop))) - (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p)))))) - (if (not dest) - (error "Cannot find the beginning of the blog") - (goto-char dest) - (move-beginning-of-line 1))))) + (org-agenda-forward-block 'backward)) + +(defun org-agenda-forward-block (&optional backward) + "Move forward by one agenda block. +When optional argument BACKWARD is set, go backward" + (interactive) + (cond ((not (derived-mode-p 'org-agenda-mode)) + (user-error + "Cannot execute this command outside of org-agenda-mode buffers")) + ((looking-at (if backward "\\`" "\\'")) + (message "Already at the %s block" (if backward "first" "last"))) + (t (let ((pos (prog1 (point) + (ignore-errors (if backward (backward-char 1) + (move-end-of-line 1))))) + (f (if backward + 'previous-single-property-change + 'next-single-property-change)) + moved dest) + (while (and (setq dest (funcall + f (point) 'org-agenda-structural-header)) + (not (get-text-property + (point) 'org-agenda-structural-header))) + (setq moved t) + (goto-char dest)) + (if moved (move-beginning-of-line 1) + (goto-char (if backward (point-min) (point-max))) + (move-beginning-of-line 1) + (message "No %s block" (if backward "previous" "further"))))))) (defun org-agenda-later (arg) "Go forward in time by the current span. @@ -7866,71 +8020,77 @@ With prefix ARG, go backward that many times the current span." (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") - (let ((a (read-char-exclusive))) - (case a - (?\ (call-interactively 'org-agenda-reset-view)) - (?d (call-interactively 'org-agenda-day-view)) - (?w (call-interactively 'org-agenda-week-view)) - (?t (call-interactively 'org-agenda-fortnight-view)) - (?m (call-interactively 'org-agenda-month-view)) - (?y (call-interactively 'org-agenda-year-view)) - (?l (call-interactively 'org-agenda-log-mode)) - (?L (org-agenda-log-mode '(4))) - (?c (org-agenda-log-mode 'clockcheck)) - ((?F ?f) (call-interactively 'org-agenda-follow-mode)) - (?a (call-interactively 'org-agenda-archives-mode)) - (?A (org-agenda-archives-mode 'files)) - ((?R ?r) (call-interactively 'org-agenda-clockreport-mode)) - ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) - (?G (call-interactively 'org-agenda-toggle-time-grid)) - (?D (call-interactively 'org-agenda-toggle-diary)) - (?\! (call-interactively 'org-agenda-toggle-deadlines)) - (?\[ (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-check-type t 'timeline 'agenda) - (org-agenda-redo)) - (message "Display now includes inactive timestamps as well")) - (?q (message "Abort")) - (otherwise (error "Invalid key" ))))) + (pcase (read-char-exclusive) + (?\ (call-interactively 'org-agenda-reset-view)) + (?d (call-interactively 'org-agenda-day-view)) + (?w (call-interactively 'org-agenda-week-view)) + (?t (call-interactively 'org-agenda-fortnight-view)) + (?m (call-interactively 'org-agenda-month-view)) + (?y (call-interactively 'org-agenda-year-view)) + (?l (call-interactively 'org-agenda-log-mode)) + (?L (org-agenda-log-mode '(4))) + (?c (org-agenda-log-mode 'clockcheck)) + ((or ?F ?f) (call-interactively 'org-agenda-follow-mode)) + (?a (call-interactively 'org-agenda-archives-mode)) + (?A (org-agenda-archives-mode 'files)) + ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode)) + ((or ?E ?e) (call-interactively 'org-agenda-entry-text-mode)) + (?G (call-interactively 'org-agenda-toggle-time-grid)) + (?D (call-interactively 'org-agenda-toggle-diary)) + (?\! (call-interactively 'org-agenda-toggle-deadlines)) + (?\[ (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + (?q (message "Abort")) + (key (user-error "Invalid key: %s" key)))) (defun org-agenda-reset-view () "Switch to default view for agenda." (interactive) - (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) + (org-agenda-change-time-span org-agenda-span)) + (defun org-agenda-day-view (&optional day-of-month) "Switch to daily view for agenda. With argument DAY-OF-MONTH, switch to that day of the month." (interactive "P") (org-agenda-change-time-span 'day day-of-month)) + (defun org-agenda-week-view (&optional iso-week) - "Switch to daily view for agenda. + "Switch to weekly view for agenda. With argument ISO-WEEK, switch to the corresponding ISO week. -If ISO-WEEK has more then 2 digits, only the last two encode the -week. Any digits before this encode a year. So 200712 means -week 12 of year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." +If ISO-WEEK has more then 2 digits, only the last two encode +the week. Any digits before this encode a year. So 200712 +means week 12 of year 2007. Years ranging from 70 years ago +to 30 years in the future can also be written as 2-digit years." (interactive "P") (org-agenda-change-time-span 'week iso-week)) + (defun org-agenda-fortnight-view (&optional iso-week) - "Switch to daily view for agenda. + "Switch to fortnightly view for agenda. With argument ISO-WEEK, switch to the corresponding ISO week. -If ISO-WEEK has more then 2 digits, only the last two encode the -week. Any digits before this encode a year. So 200712 means -week 12 of year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." +If ISO-WEEK has more then 2 digits, only the last two encode +the week. Any digits before this encode a year. So 200712 +means week 12 of year 2007. Years ranging from 70 years ago +to 30 years in the future can also be written as 2-digit years." (interactive "P") (org-agenda-change-time-span 'fortnight iso-week)) + (defun org-agenda-month-view (&optional month) "Switch to monthly view for agenda. -With argument MONTH, switch to that month." +With argument MONTH, switch to that month. If MONTH has more +then 2 digits, only the last two encode the month. Any digits +before this encode a year. So 200712 means December year 2007. +Years ranging from 70 years ago to 30 years in the future can +also be written as 2-digit years." (interactive "P") (org-agenda-change-time-span 'month month)) + (defun org-agenda-year-view (&optional year) "Switch to yearly view for agenda. -With argument YEAR, switch to that year. -If MONTH has more then 2 digits, only the last two encode the -month. Any digits before this encode a year. So 200712 means -December year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." +With argument YEAR, switch to that year. Years ranging from 70 +years ago to 30 years in the future can also be written as +2-digit years." (interactive "P") (when year (setq year (org-small-year-to-year year))) @@ -7988,7 +8148,7 @@ so that the date SD will be in that range." (setq y1 (org-small-year-to-year (/ n 100)) n (mod n 100))) (setq sd - (calendar-absolute-from-iso + (calendar-iso-to-absolute (list n 1 (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) ((eq span 'month) @@ -8034,7 +8194,7 @@ so that the date SD will be in that range." (defun org-unhighlight () "Detach overlay INDEX." - (org-detach-overlay org-hl)) + (delete-overlay org-hl)) (defun org-unhighlight-once () "Remove the highlight from its position, and this function from the hook." @@ -8091,9 +8251,12 @@ so that the date SD will be in that range." (defun org-agenda-log-mode (&optional special) "Toggle log mode in an agenda buffer. + With argument SPECIAL, show all possible log items, not only the ones configured in `org-agenda-log-mode-items'. -With a double `C-u' prefix arg, show *only* log items, nothing else." + +With a `\\[universal-argument] \\[universal-argument]' prefix, show *only* \ +log items, nothing else." (interactive "P") (org-agenda-check-type t 'agenda 'timeline) (setq org-agenda-show-log @@ -8107,8 +8270,7 @@ With a double `C-u' prefix arg, show *only* log items, nothing else." (setq org-agenda-start-with-log-mode org-agenda-show-log) (org-agenda-set-mode-name) (org-agenda-redo) - (message "Log mode is %s" - (if org-agenda-show-log "on" "off"))) + (message "Log mode is %s" (if org-agenda-show-log "on" "off"))) (defun org-agenda-archives-mode (&optional with-files) "Toggle inclusion of items in trees marked with :ARCHIVE:. @@ -8180,7 +8342,7 @@ When called with a prefix argument, include all archive files as well." (t "")) (if (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " <" (mapconcat 'identity @@ -8193,7 +8355,7 @@ When called with a prefix argument, include all archive files as well." 'help-echo "Category used in filtering")) "") (if (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " {" (mapconcat 'identity @@ -8204,9 +8366,22 @@ When called with a prefix argument, include all archive files as well." "}") 'face 'org-agenda-filter-tags 'help-echo "Tags used in filtering")) "") + (if (or org-agenda-effort-filter + (get 'org-agenda-effort-filter :preset-filter)) + '(:eval (propertize + (concat " {" + (mapconcat + 'identity + (append + (get 'org-agenda-effort-filter :preset-filter) + org-agenda-effort-filter) + "") + "}") + 'face 'org-agenda-filter-effort + 'help-echo "Effort conditions used in filtering")) "") (if (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter)) - '(:eval (org-propertize + '(:eval (propertize (concat " [" (mapconcat 'identity @@ -8225,9 +8400,6 @@ When called with a prefix argument, include all archive files as well." (if org-agenda-clockreport-mode " Clock" ""))) (force-mode-line-update)) -(define-obsolete-function-alias - 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") - (defun org-agenda-update-agenda-type () "Update the agenda type after each command." (setq org-agenda-type @@ -8290,7 +8462,7 @@ When called with a prefix argument, include all archive files as well." (message "No tags associated with this line")))) (defun org-agenda-goto (&optional highlight) - "Go to the Org-mode file which contains the item at point." + "Go to the entry at point in the corresponding Org file." (interactive) (let* ((marker (or (org-get-at-bol 'org-marker) (org-agenda-error))) @@ -8302,12 +8474,11 @@ When called with a prefix argument, include all archive files as well." (goto-char pos) (when (derived-mode-p 'org-mode) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))) ; show the next heading - (when (outline-invisible-p) - (show-entry)) ; display invisible text - (recenter (/ (window-height) 2)) + (recenter (/ (window-height) 2)) + (org-back-to-heading t) + (let ((case-fold-search nil)) + (when (re-search-forward org-complex-heading-regexp nil t) + (goto-char (match-beginning 4))))) (run-hooks 'org-agenda-after-show-hook) (and highlight (org-highlight (point-at-bol) (point-at-eol))))) @@ -8394,7 +8565,7 @@ Point is in the buffer where the item originated.") (org-remove-subtree-entries-from-agenda)) (org-back-to-heading t) (funcall cmd))) - (error "Archiving works only in Org-mode files")))))) + (error "Archiving works only in Org files")))))) (defun org-remove-subtree-entries-from-agenda (&optional buf beg end) "Remove all lines in the agenda that correspond to a given subtree. @@ -8424,9 +8595,16 @@ If this information is not given, the function uses the tree at point." (defun org-agenda-refile (&optional goto rfloc no-update) "Refile the item at point. -When GOTO is 0 or '(64), clear the refile cache. -When GOTO is '(16), go to the location of the last refiled item. +When called with `\\[universal-argument] \\[universal-argument]', \ +go to the location of the last +refiled item. + +When called with `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix or when GOTO is 0, clear +the refile cache. + RFLOC can be a refile location obtained in a different way. + When NO-UPDATE is non-nil, don't redo the agenda buffer." (interactive "P") (cond @@ -8445,13 +8623,11 @@ When NO-UPDATE is non-nil, don't redo the agenda buffer." (if goto "Goto" "Refile to") buffer org-refile-allow-creating-parent-nodes)))) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((org-agenda-buffer-name buffer-orig)) - (org-remove-subtree-entries-from-agenda)) - (org-refile goto buffer rfloc))))) + (org-with-wide-buffer + (goto-char marker) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-refile goto buffer rfloc)))) (unless no-update (org-agenda-redo))))) (defun org-agenda-open-link (&optional arg) @@ -8476,13 +8652,11 @@ It also looks at the text of the entry itself." (setq trg (and (string-match org-bracket-link-regexp l) (match-string 1 l))) (if (or (not trg) (string-match org-any-link-re trg)) - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (when (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point)))) + (org-with-wide-buffer + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point))) ;; This is an internal link, widen the buffer (switch-to-buffer-other-window buffer) (widen) @@ -8502,11 +8676,14 @@ It also looks at the text of the entry itself." "Get a variable from a referenced buffer and install it here." (let ((m (org-get-at-bol 'org-marker))) (when (and m (buffer-live-p (marker-buffer m))) - (org-set-local var (with-current-buffer (marker-buffer m) - (symbol-value var)))))) + (set (make-local-variable var) + (with-current-buffer (marker-buffer m) + (symbol-value var)))))) (defun org-agenda-switch-to (&optional delete-other-windows) - "Go to the Org-mode file which contains the item at point." + "Go to the Org mode file which contains the item at point. +When optional argument DELETE-OTHER-WINDOWS is non-nil, the +displayed Org file fills the frame." (interactive) (if (and org-return-follows-link (not (org-get-at-bol 'org-marker)) @@ -8516,44 +8693,40 @@ It also looks at the text of the entry itself." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker))) - (org-pop-to-buffer-same-window buffer) - (and delete-other-windows (delete-other-windows)) + (unless buffer (user-error "Trying to switch to non-existent buffer")) + (pop-to-buffer-same-window buffer) + (when delete-other-windows (delete-other-windows)) (widen) (goto-char pos) (when (derived-mode-p 'org-mode) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (when (outline-invisible-p) - (show-entry)) ; display invisible text (run-hooks 'org-agenda-after-show-hook))))) (defun org-agenda-goto-mouse (ev) - "Go to the Org-mode file which contains the item at the mouse click." + "Go to the Org file which contains the item at the mouse click." (interactive "e") (mouse-set-point ev) (org-agenda-goto)) (defun org-agenda-show (&optional full-entry) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. With prefix argument FULL-ENTRY, make the entire entry visible if it was hidden in the outline." (interactive "P") (let ((win (selected-window))) - (if full-entry - (let ((org-show-entry-below t)) - (org-agenda-goto t)) - (org-agenda-goto t)) + (org-agenda-goto t) + (when full-entry (org-show-entry)) (select-window win))) (defvar org-agenda-show-window nil) (defun org-agenda-show-and-scroll-up (&optional arg) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. + When called repeatedly, scroll the window that is displaying the buffer. -With a \\[universal-argument] prefix, use `org-show-entry' instead of -`show-subtree' to display the item, so that drawers and logbooks stay -folded." + +With a `\\[universal-argument]' prefix, use `org-show-entry' instead of \ +`outline-show-subtree' +to display the item, so that drawers and logbooks stay folded." (interactive "P") (let ((win (selected-window))) (if (and (window-live-p org-agenda-show-window) @@ -8562,7 +8735,7 @@ folded." (select-window org-agenda-show-window) (ignore-errors (scroll-up))) (org-agenda-goto t) - (if arg (org-show-entry) (show-subtree)) + (if arg (org-show-entry) (outline-show-subtree)) (setq org-agenda-show-window (selected-window))) (select-window win))) @@ -8576,7 +8749,7 @@ folded." (select-window win)))) (defun org-agenda-show-1 (&optional more) - "Display the Org-mode file which contains the item at point. + "Display the Org file which contains the item at point. The prefix arg selects the amount of information to display: 0 hide the subtree @@ -8594,50 +8767,46 @@ if it was hidden in the outline." (set-window-start (selected-window) (point-at-bol)) (cond ((= more 0) - (hide-subtree) + (outline-hide-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'folded)) (message "Remote: FOLDED")) - ((and (org-called-interactively-p 'any) (= more 1)) + ((and (called-interactively-p 'any) (= more 1)) (message "Remote: show with default settings")) ((= more 2) - (show-entry) - (show-children) + (outline-show-entry) + (org-show-children) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'children)) (message "Remote: CHILDREN")) ((= more 3) - (show-subtree) + (outline-show-subtree) (save-excursion (org-back-to-heading) (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((= more 4) - (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) - (org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) - (show-subtree) - (save-excursion - (org-back-to-heading) - (org-cycle-hide-drawers 'subtree))) + (outline-show-subtree) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'subtree '("LOGBOOK"))) (message "Remote: SUBTREE AND LOGBOOK")) ((> more 4) - (show-subtree) + (outline-show-subtree) (message "Remote: SUBTREE AND ALL DRAWERS"))) (select-window win))) (defvar org-agenda-cycle-counter nil) (defun org-agenda-cycle-show (&optional n) "Show the current entry in another window, with default settings. -Default settings are taken from `org-show-hierarchy-above' and siblings. -When use repeatedly in immediate succession, the remote entry will cycle -through visibility -children -> subtree -> folded +Default settings are taken from `org-show-context-detail'. When +use repeatedly in immediate succession, the remote entry will +cycle through visibility + + children -> subtree -> folded When called with a numeric prefix arg, that arg will be passed through to `org-agenda-show-1'. For the interpretation of that argument, see the @@ -8655,7 +8824,7 @@ docstring of `org-agenda-show-1'." (org-agenda-show-1 org-agenda-cycle-counter)) (defun org-agenda-recenter (arg) - "Display the Org-mode file which contains the item at point and recenter." + "Display the Org file which contains the item at point and recenter." (interactive "P") (let ((win (selected-window))) (org-agenda-goto t) @@ -8663,7 +8832,7 @@ docstring of `org-agenda-show-1'." (select-window win))) (defun org-agenda-show-mouse (ev) - "Display the Org-mode file which contains the item at the mouse click." + "Display the Org file which contains the item at the mouse click." (interactive "e") (mouse-set-point ev) (org-agenda-show)) @@ -8674,7 +8843,8 @@ docstring of `org-agenda-show-1'." (org-agenda-error))) (defun org-agenda-error () - (error "Command not allowed in this line")) + "Throw an error when a command is not allowed in the agenda." + (user-error "Command not allowed in this line")) (defun org-agenda-tree-to-indirect-buffer (arg) "Show the subtree corresponding to the current entry in an indirect buffer. @@ -8682,8 +8852,10 @@ This calls the command `org-tree-to-indirect-buffer' from the original buffer. With a numerical prefix ARG, go up to this level and then take that tree. With a negative numeric ARG, go up by this number of levels. -With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't -use the dedicated frame)." + +With a `\\[universal-argument]' prefix, make a separate frame for this tree, \ +i.e. don't use +the dedicated frame." (interactive "P") (if current-prefix-arg (org-agenda-do-tree-to-indirect-buffer arg) @@ -8701,7 +8873,8 @@ use the dedicated frame)." (and indirect-window (select-window indirect-window)) (switch-to-buffer org-last-indirect-buffer :norecord) (fit-window-to-buffer indirect-window))) - (select-window (get-buffer-window agenda-buffer))))) + (select-window (get-buffer-window agenda-buffer)) + (setq org-agenda-last-indirect-buffer org-last-indirect-buffer)))) (defun org-agenda-do-tree-to-indirect-buffer (arg) "Same as `org-agenda-tree-to-indirect-buffer' without saving window." @@ -8730,9 +8903,9 @@ by a remote command from the agenda.") (org-agenda-todo 'previousset)) (defun org-agenda-todo (&optional arg) - "Cycle TODO state of line at point, also in Org-mode file. + "Cycle TODO state of line at point, also in Org file. This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file." +the same tree node, and the headline of the tree node in the Org file." (interactive "P") (org-agenda-check-no-diary) (let* ((col (current-column)) @@ -8741,7 +8914,7 @@ the same tree node, and the headline of the tree node in the Org-mode file." (buffer (marker-buffer marker)) (pos (marker-position marker)) (hdmarker (org-get-at-bol 'org-hd-marker)) - (todayp (org-agenda-todayp (org-get-at-bol 'day))) + (todayp (org-agenda-today-p (org-get-at-bol 'day))) (inhibit-read-only t) org-agenda-headline-snapshot-before-repeat newhead just-one) (org-with-remote-undo buffer @@ -8749,14 +8922,11 @@ the same tree node, and the headline of the tree node in the Org-mode file." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (let ((current-prefix-arg arg)) (call-interactively 'org-todo)) (and (bolp) (forward-char 1)) (setq newhead (org-get-heading)) - (when (and (org-bound-and-true-p + (when (and (bound-and-true-p org-agenda-headline-snapshot-before-repeat) (not (equal org-agenda-headline-snapshot-before-repeat newhead)) @@ -8769,11 +8939,12 @@ the same tree node, and the headline of the tree node in the Org-mode file." (beginning-of-line 1) (save-window-excursion (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) - (when (org-bound-and-true-p org-clock-out-when-done) + (when (bound-and-true-p org-clock-out-when-done) (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) newhead) (org-agenda-unmark-clocking-task)) - (org-move-to-column col)))) + (org-move-to-column col) + (org-agenda-mark-clocking-task)))) (defun org-agenda-add-note (&optional arg) "Add a time-stamped note to the entry at point." @@ -8789,9 +8960,6 @@ the same tree node, and the headline of the tree node in the Org-mode file." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (org-add-note)))) (defun org-agenda-change-all-lines (newhead hdmarker @@ -8808,9 +8976,9 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (line (org-current-line)) (org-agenda-buffer (current-buffer)) (thetags (with-current-buffer (marker-buffer hdmarker) - (save-excursion (save-restriction (widen) - (goto-char hdmarker) - (org-get-tags-at))))) + (org-with-wide-buffer + (goto-char hdmarker) + (org-get-tags-at)))) props m pl undone-face done-face finish new dotime level cat tags) (save-excursion (goto-char (point-max)) @@ -8822,7 +8990,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (equal m hdmarker)) (setq props (text-properties-at (point)) dotime (org-get-at-bol 'dotime) - cat (org-get-at-bol 'org-category) + cat (org-get-at-eol 'org-category 1) level (org-get-at-bol 'level) tags thetags new @@ -8831,20 +8999,25 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." org-prefix-format-compiled)) (extra (org-get-at-bol 'extra))) (with-current-buffer (marker-buffer hdmarker) - (save-excursion - (save-restriction - (widen) - (org-agenda-format-item extra newhead level cat tags dotime))))) + (org-with-wide-buffer + (org-agenda-format-item extra newhead level cat tags dotime)))) pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) undone-face (org-get-at-bol 'undone-face) done-face (org-get-at-bol 'done-face)) (beginning-of-line 1) (cond - ((equal new "") - (and (looking-at ".*\n?") (replace-match ""))) + ((equal new "") (delete-region (point) (line-beginning-position 2))) ((looking-at ".*") - (replace-match new t t) - (beginning-of-line 1) + ;; When replacing the whole line, preserve bulk mark + ;; overlay, if any. + (let ((mark (catch :overlay + (dolist (o (overlays-in (point) (+ 2 (point)))) + (when (eq (overlay-get o 'type) + 'org-marked-entry-overlay) + (throw :overlay o)))))) + (replace-match new t t) + (beginning-of-line) + (when mark (move-overlay mark (point) (+ 2 (point))))) (add-text-properties (point-at-bol) (point-at-eol) props) (when fixface (add-text-properties @@ -8865,7 +9038,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (let ((inhibit-read-only t) l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + (while (re-search-forward "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (if line (point-at-eol) nil) t) (add-text-properties (match-beginning 2) (match-end 2) @@ -8889,19 +9062,19 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (org-font-lock-add-tag-faces (point-max))))) (defun org-agenda-priority-up () - "Increase the priority of line at point, also in Org-mode file." + "Increase the priority of line at point, also in Org file." (interactive) (org-agenda-priority 'up)) (defun org-agenda-priority-down () - "Decrease the priority of line at point, also in Org-mode file." + "Decrease the priority of line at point, also in Org file." (interactive) (org-agenda-priority 'down)) (defun org-agenda-priority (&optional force-direction) - "Set the priority of line at point, also in Org-mode file. + "Set the priority of line at point, also in Org file. This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file. +the same tree node, and the headline of the tree node in the Org file. Called with a universal prefix arg, show the priority instead of setting it." (interactive "P") (if (equal force-direction '(4)) @@ -8922,9 +9095,6 @@ Called with a universal prefix arg, show the priority instead of setting it." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (funcall 'org-priority force-direction) (end-of-line 1) (setq newhead (org-get-heading))) @@ -8936,7 +9106,7 @@ Called with a universal prefix arg, show the priority instead of setting it." "Set tags for the current headline." (interactive) (org-agenda-check-no-diary) - (if (and (org-region-active-p) (org-called-interactively-p 'any)) + (if (and (org-region-active-p) (called-interactively-p 'any)) (call-interactively 'org-change-tag-in-region) (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) (org-agenda-error))) @@ -8948,12 +9118,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (if tag (org-toggle-tag tag onoff) (call-interactively 'org-set-tags)) @@ -8976,12 +9141,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (call-interactively 'org-set-property))))) (defun org-agenda-set-effort () @@ -8998,12 +9158,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (with-current-buffer buffer (widen) (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) + (org-show-context 'agenda) (call-interactively 'org-set-effort) (end-of-line 1) (setq newhead (org-get-heading))) @@ -9024,9 +9179,6 @@ Called with a universal prefix arg, show the priority instead of setting it." (widen) (goto-char pos) (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading (call-interactively 'org-toggle-archive-tag) (end-of-line 1) (setq newhead (org-get-heading))) @@ -9140,18 +9292,10 @@ Called with a universal prefix arg, show the priority instead of setting it." (when (equal marker (org-get-at-bol 'org-marker)) (remove-text-properties (point-at-bol) (point-at-eol) '(display)) (org-move-to-column (- (window-width) (length stamp)) t) - (if (featurep 'xemacs) - ;; Use `duplicable' property to trigger undo recording - (let ((ex (make-extent nil nil)) - (gl (make-glyph stamp))) - (set-glyph-face gl 'secondary-selection) - (set-extent-properties - ex (list 'invisible t 'end-glyph gl 'duplicable t)) - (insert-extent ex (1- (point)) (point-at-eol))) - (add-text-properties - (1- (point)) (point-at-eol) - (list 'display (org-add-props stamp nil - 'face '(secondary-selection default))))) + (add-text-properties + (1- (point)) (point-at-eol) + (list 'display (org-add-props stamp nil + 'face '(secondary-selection default)))) (beginning-of-line 1)) (beginning-of-line 0))))) @@ -9187,7 +9331,6 @@ ARG is passed through to `org-schedule'." (type (marker-insertion-type marker)) (buffer (marker-buffer marker)) (pos (marker-position marker)) - (org-insert-labeled-timestamps-at-point nil) ts) (set-marker-insertion-type marker t) (org-with-remote-undo buffer @@ -9208,7 +9351,6 @@ ARG is passed through to `org-deadline'." (org-agenda-error))) (buffer (marker-buffer marker)) (pos (marker-position marker)) - (org-insert-labeled-timestamps-at-point nil) ts) (org-with-remote-undo buffer (with-current-buffer buffer @@ -9235,7 +9377,6 @@ ARG is passed through to `org-deadline'." (widen) (goto-char pos) (org-show-context 'agenda) - (org-show-entry) (org-cycle-hide-drawers 'children) (org-clock-in arg) (setq newhead (org-get-heading))) @@ -9250,14 +9391,12 @@ ARG is passed through to `org-deadline'." (let ((marker (make-marker)) (col (current-column)) newhead) (org-with-remote-undo (marker-buffer org-clock-marker) (with-current-buffer (marker-buffer org-clock-marker) - (save-excursion - (save-restriction - (widen) - (goto-char org-clock-marker) - (org-back-to-heading t) - (move-marker marker (point)) - (org-clock-out) - (setq newhead (org-get-heading)))))) + (org-with-wide-buffer + (goto-char org-clock-marker) + (org-back-to-heading t) + (move-marker marker (point)) + (org-clock-out) + (setq newhead (org-get-heading))))) (org-agenda-change-all-lines newhead marker) (move-marker marker nil) (org-move-to-column col) @@ -9284,7 +9423,7 @@ buffer, display it in another window." (cond (pos (goto-char pos)) ;; If the currently clocked entry is not in the agenda ;; buffer, we visit it in another window: - (org-clock-current-task + ((bound-and-true-p org-clock-current-task) (org-switch-to-buffer-other-window (org-clock-goto))) (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) @@ -9334,11 +9473,13 @@ buffer, display it in another window." "Where in `org-agenda-diary-file' should new entries be added? Valid values: -date-tree in the date tree, as child of the date -top-level as top-level entries at the end of the file." +date-tree in the date tree, as first child of the date +date-tree-last in the date tree, as last child of the date +top-level as top-level entries at the end of the file." :group 'org-agenda :type '(choice - (const :tag "in a date tree" date-tree) + (const :tag "first in a date tree" date-tree) + (const :tag "last in a date tree" date-tree-last) (const :tag "as top level at end of file" top-level))) (defcustom org-agenda-insert-diary-extract-time nil @@ -9434,40 +9575,43 @@ Add TEXT as headline, and position the cursor in the second line so that a timestamp can be added there." (widen) (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "* " text "\n") - (if org-adapt-indentation (org-indent-to-column 2))) + (unless (bolp) (insert "\n")) + (org-insert-heading nil t t) + (insert text) + (org-end-of-meta-data) + (unless (bolp) (insert "\n")) + (when org-adapt-indentation (indent-to-column 2))) (defun org-agenda-insert-diary-make-new-entry (text) - "Make a new entry with TEXT as the first child of the current subtree. -Position the point in the line right after the new heading so -that a timestamp can be added there." - (let ((org-show-following-heading t) - (org-show-siblings t) - (org-show-hierarchy-above t) - (org-show-entry-below t) - col) + "Make a new entry with TEXT as a child of the current subtree. +Position the point in the heading's first body line so that +a timestamp can be added there." + (cond + ((eq org-agenda-insert-diary-strategy 'date-tree-last) + (end-of-line) + (org-insert-heading '(4) t) + (org-do-demote)) + (t (outline-next-heading) (org-back-over-empty-lines) - (or (looking-at "[ \t]*$") - (progn (insert "\n") (backward-char 1))) + (unless (looking-at "[ \t]*$") (save-excursion (insert "\n"))) (org-insert-heading nil t) - (org-do-demote) - (setq col (current-column)) - (insert text "\n") - (if org-adapt-indentation (org-indent-to-column col)) - (let ((org-show-following-heading t) - (org-show-siblings t) - (org-show-hierarchy-above t) - (org-show-entry-below t)) - (org-show-context)))) + (org-do-demote))) + (let ((col (current-column))) + (insert text) + (org-end-of-meta-data) + ;; Ensure point is left on a blank line, at proper indentation. + (unless (bolp) (insert "\n")) + (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n"))) + (when org-adapt-indentation (indent-to-column col))) + (org-show-set-visibility 'lineage)) (defun org-agenda-diary-entry () "Make a diary entry, like the `i' command from the calendar. All the standard commands work: block, weekly etc. When `org-agenda-diary-file' points to a file, `org-agenda-diary-entry-in-org-file' is called instead to create -entries in that Org-mode file." +entries in that Org file." (interactive) (if (not (eq org-agenda-diary-file 'diary-file)) (org-agenda-diary-entry-in-org-file) @@ -9476,13 +9620,13 @@ entries in that Org-mode file." (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") (read-char-exclusive))) (cmd (cdr (assoc char - '((?d . insert-diary-entry) - (?w . insert-weekly-diary-entry) - (?m . insert-monthly-diary-entry) - (?y . insert-yearly-diary-entry) - (?a . insert-anniversary-diary-entry) - (?b . insert-block-diary-entry) - (?c . insert-cyclic-diary-entry))))) + '((?d . diary-insert-entry) + (?w . diary-insert-weekly-entry) + (?m . diary-insert-monthly-entry) + (?y . diary-insert-yearly-entry) + (?a . diary-insert-anniversary-entry) + (?b . diary-insert-block-entry) + (?c . diary-insert-cyclic-entry))))) (oldf (symbol-function 'calendar-cursor-to-date)) ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) (point (point)) @@ -9538,7 +9682,7 @@ entries in that Org-mode file." (defun org-agenda-holidays () "Display the holidays for the 3 months around the cursor date." (interactive) - (org-agenda-execute-calendar-command 'list-calendar-holidays)) + (org-agenda-execute-calendar-command 'calendar-list-holidays)) (defvar calendar-longitude) ; defined in calendar.el (defvar calendar-latitude) ; defined in calendar.el @@ -9572,12 +9716,16 @@ argument, latitude and longitude will be prompted for." ;;;###autoload (defun org-calendar-goto-agenda () - "Compute the Org-mode agenda for the calendar date displayed at the cursor. + "Compute the Org agenda for the calendar date displayed at the cursor. This is a command that has to be installed in `calendar-mode-map'." (interactive) - (org-agenda-list nil (calendar-absolute-from-gregorian - (calendar-cursor-to-date)) - nil)) + ;; Temporarily disable sticky agenda since user clearly wants to + ;; refresh view anyway. + (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*") + (org-agenda-sticky nil)) + (org-agenda-list nil (calendar-absolute-from-gregorian + (calendar-cursor-to-date)) + nil))) (defun org-agenda-convert-date () (interactive) @@ -9610,6 +9758,7 @@ This is a command that has to be installed in `calendar-mode-map'." ;;; Bulk commands (defun org-agenda-bulk-marked-p () + "Non-nil when current entry is marked for bulk action." (eq (get-char-property (point-at-bol) 'type) 'org-marked-entry-overlay)) @@ -9651,9 +9800,12 @@ This is a command that has to be installed in `calendar-mode-map'." (goto-char (next-single-property-change (point) 'org-hd-marker)) (while (and (re-search-forward regexp nil t) (setq txt-at-point (get-text-property (point) 'txt))) - (when (string-match regexp txt-at-point) - (setq entries-marked (1+ entries-marked)) - (call-interactively 'org-agenda-bulk-mark)))) + (if (get-char-property (point) 'invisible) + (beginning-of-line 2) + (when (string-match regexp txt-at-point) + (setq entries-marked (1+ entries-marked)) + (call-interactively 'org-agenda-bulk-mark))))) + (if (not entries-marked) (message "No entry matching this regexp.")))) @@ -9712,7 +9864,6 @@ This will remove the markers and the overlays." (interactive) (if (null org-agenda-bulk-marked-entries) (message "No entry to unmark") - (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) (setq org-agenda-bulk-marked-entries nil) (org-agenda-bulk-remove-overlays (point-min) (point-max)))) @@ -9786,21 +9937,21 @@ The prefix arg is passed through to the command if possible." redo-at-end t)) ((equal action ?t) - (setq state (org-icompleting-read + (setq state (completing-read "Todo state: " (with-current-buffer (marker-buffer (car entries)) - (mapcar 'list org-todo-keywords-1)))) + (mapcar #'list org-todo-keywords-1)))) (setq cmd `(let ((org-inhibit-blocking t) (org-inhibit-logging 'note)) (org-agenda-todo ,state)))) ((memq action '(?- ?+)) - (setq tag (org-icompleting-read + (setq tag (completing-read (format "Tag to %s: " (if (eq action ?+) "add" "remove")) (with-current-buffer (marker-buffer (car entries)) (delq nil - (mapcar (lambda (x) - (if (stringp (car x)) x)) org-tag-alist))))) + (mapcar (lambda (x) (and (stringp (car x)) x)) + org-current-tag-alist))))) (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) ((memq action '(?s ?d)) @@ -9810,8 +9961,17 @@ The prefix arg is passed through to the command if possible." nil nil nil (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") org-overriding-default-time))) - (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) - (setq cmd `(eval '(,c1 arg ,time))))) + (c1 (if (eq action ?s) 'org-agenda-schedule + 'org-agenda-deadline))) + ;; Make sure to not prompt for a note when bulk + ;; rescheduling as Org cannot cope with simultaneous + ;; notes. Besides, it could be annoying depending on the + ;; number of items re-scheduled. + (setq cmd `(eval '(let ((org-log-reschedule + (and org-log-reschedule 'time)) + (org-log-redeadline + (and org-log-redeadline 'time))) + (,c1 arg ,time)))))) ((equal action ?S) (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) @@ -9828,13 +9988,13 @@ The prefix arg is passed through to the command if possible." (calendar-gregorian-from-absolute (org-today))))) (dotimes (i (1+ dist)) (while (member day-of-week org-agenda-weekend-days) - (incf distance) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))))) + (cl-incf distance) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))) + (cl-incf day-of-week) + (when (= day-of-week 7) + (setq day-of-week 0))))) ;; silently fail when try to replan a sexp entry (condition-case nil (let* ((date (calendar-gregorian-from-absolute @@ -9850,8 +10010,8 @@ The prefix arg is passed through to the command if possible." ((equal action ?f) (setq cmd (list (intern - (org-icompleting-read "Function: " - obarray 'fboundp t nil nil))))) + (completing-read "Function: " + obarray 'fboundp t nil nil))))) (t (user-error "Invalid bulk action"))) @@ -9874,6 +10034,11 @@ The prefix arg is passed through to the command if possible." (goto-char pos) (let (org-loop-over-headlines-in-active-region) (eval cmd)) + ;; `post-command-hook' is not run yet. We make sure any + ;; pending log note is processed. + (when (or (memq 'org-add-log-note (default-value 'post-command-hook)) + (memq 'org-add-log-note post-command-hook)) + (org-add-log-note)) (setq cnt (1+ cnt)))) (when redo-at-end (org-agenda-redo)) (unless org-agenda-persistent-marks @@ -9903,12 +10068,14 @@ current HH:MM time." (defun org-agenda-reapply-filters () "Re-apply all agenda filters." (mapcar - (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f)))) + (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t))) `((,org-agenda-tag-filter tag) (,org-agenda-category-filter category) (,org-agenda-regexp-filter regexp) + (,org-agenda-effort-filter effort) (,(get 'org-agenda-tag-filter :preset-filter) tag) (,(get 'org-agenda-category-filter :preset-filter) category) + (,(get 'org-agenda-effort-filter :preset-filter) effort) (,(get 'org-agenda-regexp-filter :preset-filter) regexp)))) (defun org-agenda-drag-line-forward (arg &optional backward) @@ -9969,7 +10136,9 @@ tag and (if present) the flagging note." (replace-match "\n" t t)) (goto-char (point-min)) (select-window win) - (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note")))) + (message "%s" (substitute-command-keys "Flagging note pushed to \ +kill ring. Press `\\[org-agenda-show-the-flagging-note]' again to remove \ +tag and note"))))) (defun org-agenda-remove-flag (marker) "Remove the FLAGGED tag and any flagging note in the entry." @@ -9992,7 +10161,8 @@ tag and (if present) the flagging note." ;;;###autoload (defun org-agenda-to-appt (&optional refresh filter &rest args) "Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of + +With a `\\[universal-argument]' prefix, refresh the list of \ appointments. If FILTER is t, interactively prompt the user for a regular @@ -10008,8 +10178,8 @@ argument: an entry from `org-agenda-get-day-entries'. FILTER can also be an alist with the car of each cell being either `headline' or `category'. For example: - ((headline \"IMPORTANT\") - (category \"Work\")) + \\='((headline \"IMPORTANT\") + (category \"Work\")) will only add headlines containing IMPORTANT or headlines belonging to the \"Work\" category. @@ -10026,75 +10196,78 @@ to override `appt-message-warning-time'." (if refresh (setq appt-time-msg-list nil)) (if (eq filter t) (setq filter (read-from-minibuffer "Regexp filter: "))) - (let* ((cnt 0) ; count added events - (scope (or args '(:deadline* :scheduled* :timestamp))) - (org-agenda-new-buffers nil) - (org-deadline-warning-days 0) - ;; Do not use `org-today' here because appt only takes - ;; time and without date as argument, so it may pass wrong - ;; information otherwise - (today (org-date-to-gregorian - (time-to-days (current-time)))) - (org-agenda-restrict nil) - (files (org-agenda-files 'unrestricted)) entries file - (org-agenda-buffer nil)) + (let* ((cnt 0) ; count added events + (scope (or args '(:deadline* :scheduled* :timestamp))) + (org-agenda-new-buffers nil) + (org-deadline-warning-days 0) + ;; Do not use `org-today' here because appt only takes + ;; time and without date as argument, so it may pass wrong + ;; information otherwise + (today (org-date-to-gregorian + (time-to-days (current-time)))) + (org-agenda-restrict nil) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) ;; Get all entries which may contain an appt (org-agenda-prepare-buffers files) (while (setq file (pop files)) (setq entries - (delq nil - (append entries - (apply 'org-agenda-get-day-entries - file today scope))))) + (delq nil + (append entries + (apply 'org-agenda-get-day-entries + file today scope))))) ;; Map thru entries and find if we should filter them out (mapc - (lambda(x) + (lambda (x) (let* ((evt (org-trim - (replace-regexp-in-string - org-bracket-link-regexp "\\3" - (or (get-text-property 1 'txt x) "")))) - (cat (get-text-property 1 'org-category x)) - (tod (get-text-property 1 'time-of-day x)) - (ok (or (null filter) - (and (stringp filter) (string-match filter evt)) - (and (functionp filter) (funcall filter x)) - (and (listp filter) - (let ((cat-filter (cadr (assoc 'category filter))) - (evt-filter (cadr (assoc 'headline filter)))) - (or (and (stringp cat-filter) - (string-match cat-filter cat)) - (and (stringp evt-filter) - (string-match evt-filter evt))))))) - (wrn (get-text-property 1 'warntime x))) - ;; FIXME: Shall we remove text-properties for the appt text? - ;; (setq evt (set-text-properties 0 (length evt) nil evt)) - (when (and ok tod) - (setq tod (concat "00" (number-to-string tod)) - tod (when (string-match - "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) - (concat (match-string 1 tod) ":" - (match-string 2 tod)))) - (if (version< emacs-version "23.3") - (appt-add tod evt) - (appt-add tod evt wrn)) - (setq cnt (1+ cnt))))) entries) + (replace-regexp-in-string + org-bracket-link-regexp "\\3" + (or (get-text-property 1 'txt x) "")))) + (cat (get-text-property (1- (length x)) 'org-category x)) + (tod (get-text-property 1 'time-of-day x)) + (ok (or (null filter) + (and (stringp filter) (string-match filter evt)) + (and (functionp filter) (funcall filter x)) + (and (listp filter) + (let ((cat-filter (cadr (assq 'category filter))) + (evt-filter (cadr (assq 'headline filter)))) + (or (and (stringp cat-filter) + (string-match cat-filter cat)) + (and (stringp evt-filter) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) + ;; FIXME: Shall we remove text-properties for the appt text? + ;; (setq evt (set-text-properties 0 (length evt) nil evt)) + (when (and ok tod (not (string-match "\\`DONE\\|CANCELLED" evt))) + (setq tod (concat "00" (number-to-string tod))) + (setq tod (when (string-match + "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) + (concat (match-string 1 tod) ":" + (match-string 2 tod)))) + (when (if (version< emacs-version "23.3") + (appt-add tod evt) + (appt-add tod evt wrn)) + (setq cnt (1+ cnt)))))) + entries) (org-release-buffers org-agenda-new-buffers) (if (eq cnt 0) - (message "No event to add") + (message "No event to add") (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) -(defun org-agenda-todayp (date) - "Does DATE mean today, when considering `org-extend-today-until'?" - (let ((today (org-today)) - (date (if (and date (listp date)) (calendar-absolute-from-gregorian date) - date))) - (eq date today))) +(defun org-agenda-today-p (date) + "Non nil when DATE means today. +DATE is either a list of the form (month day year) or a number of +days as returned by `calendar-absolute-from-gregorian' or +`org-today'. This function considers `org-extend-today-until' +when defining today." + (eq (org-today) + (if (consp date) (calendar-absolute-from-gregorian date) date))) (defun org-agenda-todo-yesterday (&optional arg) "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." (interactive "P") - (let* ((hour (third (decode-time - (org-current-time)))) + (let* ((org-use-effective-time t) + (hour (nth 2 (decode-time (org-current-time)))) (org-extend-today-until (1+ hour))) (org-agenda-todo arg))) diff --git a/lisp/org/org-archive.el b/lisp/org/org-archive.el index 39a6581046..ce1f35df36 100644 --- a/lisp/org/org-archive.el +++ b/lisp/org/org-archive.el @@ -1,4 +1,4 @@ -;;; org-archive.el --- Archiving for Org-mode +;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -29,10 +29,10 @@ ;;; Code: (require 'org) -(eval-when-compile (require 'cl)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-element-type "org-element" (element)) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (defcustom org-archive-default-command 'org-archive-subtree "The default archiving command." @@ -57,7 +57,7 @@ See `org-archive-to-archive-sibling' for more information." (defcustom org-archive-mark-done nil "Non-nil means mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will +This can be a string to set the keyword to use. When non-nil, Org will use the first keyword in its list that means done." :group 'org-archive :type '(choice @@ -120,9 +120,15 @@ information." (const :tag "Outline path" olpath) (const :tag "Local tags" ltags))) +(defvar org-archive-hook nil + "Hook run after successfully archiving a subtree. +Hook functions are called with point on the subtree in the +original file. At this stage, the subtree has been added to the +archive location, but not yet deleted from the original file.") + (defun org-get-local-archive-location () "Get the archive location applicable at point." - (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") + (let ((re "^[ \t]*#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") prop) (save-excursion (save-restriction @@ -154,21 +160,24 @@ archive file is." (defun org-all-archive-files () "Get a list of all archive files used in the current buffer." - (let (file files) - (save-excursion - (save-restriction - (goto-char (point-min)) - (while (re-search-forward - "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)" - nil t) - (setq file (org-extract-archive-file - (org-match-string-no-properties 2))) - (and file (> (length file) 0) (file-exists-p file) - (pushnew file files :test #'equal))))) + (let ((case-fold-search t) + files) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*\\(#\\+\\|:\\)ARCHIVE:[ \t]+\\(.*\\)" + nil t) + (when (save-match-data + (if (eq (match-string 1) ":") (org-at-property-p) + (eq (org-element-type (org-element-at-point)) 'keyword))) + (let ((file (org-extract-archive-file + (match-string-no-properties 2)))) + (when (and (org-string-nw-p file) (file-exists-p file)) + (push file files)))))) (setq files (nreverse files)) - (setq file (org-extract-archive-file)) - (and file (> (length file) 0) (file-exists-p file) - (pushnew file files :test #'equal)) + (let ((file (org-extract-archive-file))) + (when (and (org-string-nw-p file) (file-exists-p file)) + (push file files))) files)) (defun org-extract-archive-file (&optional location) @@ -195,15 +204,19 @@ if LOCATION is not given, the value of `org-archive-location' is used." ;;;###autoload (defun org-archive-subtree (&optional find-done) "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this command is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." +The archive can be a certain top-level heading in the current +file, or in a different file. The tree will be moved to that +location, the subtree heading be marked DONE, and the current +time will be added. + +When called with a single prefix argument FIND-DONE, find whole +trees without any open TODO items and archive them (after getting +confirmation from the user). When called with a double prefix +argument, find whole trees with timestamps before today and +archive them (after getting confirmation from the user). If the +cursor is not at a headline when these commands are called, try +all level 1 trees. If the cursor is on a headline, only try the +direct children of this heading." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) @@ -213,46 +226,36 @@ this heading." `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point))) (org-archive-subtree ,find-done)) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if find-done - (org-archive-all-done) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) + (cond + ((equal find-done '(4)) (org-archive-all-done)) + ((equal find-done '(16)) (org-archive-all-old)) + (t ;; Save all relevant TODO keyword-relatex variables - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name - (or (buffer-file-name (buffer-base-buffer)) - (error "No file associated to buffer")))) - (olpath (mapconcat 'identity (org-get-outline-path) "/")) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1))) - category todo priority ltags itags atags - ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p infile-p visiting - datetree-date datetree-subheading-p) - - ;; Find the local archive location - (setq location (org-get-local-archive-location) - afile (org-extract-archive-file location) - heading (org-extract-archive-heading location) - infile-p (equal file (abbreviate-file-name (or afile "")))) - (unless afile - (error "Invalid `org-archive-location'")) - - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - visiting (find-buffer-visiting afile) - buffer (or visiting (find-file-noselect afile))) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) + (let* ((tr-org-todo-keywords-1 org-todo-keywords-1) + (tr-org-todo-kwd-alist org-todo-kwd-alist) + (tr-org-done-keywords org-done-keywords) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (tr-org-odd-levels-only org-odd-levels-only) + (this-buffer (current-buffer)) + (time (format-time-string + (substring (cdr org-time-stamp-formats) 1 -1))) + (file (abbreviate-file-name + (or (buffer-file-name (buffer-base-buffer)) + (error "No file associated to buffer")))) + (location (org-get-local-archive-location)) + (afile (or (org-extract-archive-file location) + (error "Invalid `org-archive-location'"))) + (heading (org-extract-archive-heading location)) + (infile-p (equal file (abbreviate-file-name (or afile "")))) + (newfile-p (and (org-string-nw-p afile) + (not (file-exists-p afile)))) + (buffer (cond ((not (org-string-nw-p afile)) this-buffer) + ((find-buffer-visiting afile)) + ((find-file-noselect afile)) + (t (error "Cannot access file \"%s\"" afile)))) + level datetree-date datetree-subheading-p) (when (string-match "\\`datetree/" heading) ;; Replace with ***, to represent the 3 levels of headings the ;; datetree has. @@ -266,108 +269,120 @@ this heading." (setq heading nil level 0)) (save-excursion (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (setq category (org-get-category nil 'force-refresh) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority - (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at)) - atags (org-get-tags-at)) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect `this-command', to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree 1 nil t)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (derived-mode-p 'org-mode)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when (and newfile-p org-archive-file-header-format) - (goto-char (point-max)) - (insert (format org-archive-file-header-format - (buffer-file-name this-buffer)))) - (when datetree-date - (require 'org-datetree) - (org-datetree-find-date-create datetree-date) - (org-narrow-to-subtree)) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (show-all) - (if (and heading (not (and datetree-date (not datetree-subheading-p)))) - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - ;; datetrees don't need too much spacing - (insert (if datetree-date "" "\n") heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (if org-archive-reversed-order - (progn - (org-back-to-heading t) - (outline-next-heading)) - (org-end-of-subtree t)) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - ;; datetree archives don't need so much spacing. - (replace-match (if datetree-date "\n" "\n\n")))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (unless datetree-date (insert "\n"))) - ;; Paste - (org-paste-subtree (org-get-valid-level level (and heading 1))) - ;; Shall we append inherited tags? - (and itags - (or (and (eq org-archive-subtree-add-inherited-tags 'infile) - infile-p) - (eq org-archive-subtree-add-inherited-tags t)) - (org-set-tags-to atags)) - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done org-todo-log-states) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - (widen) - ;; Save and kill the buffer, if it is not the same buffer. - (when (not (eq this-buffer buffer)) - (save-buffer)))) - ;; Here we are back in the original buffer. Everything seems to have - ;; worked. So now cut the tree and finish up. + ;; Get context information that will be lost by moving the + ;; tree. See `org-archive-save-context-info'. + (let* ((all-tags (org-get-tags-at)) + (local-tags (org-get-tags)) + (inherited-tags (org-delete-all local-tags all-tags)) + (context + `((category . ,(org-get-category nil 'force-refresh)) + (file . ,file) + (itags . ,(mapconcat #'identity inherited-tags " ")) + (ltags . ,(mapconcat #'identity local-tags " ")) + (olpath . ,(mapconcat #'identity + (org-get-outline-path) + "/")) + (time . ,time) + (todo . ,(org-entry-get (point) "TODO"))))) + ;; We first only copy, in case something goes wrong + ;; we need to protect `this-command', to avoid kill-region sets it, + ;; which would lead to duplication of subtrees + (let (this-command) (org-copy-subtree 1 nil t)) + (set-buffer buffer) + ;; Enforce Org mode for the archive buffer + (if (not (derived-mode-p 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t) + (org-inhibit-startup t)) + (call-interactively 'org-mode))) + (when (and newfile-p org-archive-file-header-format) + (goto-char (point-max)) + (insert (format org-archive-file-header-format + (buffer-file-name this-buffer)))) + (when datetree-date + (require 'org-datetree) + (org-datetree-find-date-create datetree-date) + (org-narrow-to-subtree)) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords-1 tr-org-todo-keywords-1) + (org-todo-kwd-alist tr-org-todo-kwd-alist) + (org-done-keywords tr-org-done-keywords) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp) + (org-odd-levels-only + (if (local-variable-p 'org-odd-levels-only (current-buffer)) + org-odd-levels-only + tr-org-odd-levels-only))) + (goto-char (point-min)) + (outline-show-all) + (if (and heading (not (and datetree-date (not datetree-subheading-p)))) + (progn + (if (re-search-forward + (concat "^" (regexp-quote heading) + "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)") + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + ;; datetrees don't need too much spacing + (insert (if datetree-date "" "\n") heading "\n") + (end-of-line 0)) + ;; Make the subtree visible + (outline-show-subtree) + (if org-archive-reversed-order + (progn + (org-back-to-heading t) + (outline-next-heading)) + (org-end-of-subtree t)) + (skip-chars-backward " \t\r\n") + (and (looking-at "[ \t\r\n]*") + ;; datetree archives don't need so much spacing. + (replace-match (if datetree-date "\n" "\n\n")))) + ;; No specific heading, just go to end of file. + (goto-char (point-max)) + ;; Subtree narrowing can let the buffer end on + ;; a headline. `org-paste-subtree' then deletes it. + ;; To prevent this, make sure visible part of buffer + ;; always terminates on a new line, while limiting + ;; number of blank lines in a date tree. + (unless (and datetree-date (bolp)) (insert "\n"))) + ;; Paste + (org-paste-subtree (org-get-valid-level level (and heading 1))) + ;; Shall we append inherited tags? + (and inherited-tags + (or (and (eq org-archive-subtree-add-inherited-tags 'infile) + infile-p) + (eq org-archive-subtree-add-inherited-tags t)) + (org-set-tags-to all-tags)) + ;; Mark the entry as done + (when (and org-archive-mark-done + (let ((case-fold-search nil)) + (looking-at org-todo-line-regexp)) + (or (not (match-end 2)) + (not (member (match-string 2) org-done-keywords)))) + (let (org-log-done org-todo-log-states) + (org-todo + (car (or (member org-archive-mark-done org-done-keywords) + org-done-keywords))))) + + ;; Add the context info. + (dolist (item org-archive-save-context-info) + (let ((value (cdr (assq item context)))) + (when (org-string-nw-p value) + (org-entry-put + (point) + (concat "ARCHIVE_" (upcase (symbol-name item))) + value)))) + (widen) + ;; Save and kill the buffer, if it is not the same + ;; buffer. + (unless (eq this-buffer buffer) (save-buffer))))) + ;; Here we are back in the original buffer. Everything seems + ;; to have worked. So now run hooks, cut the tree and finish + ;; up. + (run-hooks 'org-archive-hook) (let (this-command) (org-cut-subtree)) (when (featurep 'org-inlinetask) (org-inlinetask-remove-END-maybe)) @@ -375,7 +390,7 @@ this heading." (message "Subtree archived %s" (if (eq this-buffer buffer) (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name afile)))))) + (concat "in file: " (abbreviate-file-name afile))))))) (org-reveal) (if (looking-at "^[ \t]*$") (outline-next-visible-heading 1)))) @@ -383,9 +398,12 @@ this heading." ;;;###autoload (defun org-archive-to-archive-sibling () "Archive the current heading by moving it under the archive sibling. + The archive sibling is a sibling of the heading with the heading name `org-archive-sibling-heading' and an `org-archive-tag' tag. If this -sibling does not exist, it will be created at the end of the subtree." +sibling does not exist, it will be created at the end of the subtree. + +Archiving time is retained in the ARCHIVE_TIME node property." (interactive) (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level) @@ -400,7 +418,7 @@ sibling does not exist, it will be created at the end of the subtree." (when (org-at-heading-p) (org-archive-to-archive-sibling))) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (save-restriction (widen) (let (b e pos leader level) @@ -443,7 +461,7 @@ sibling does not exist, it will be created at the end of the subtree." (format-time-string (substring (cdr org-time-stamp-formats) 1 -1))) (outline-up-heading 1 t) - (hide-subtree) + (outline-hide-subtree) (org-cycle-show-empty-lines 'folded) (goto-char pos))) (org-reveal) @@ -455,13 +473,51 @@ sibling does not exist, it will be created at the end of the subtree." If the cursor is not on a headline, try all level 1 trees. If it is on a headline, try all direct children. When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re org-not-done-heading-regexp) re1 - (rea (concat ".*:" org-archive-tag ":")) + (org-archive-all-matches + (lambda (_beg end) + (let ((case-fold-search nil)) + (unless (re-search-forward org-not-done-heading-regexp end t) + "no open TODO items"))) + tag)) + +(defun org-archive-all-old (&optional tag) + "Archive sublevels of the current tree with timestamps prior to today. +If the cursor is not on a headline, try all level 1 trees. If +it is on a headline, try all direct children. +When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." + (org-archive-all-matches + (lambda (_beg end) + (let (ts) + (and (re-search-forward org-ts-regexp end t) + (setq ts (match-string 0)) + (< (org-time-stamp-to-now ts) 0) + (if (not (looking-at + (concat "--\\(" org-ts-regexp "\\)"))) + (concat "old timestamp " ts) + (setq ts (concat "old timestamp " ts (match-string 0))) + (and (< (org-time-stamp-to-now (match-string 1)) 0) + ts))))) + tag)) + +(defun org-archive-all-matches (predicate &optional tag) + "Archive sublevels of the current tree that match PREDICATE. + +PREDICATE is a function of two arguments, BEG and END, which +specify the beginning and end of the headline being considered. +It is called with point positioned at BEG. The headline will be +archived if PREDICATE returns non-nil. If the return value of +PREDICATE is a string, it should describe the reason for +archiving the heading. + +If the cursor is not on a headline, try all level 1 trees. If it +is on a headline, try all direct children. When TAG is non-nil, +don't move trees, but mark them with the ARCHIVE tag." + (let ((rea (concat ".*:" org-archive-tag ":")) re1 (begm (make-marker)) (endm (make-marker)) - (question (if tag "Set ARCHIVE tag (no open TODO items)? " - "Move subtree to archive (no open TODO items)? ")) - beg end (cntarch 0)) + (question (if tag "Set ARCHIVE tag? " + "Move subtree to archive? ")) + reason beg end (cntarch 0)) (if (org-at-heading-p) (progn (setq re1 (concat "^" (regexp-quote @@ -481,11 +537,14 @@ When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." (setq beg (match-beginning 0) end (save-excursion (org-end-of-subtree t) (point))) (goto-char beg) - (if (re-search-forward re end t) + (if (not (setq reason (funcall predicate beg end))) (goto-char end) (goto-char beg) (if (and (or (not tag) (not (looking-at rea))) - (y-or-n-p question)) + (y-or-n-p + (if (stringp reason) + (concat question "(" reason ")") + question))) (progn (if tag (org-toggle-tag org-archive-tag 'on) @@ -507,14 +566,14 @@ the children that do not contain any open TODO items." (org-map-entries `(org-toggle-archive-tag ,find-done) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (if find-done (org-archive-all-done 'tag) (let (set) (save-excursion (org-back-to-heading t) (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) + (when set (org-flag-subtree t))) (and set (beginning-of-line 1)) (message "Subtree %s" (if set "archived" "unarchived")))))) @@ -528,7 +587,7 @@ the children that do not contain any open TODO items." (org-map-entries 'org-archive-set-tag org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (org-toggle-tag org-archive-tag 'on))) ;;;###autoload diff --git a/lisp/org/org-attach.el b/lisp/org/org-attach.el index 7d25437d9f..a026eee4f1 100644 --- a/lisp/org/org-attach.el +++ b/lisp/org/org-attach.el @@ -1,4 +1,4 @@ -;;; org-attach.el --- Manage file attachments to org-mode tasks +;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. @@ -22,7 +22,7 @@ ;;; Commentary: -;; See the Org-mode manual for information on how to use it. +;; See the Org manual for information on how to use it. ;; ;; Attachments are managed in a special directory called "data", which ;; lives in the same directory as the org file itself. If this data @@ -37,14 +37,13 @@ ;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-id) +(require 'cl-lib) (require 'org) +(require 'org-id) (require 'vc-git) (defgroup org-attach nil - "Options concerning entry attachments in Org-mode." + "Options concerning entry attachments in Org mode." :tag "Org Attach" :group 'org) @@ -55,6 +54,14 @@ where the Org file lives." :group 'org-attach :type 'directory) +(defcustom org-attach-commit t + "If non-nil commit attachments with git. +This is only done if the Org file is in a git repository." + :group 'org-attach + :type 'boolean + :version "26.1" + :package-version '(Org . "9.0")) + (defcustom org-attach-git-annex-cutoff (* 32 1024) "If non-nil, files larger than this will be annexed instead of stored." :group 'org-attach @@ -120,6 +127,28 @@ lns create a symbol link. Note that this is not supported (const :tag "Link to origin location" t) (const :tag "Link to the attach-dir location" attached))) +(defcustom org-attach-archive-delete nil + "Non-nil means attachments are deleted upon archiving a subtree. +When set to `query', ask the user instead." + :group 'org-attach + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Never delete attachments" nil) + (const :tag "Always delete attachments" t) + (const :tag "Query the user" query))) + +(defcustom org-attach-annex-auto-get 'ask + "Confirmation preference for automatically getting annex files. +If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." + :group 'org-attach + :package-version '(Org . "9") + :version "26.1" + :type '(choice + (const :tag "confirm with `y-or-n-p'" ask) + (const :tag "always get from annex if necessary" t) + (const :tag "never get from annex" nil))) + ;;;###autoload (defun org-attach () "The dispatcher for attachment commands. @@ -197,25 +226,23 @@ using the entry ID will be invoked to access the unique directory for the current entry. If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, the directory and (if necessary) the corresponding ID will be created." - (let (attach-dir uuid inherit) + (let (attach-dir uuid) (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) (cond ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) (org-attach-check-absolute-path attach-dir)) ((and org-attach-allow-inheritance - (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) + (org-entry-get nil "ATTACH_DIR_INHERIT" t)) (setq attach-dir - (save-excursion - (save-restriction - (widen) - (if (marker-position org-entry-property-inherited-from) - (goto-char org-entry-property-inherited-from) - (org-back-to-heading t)) - (let (org-attach-allow-inheritance) - (org-attach-dir create-if-not-exists-p))))) + (org-with-wide-buffer + (if (marker-position org-entry-property-inherited-from) + (goto-char org-entry-property-inherited-from) + (org-back-to-heading t)) + (let (org-attach-allow-inheritance) + (org-attach-dir create-if-not-exists-p)))) (org-attach-check-absolute-path attach-dir) (setq org-attach-inherited t)) - (t ; use the ID + (t ; use the ID (org-attach-check-absolute-path nil) (setq uuid (org-id-get (point) create-if-not-exists-p)) (when (or uuid create-if-not-exists-p) @@ -261,33 +288,59 @@ the ATTACH_DIR property) their own attachment directory." (org-entry-put nil "ATTACH_DIR_INHERIT" "t") (message "Children will inherit attachment directory")) +(defun org-attach-use-annex () + "Return non-nil if git annex can be used." + (let ((git-dir (vc-git-root (expand-file-name org-attach-directory)))) + (and org-attach-git-annex-cutoff + (or (file-exists-p (expand-file-name "annex" git-dir)) + (file-exists-p (expand-file-name ".git/annex" git-dir)))))) + +(defun org-attach-annex-get-maybe (path) + "Call git annex get PATH (via shell) if using git annex. +Signals an error if the file content is not available and it was not retrieved." + (let ((path-relative (file-relative-name path))) + (when (and (org-attach-use-annex) + (not + (string-equal + "found" + (shell-command-to-string + (format "git annex find --format=found --in=here %s" + (shell-quote-argument path-relative)))))) + (let ((should-get + (if (eq org-attach-annex-auto-get 'ask) + (y-or-n-p (format "Run git annex get %s? " path-relative)) + org-attach-annex-auto-get))) + (if should-get + (progn (message "Running git annex get \"%s\"." path-relative) + (call-process "git" nil nil nil "annex" "get" path-relative)) + (error "File %s stored in git annex but it is not available, and was not retrieved" + path)))))) + (defun org-attach-commit () "Commit changes to git if `org-attach-directory' is properly initialized. This checks for the existence of a \".git\" directory in that directory." (let* ((dir (expand-file-name org-attach-directory)) (git-dir (vc-git-root dir)) + (use-annex (org-attach-use-annex)) (changes 0)) (when (and git-dir (executable-find "git")) (with-temp-buffer (cd dir) - (let ((have-annex - (and org-attach-git-annex-cutoff - (file-exists-p (expand-file-name "annex" git-dir))))) - (dolist (new-or-modified - (split-string - (shell-command-to-string - "git ls-files -zmo --exclude-standard") "\0" t)) - (if (and have-annex - (>= (nth 7 (file-attributes new-or-modified)) - org-attach-git-annex-cutoff)) - (call-process "git" nil nil nil "annex" "add" new-or-modified) - (call-process "git" nil nil nil "add" new-or-modified)) - (incf changes))) + (dolist (new-or-modified + (split-string + (shell-command-to-string + "git ls-files -zmo --exclude-standard") "\0" t)) + (if (and use-annex + (>= (nth 7 (file-attributes new-or-modified)) + org-attach-git-annex-cutoff)) + (call-process "git" nil nil nil "annex" "add" new-or-modified) + (call-process "git" nil nil nil "add" new-or-modified)) + (cl-incf changes)) (dolist (deleted (split-string (shell-command-to-string "git ls-files -z --deleted") "\0" t)) (call-process "git" nil nil nil "rm" deleted) - (incf changes)) + (cl-incf changes)) (when (> changes 0) (shell-command "git commit -m 'Synchronized attachments'")))))) @@ -328,7 +381,8 @@ METHOD may be `cp', `mv', `ln', or `lns' default taken from ((eq method 'cp) (copy-file file fname)) ((eq method 'ln) (add-name-to-file file fname)) ((eq method 'lns) (make-symbolic-link file fname))) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-tag) (cond ((eq org-attach-store-link-p 'attached) (org-attach-store-link fname)) @@ -378,7 +432,7 @@ The attachment is created as an Emacs buffer." (let* ((attach-dir (org-attach-dir t)) (files (org-attach-file-list attach-dir)) (file (or file - (org-icompleting-read + (completing-read "Delete attachment: " (mapcar (lambda (f) (list (file-name-nondirectory f))) @@ -387,7 +441,8 @@ The attachment is created as an Emacs buffer." (unless (file-exists-p file) (error "No such attachment: %s" file)) (delete-file file) - (org-attach-commit))) + (when org-attach-commit + (org-attach-commit)))) (defun org-attach-delete-all (&optional force) "Delete all attachments from the current task. @@ -403,14 +458,16 @@ A safer way is to open the directory in dired and delete from there." (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) (shell-command (format "rm -fr %s" attach-dir)) (message "Attachment directory removed") - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-untag)))) (defun org-attach-sync () "Synchronize the current tasks with its attachments. This can be used after files have been added externally." (interactive) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (when (and org-attach-file-list-property (not org-attach-inherited)) (org-entry-delete (point) org-attach-file-list-property)) (let ((attach-dir (org-attach-dir))) @@ -419,15 +476,15 @@ This can be used after files have been added externally." (and files (org-attach-tag)) (when org-attach-file-list-property (dolist (file files) - (unless (string-match "^\\." file) + (unless (string-match "^\\.\\.?\\'" file) (org-entry-add-to-multivalued-property (point) org-attach-file-list-property file)))))))) (defun org-attach-file-list (dir) "Return a list of files in the attachment directory. -This ignores files starting with a \".\", and files ending in \"~\"." +This ignores files ending in \"~\"." (delq nil - (mapcar (lambda (x) (if (string-match "^\\." x) nil x)) + (mapcar (lambda (x) (if (string-match "^\\.\\.?\\'" x) nil x)) (directory-files dir nil "[^~]\\'")))) (defun org-attach-reveal (&optional if-exists) @@ -454,9 +511,11 @@ If IN-EMACS is non-nil, force opening in Emacs." (files (org-attach-file-list attach-dir)) (file (if (= (length files) 1) (car files) - (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) - (org-open-file (expand-file-name file attach-dir) in-emacs))) + (completing-read "Open attachment: " + (mapcar #'list files) nil t))) + (path (expand-file-name file attach-dir))) + (org-attach-annex-get-maybe path) + (org-open-file path in-emacs))) (defun org-attach-open-in-emacs () "Open attachment, force opening in Emacs. @@ -475,6 +534,17 @@ Basically, this adds the path to the attachment directory, and a \"file:\" prefix." (concat "file:" (org-attach-expand file))) +(defun org-attach-archive-delete-maybe () + "Maybe delete subtree attachments when archiving. +This function is called by `org-archive-hook'. The option +`org-attach-archive-delete' controls its behavior." + (when (if (eq org-attach-archive-delete 'query) + (yes-or-no-p "Delete all attachments? ") + org-attach-archive-delete) + (org-attach-delete-all t))) + +(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe) + (provide 'org-attach) ;; Local variables: diff --git a/lisp/org/org-bbdb.el b/lisp/org/org-bbdb.el index e41bda47db..f851668157 100644 --- a/lisp/org/org-bbdb.el +++ b/lisp/org/org-bbdb.el @@ -1,4 +1,4 @@ -;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode +;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -25,12 +25,12 @@ ;; ;;; Commentary: -;; This file implements links to BBDB database entries from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to BBDB database entries from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; It also implements an interface (based on Ivar Rummelhoff's -;; bbdb-anniv.el) for those org-mode users, who do not use the diary +;; bbdb-anniv.el) for those Org users, who do not use the diary ;; but who do want to include the anniversaries stored in the BBDB ;; into the org-agenda. If you already include the `diary' into the ;; agenda, you might want to prefer to include the anniversaries in @@ -94,8 +94,7 @@ ;;; Code: (require 'org) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) ;; Declare external functions and variables @@ -106,6 +105,7 @@ (declare-function bbdb-name "ext:bbdb-com" (string elidep)) (declare-function bbdb-completing-read-record "ext:bbdb-com" (prompt &optional omit-records)) +(declare-function bbdb-record-field "ext:bbdb" (recond field)) (declare-function bbdb-record-getprop "ext:bbdb" (record property)) (declare-function bbdb-record-name "ext:bbdb" (record)) (declare-function bbdb-records "ext:bbdb" @@ -124,7 +124,7 @@ (declare-function calendar-leap-year-p "calendar" (year)) (declare-function diary-ordinal-suffix "diary-lib" (n)) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(with-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Customization @@ -194,10 +194,12 @@ date year)." :group 'org-bbdb-anniversaries :require 'bbdb) - ;; Install the link type -(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export) -(add-hook 'org-store-link-functions 'org-bbdb-store-link) +(org-link-set-parameters "bbdb" + :follow #'org-bbdb-open + :export #'org-bbdb-export + :complete #'org-bbdb-complete-link + :store #'org-bbdb-store-link) ;; Implementation (defun org-bbdb-store-link () @@ -208,7 +210,7 @@ date year)." (name (bbdb-record-name rec)) (company (if (fboundp 'bbdb-record-getprop) (bbdb-record-getprop rec 'company) - (car (bbdb-record-get-field rec 'organization)))) + (car (bbdb-record-field rec 'organization)))) (link (concat "bbdb:" name))) (org-store-link-props :type "bbdb" :name name :company company :link link :description name) @@ -230,10 +232,9 @@ italicized, in all other cases it is left unchanged." (defun org-bbdb-open (name) "Follow a BBDB link to NAME." (require 'bbdb-com) - (let ((inhibit-redisplay (not debug-on-error)) - (bbdb-electric-p nil)) + (let ((inhibit-redisplay (not debug-on-error))) (if (fboundp 'bbdb-name) - (org-bbdb-open-old name) + (org-bbdb-open-old name) (org-bbdb-open-new name)))) (defun org-bbdb-open-old (name) @@ -280,14 +281,11 @@ italicized, in all other cases it is left unchanged." "Convert YYYY-MM-DD to (month date year). Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted it will be considered unknown." - (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) - (if (eq c nil) - (list (string-to-number a) - (string-to-number b) - nil) - (list (string-to-number b) - (string-to-number c) - (string-to-number a))))) + (pcase (org-split-string time-str "-") + (`(,a ,b nil) (list (string-to-number a) (string-to-number b) nil)) + (`(,a ,b ,c) (list (string-to-number b) + (string-to-number c) + (string-to-number a))))) (defun org-bbdb-anniv-split (str) "Split multiple entries in the BBDB anniversary field. @@ -325,9 +323,9 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." (bbdb-split "\n" annivs))) (while annivs (setq split (org-bbdb-anniv-split (pop annivs))) - (multiple-value-bind (m d y) - (values-list (funcall org-bbdb-extract-date-fun (car split))) - (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) + (pcase-let ((`(,m ,d ,y) (funcall org-bbdb-extract-date-fun + (car split)))) + (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) (puthash (list m d) (cons (list y (bbdb-record-name rec) (cadr split)) @@ -335,7 +333,7 @@ The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." org-bbdb-anniv-hash)))))) (setq org-bbdb-updated-p nil)) -(defun org-bbdb-updated (rec) +(defun org-bbdb-updated (_rec) "Record the fact that BBDB has been updated. This is used by Org to re-create the anniversary hash table." (setq org-bbdb-updated-p t)) @@ -397,6 +395,66 @@ This is used by Org to re-create the anniversary hash table." )) text)) +;;; Return list of anniversaries for today and the next n-1 (default: n=7) days. +;;; This is meant to be used in an org file instead of org-bbdb-anniversaries: +;;; +;;; %%(org-bbdb-anniversaries-future) +;;; +;;; or +;;; +;;; %%(org-bbdb-anniversaries-future 3) +;;; +;;; to override the 7-day default. + +(defun org-bbdb-date-list (d n) + "Return a list of dates in (m d y) format from the given date D to n-1 days hence." + (let ((abs (calendar-absolute-from-gregorian d))) + (mapcar (lambda (i) (calendar-gregorian-from-absolute (+ abs i))) + (number-sequence 0 (1- n))))) + +;;;###autoload +(defun org-bbdb-anniversaries-future (&optional n) + "Return list of anniversaries for today and the next n-1 days (default n=7)." + (let ((n (or n 7))) + (when (<= n 0) + (error "The (optional) argument of `org-bbdb-anniversaries-future' \ +must be positive")) + (let ( + ;; List of relevant dates. + (dates (org-bbdb-date-list date n)) + ;; Function to annotate text of each element of l with the + ;; anniversary date d. + (annotate-descriptions + (lambda (d l) + (mapcar (lambda (x) + ;; The assumption here is that x is a bbdb link + ;; of the form [[bbdb:name][description]]. + ;; This function rather arbitrarily modifies + ;; the description by adding the date to it in + ;; a fixed format. + (string-match "]]" x) + (replace-match (format " -- %d-%02d-%02d\\&" + (nth 2 d) + (nth 0 d) + (nth 1 d)) + nil nil x)) + l)))) + ;; Map a function that generates anniversaries for each date + ;; over the dates and nconc the results into a single list. When + ;; it is no longer necessary to support older versions of Emacs, + ;; this can be done with a cl-mapcan; for now, we use the (apply + ;; #'nconc ...) method for compatibility. + (apply #'nconc + (mapcar + (lambda (d) + (let ((date d)) + ;; Rebind 'date' so that org-bbdb-anniversaries will + ;; be fooled into giving us the list for the given + ;; date and then annotate the descriptions for that + ;; date. + (funcall annotate-descriptions d (org-bbdb-anniversaries)))) + dates))))) + (defun org-bbdb-complete-link () "Read a bbdb link with name completion." (require 'bbdb-com) diff --git a/lisp/org/org-bibtex.el b/lisp/org/org-bibtex.el index f8b376daa1..d81c9f1898 100644 --- a/lisp/org/org-bibtex.el +++ b/lisp/org/org-bibtex.el @@ -1,4 +1,4 @@ -;;; org-bibtex.el --- Org links to BibTeX entries +;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; @@ -73,7 +73,7 @@ ;; ===================================================================== ;; ;; Additionally, the following functions are now available for storing -;; bibtex entries within Org-mode documents. +;; bibtex entries within Org documents. ;; ;; - Run `org-bibtex' to export the current file to a .bib. ;; @@ -92,27 +92,28 @@ ;; ;;; History: ;; -;; The link creation part has been part of Org-mode for a long time. +;; The link creation part has been part of Org for a long time. ;; ;; Creating better capture template information was inspired by a request ;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 ;; and then implemented by Bastien Guerry. ;; ;; Eric Schulte eventually added the functions for translating between -;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex -;; fields of existing Org-mode headlines. +;; Org headlines and Bibtex entries, and for fleshing out the Bibtex +;; fields of existing Org headlines. ;; -;; Org-mode loads this module by default - if this is not what you want, +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: (require 'org) (require 'bibtex) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org-compat) +(defvar org-agenda-overriding-header) +(defvar org-agenda-search-view-always-boolean) (defvar org-bibtex-description nil) ; dynamically scoped from org.el (defvar org-id-locations) @@ -120,7 +121,6 @@ (declare-function bibtex-generate-autokey "bibtex" ()) (declare-function bibtex-parse-entry "bibtex" (&optional content)) (declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function org-babel-trim "ob-core" (string &optional regexp)) ;;; Bibtex data @@ -264,26 +264,39 @@ IDs must be unique." (defcustom org-bibtex-tags-are-keywords nil "Convert the value of the keywords field to tags and vice versa. -If set to t, comma-separated entries in a bibtex entry's keywords -field will be converted to org tags. Note: spaces will be escaped -with underscores, and characters that are not permitted in org + +When non-nil, comma-separated entries in a bibtex entry's keywords +field will be converted to Org tags. Note: spaces will be escaped +with underscores, and characters that are not permitted in Org tags will be removed. -If t, local tags in an org entry will be exported as a -comma-separated string of keywords when exported to bibtex. Tags -defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will -not be exported." +When non-nil, local tags in an Org entry will be exported as +a comma-separated string of keywords when exported to bibtex. +If `org-bibtex-inherit-tags' is non-nil, inherited tags will also +be exported as keywords. Tags defined in `org-bibtex-tags' or +`org-bibtex-no-export-tags' will not be exported." :group 'org-bibtex :version "24.1" :type 'boolean) (defcustom org-bibtex-no-export-tags nil "List of tag(s) that should not be converted to keywords. -This variable is relevant only if `org-bibtex-tags-are-keywords' is t." +This variable is relevant only if `org-bibtex-tags-are-keywords' +is non-nil." :group 'org-bibtex :version "24.1" :type '(repeat :tag "Tag" (string))) +(defcustom org-bibtex-inherit-tags nil + "Controls whether inherited tags are converted to bibtex keywords. +It is relevant only if `org-bibtex-tags-are-keywords' is non-nil. +Tag inheritence itself is controlled by `org-use-tag-inheritence' +and `org-exclude-tags-from-inheritence'." + :group 'org-bibtex + :version "26.1" + :package-version '(Org . "8.3") + :type 'boolean) + (defcustom org-bibtex-type-property-name "btype" "Property in which to store bibtex entry type (e.g., article)." :group 'org-bibtex @@ -299,7 +312,7 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t." (org-entry-get (point) (upcase property)) (org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))) - (when it (org-babel-trim it)))) + (when it (org-trim it)))) (defun org-bibtex-put (property value) (let ((prop (upcase (if (keywordp property) @@ -312,27 +325,27 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t." (defun org-bibtex-headline () "Return a bibtex entry of the given headline as a string." - (let* ((val (lambda (key lst) (cdr (assoc key lst)))) - (to (lambda (string) (intern (concat ":" string)))) - (from (lambda (key) (substring (symbol-name key) 1))) - flatten ; silent compiler warning - (flatten (lambda (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply flatten e) (list e))) - lsts)))) - (notes (buffer-string)) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name)) - (tags (when org-bibtex-tags-are-keywords - (delq nil - (mapcar - (lambda (tag) - (unless (member tag - (append org-bibtex-tags - org-bibtex-no-export-tags)) - tag)) - (org-get-local-tags-at)))))) + (letrec ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name)) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (if org-bibtex-inherit-tags + (org-get-tags-at) + (org-get-local-tags-at))))))) (when type (let ((entry (format "@%s{%s,\n%s\n}\n" type id @@ -358,7 +371,7 @@ This variable is relevant only if `org-bibtex-tags-are-keywords' is t." (mapcar (lambda (field) (let ((value (or (org-bibtex-get (funcall from field)) - (and (equal :title field) + (and (eq :title field) (nth 4 (org-heading-components)))))) (when value (cons (funcall from field) value)))) (funcall flatten @@ -421,13 +434,14 @@ With optional argument OPTIONAL, also prompt for optional fields." (funcall val :required (funcall val type org-bibtex-types))) (when optional (funcall val :optional (funcall val type org-bibtex-types))))) (when (consp field) ; or'd pair of fields e.g., (:editor :author) - (let ((present (first (remove + (let ((present (nth 0 (remove nil (mapcar - (lambda (f) (when (org-bibtex-get (funcall name f)) f)) + (lambda (f) + (when (org-bibtex-get (funcall name f)) f)) field))))) (setf field (or present (funcall keyword - (org-icompleting-read + (completing-read "Field: " (mapcar name field))))))) (let ((name (funcall name field))) (unless (org-bibtex-get name) @@ -439,8 +453,9 @@ With optional argument OPTIONAL, also prompt for optional fields." ;;; Bibtex link functions -(org-add-link-type "bibtex" 'org-bibtex-open) -(add-hook 'org-store-link-functions 'org-bibtex-store-link) +(org-link-set-parameters "bibtex" + :follow #'org-bibtex-open + :store #'org-bibtex-store-link) (defun org-bibtex-open (path) "Visit the bibliography entry on PATH." @@ -533,21 +548,23 @@ With optional argument OPTIONAL, also prompt for optional fields." (add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) -;;; Bibtex <-> Org-mode headline translation functions -(defun org-bibtex (&optional filename) +;;; Bibtex <-> Org headline translation functions +(defun org-bibtex (filename) "Export each headline in the current file to a bibtex entry. Headlines are exported using `org-bibtex-headline'." (interactive (list (read-file-name "Bibtex file: " nil nil nil - (file-name-nondirectory - (concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (and file + (file-name-nondirectory + (concat (file-name-sans-extension file) ".bib"))))))) (let ((error-point (catch 'bib (let ((bibtex-entries (remove nil (org-map-entries (lambda () - (condition-case foo + (condition-case nil (org-bibtex-headline) (error (throw 'bib (point))))))))) (with-temp-file filename @@ -578,7 +595,7 @@ With prefix argument OPTIONAL also prompt for optional fields." With a prefix arg, query for optional fields as well. If nonew is t, add data to the headline of the entry at point." (interactive "P") - (let* ((type (org-icompleting-read + (let* ((type (completing-read "Type: " (mapcar (lambda (type) (substring (symbol-name (car type)) 1)) org-bibtex-types) @@ -597,7 +614,7 @@ If nonew is t, add data to the headline of the entry at point." (org-bibtex-put org-bibtex-type-property-name (substring (symbol-name type) 1)) (org-bibtex-fleshout type arg) - (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags))) + (dolist (tag org-bibtex-tags) (org-toggle-tag tag 'on)))) (defun org-bibtex-create-in-current-entry (&optional arg) "Add bibliographical data to the current entry. @@ -611,10 +628,10 @@ This uses `bibtex-parse-entry'." (interactive) (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) (clean-space (lambda (str) (replace-regexp-in-string - "[[:space:]\n\r]+" " " str))) + "[[:space:]\n\r]+" " " str))) (strip-delim - (lambda (str) ; strip enclosing "..." and {...} - (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (lambda (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125))) (when (and (> (length str) 1) (= (aref str 0) (car pair)) (= (aref str (1- (length str))) (cdr pair))) @@ -622,10 +639,10 @@ This uses `bibtex-parse-entry'." (push (mapcar (lambda (pair) (cons (let ((field (funcall keyword (car pair)))) - (case field + (pcase field (:=type= :type) (:=key= :key) - (otherwise field))) + (_ field))) (funcall clean-space (funcall strip-delim (cdr pair))))) (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) org-bibtex-entries))) @@ -633,7 +650,7 @@ This uses `bibtex-parse-entry'." (defun org-bibtex-read-buffer (buffer) "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'. Return the number of saved entries." - (interactive "bbuffer: ") + (interactive "bBuffer: ") (let ((start-length (length org-bibtex-entries))) (with-current-buffer buffer (save-excursion @@ -643,12 +660,12 @@ Return the number of saved entries." (org-bibtex-read) (bibtex-beginning-of-entry)))) (let ((added (- (length org-bibtex-entries) start-length))) - (message "parsed %d entries" added) + (message "Parsed %d entries" added) added))) (defun org-bibtex-read-file (file) "Read FILE with `org-bibtex-read-buffer'." - (interactive "ffile: ") + (interactive "fFile: ") (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile))) (defun org-bibtex-write () @@ -666,25 +683,23 @@ Return the number of saved entries." (org-bibtex-put org-bibtex-type-property-name (downcase (funcall val :type))) (dolist (pair entry) - (case (car pair) + (pcase (car pair) (:title nil) (:type nil) (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) (:keywords (if org-bibtex-tags-are-keywords - (mapc - (lambda (kw) - (funcall - togtag - (replace-regexp-in-string - "[^[:alnum:]_@#%]" "" - (replace-regexp-in-string "[ \t]+" "_" kw)))) - (split-string (cdr pair) ", *")) + (dolist (kw (split-string (cdr pair) ", *")) + (funcall + togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) (org-bibtex-put (car pair) (cdr pair)))) - (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (_ (org-bibtex-put (car pair) (cdr pair))))) (mapc togtag org-bibtex-tags))) (defun org-bibtex-yank () - "If kill ring holds a bibtex entry yank it as an Org-mode headline." + "If kill ring holds a bibtex entry yank it as an Org headline." (interactive) (let (entry) (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) @@ -693,8 +708,8 @@ Return the number of saved entries." (error "Yanked text does not appear to contain a BibTeX entry")))) (defun org-bibtex-import-from-file (file) - "Read bibtex entries from FILE and insert as Org-mode headlines after point." - (interactive "ffile: ") + "Read bibtex entries from FILE and insert as Org headlines after point." + (interactive "fFile: ") (dotimes (_ (org-bibtex-read-file file)) (save-excursion (org-bibtex-write)) (re-search-forward org-property-end-re) diff --git a/lisp/org/org-capture.el b/lisp/org/org-capture.el index b302113f3e..63e23cc118 100644 --- a/lisp/org/org-capture.el +++ b/lisp/org/org-capture.el @@ -1,4 +1,4 @@ -;;; org-capture.el --- Fast note taking in Org-mode +;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -47,23 +47,22 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) +(declare-function org-at-encrypted-entry-p "org-crypt" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) -(declare-function org-table-get-specials "org-table" ()) -(declare-function org-table-goto-line "org-table" (N)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-at-encrypted-entry-p "org-crypt" ()) -(declare-function org-encrypt-entry "org-crypt" ()) (declare-function org-decrypt-entry "org-crypt" ()) +(declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-table-analyze "org-table" ()) +(declare-function org-table-goto-line "org-table" (N)) +(defvar org-end-time-was-given) (defvar org-remember-default-headline) (defvar org-remember-templates) (defvar org-table-hlines) +(defvar org-table-current-begin-pos) (defvar dired-buffers) (defvar org-capture-clock-was-started nil @@ -76,6 +75,9 @@ ;; to indicate that the link properties have already been stored (defvar org-capture-link-is-already-stored nil) +(defvar org-capture-is-refiling nil + "Non-nil when capture process is refiling an entry.") + (defgroup org-capture nil "Options concerning capturing new entries." :tag "Org Capture" @@ -103,9 +105,9 @@ description A short string describing the template, will be shown during selection. type The type of entry. Valid types are: - entry an Org-mode node, with a headline. Will be - filed as the child of the target entry or as - a top-level entry. + entry an Org node, with a headline. Will be filed + as the child of the target entry or as a + top-level entry. item a plain list item, will be placed in the first plain list at the target location. @@ -116,21 +118,22 @@ type The type of entry. Valid types are: plain text to be inserted as it is. target Specification of where the captured item should be placed. - In Org-mode files, targets usually define a node. Entries will + In Org files, targets usually define a node. Entries will become children of this node, other types will be added to the table or list in the body of this node. Most target specifications contain a file name. If that file name is the empty string, it defaults to `org-default-notes-file'. A file can also be given as a variable, function, or Emacs Lisp - form. + form. When an absolute path is not specified for a + target, it is taken as relative to `org-directory'. Valid values are: (file \"path/to/file\") Text will be placed at the beginning or end of that file - (id \"id of existing org entry\") + (id \"id of existing Org entry\") File as child of this entry, or in the body of the entry (file+headline \"path/to/file\" \"node headline\") @@ -148,6 +151,12 @@ target Specification of where the captured item should be placed. (file+datetree+prompt \"path/to/file\") Will create a heading in a date tree, prompts for date + (file+weektree \"path/to/file\") + Will create a heading in a week tree for today's date + + (file+weektree+prompt \"path/to/file\") + Will create a heading in a week tree, prompts for date + (file+function \"path/to/file\" function-finding-location) A function to find the right location in the file @@ -155,8 +164,8 @@ target Specification of where the captured item should be placed. File to the entry that is currently being clocked (function function-finding-location) - Most general way, write your own function to find both - file and location + Most general way: write your own function which both visits + the file and moves point to the right location template The template for creating the capture item. If you leave this empty, an appropriate default template will be used. See below @@ -218,15 +227,20 @@ properties are: is finalized. The template defines the text to be inserted. Often this is an -org-mode entry (so the first line should start with a star) that +Org mode entry (so the first line should start with a star) that will be filed as a child of the target headline. It can also be freely formatted text. Furthermore, the following %-escapes will -be replaced with content and expanded in this order: +be replaced with content and expanded: - %[pathname] Insert the contents of the file given by `pathname'. + %[pathname] Insert the contents of the file given by + `pathname'. These placeholders are expanded at the very + beginning of the process so they can be used to extend the + current template. %(sexp) Evaluate elisp `(sexp)' and replace it with the results. - For convenience, %:keyword (see below) placeholders within - the expression will be expanded prior to this. + Only placeholders pre-existing within the template, or + introduced with %[pathname] are expanded this way. Since this + happens after expanding non-interactive %-escapes, those can + be used to fill the expression. %<...> The result of format-time-string on the ... format specification. %t Time stamp, date only. %T Time stamp with date and time. @@ -255,8 +269,8 @@ be replaced with content and expanded in this order: A default value and a completion table ca be specified like this: %^{prompt|default|completion2|completion3|...}. %? After completing the template, position cursor here. - %\\n Insert the text entered at the nth %^{prompt}, where `n' is - a number, starting from 1. + %\\1 ... %\\N Insert the text entered at the nth %^{prompt}, where N + is a number, starting from 1. Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `org-capture' in emails @@ -274,13 +288,21 @@ gnus | %:from %:fromname %:fromaddress | %:date %:date-timestamp (as active timestamp) | %:date-timestamp-inactive (as inactive timestamp) gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url +eww, w3, w3m | %:type %:url info | %:type %:file %:node -calendar | %:type %:date" +calendar | %:type %:date + +When you need to insert a literal percent sign in the template, +you can escape ambiguous cases with a backward slash, e.g., \\%i." :group 'org-capture :version "24.1" :type - '(repeat + (let ((file-variants '(choice :tag "Filename " + (file :tag "Literal") + (function :tag "Function") + (variable :tag "Variable") + (sexp :tag "Form")))) + `(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") (list :tag "Multikey description" (string :tag "Keys ") @@ -297,39 +319,45 @@ calendar | %:type %:date" (choice :tag "Target location" (list :tag "File" (const :format "" file) - (file :tag " File")) + ,file-variants) (list :tag "ID" (const :format "" id) (string :tag " ID")) (list :tag "File & Headline" (const :format "" file+headline) - (file :tag " File ") + ,file-variants (string :tag " Headline")) (list :tag "File & Outline path" (const :format "" file+olp) - (file :tag " File ") + ,file-variants (repeat :tag "Outline path" :inline t (string :tag "Headline"))) (list :tag "File & Regexp" (const :format "" file+regexp) - (file :tag " File ") + ,file-variants (regexp :tag " Regexp")) (list :tag "File & Date tree" (const :format "" file+datetree) - (file :tag " File")) + ,file-variants) (list :tag "File & Date tree, prompt for date" (const :format "" file+datetree+prompt) - (file :tag " File")) + ,file-variants) + (list :tag "File & Week tree" + (const :format "" file+weektree) + ,file-variants) + (list :tag "File & Week tree, prompt for date" + (const :format "" file+weektree+prompt) + ,file-variants) (list :tag "File & function" (const :format "" file+function) - (file :tag " File ") + ,file-variants (sexp :tag " Function")) (list :tag "Current clocking task" (const :format "" clock)) (list :tag "Function" (const :format "" function) (sexp :tag " Function"))) - (choice :tag "Template" + (choice :tag "Template " (string) (list :tag "File" (const :format "" file) @@ -350,7 +378,7 @@ calendar | %:type %:date" ((const :format "%v " :clock-resume) (const t)) ((const :format "%v " :unnarrowed) (const t)) ((const :format "%v " :table-line-pos) (const t)) - ((const :format "%v " :kill-buffer) (const t)))))))) + ((const :format "%v " :kill-buffer) (const t))))))))) (defcustom org-capture-before-finalize-hook nil "Hook that is run right before a capture process is finalized. @@ -421,7 +449,7 @@ to avoid conflicts with other active capture processes." (defvar org-capture-mode-map (make-sparse-keymap) "Keymap for `org-capture-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used +Use this map to set additional keybindings for when Org mode is used for a capture buffer.") (defvar org-capture-mode-hook nil @@ -432,10 +460,12 @@ for a capture buffer.") Turning on this mode runs the normal hook `org-capture-mode-hook'." nil " Rem" org-capture-mode-map - (org-set-local - 'header-line-format + (setq-local + header-line-format (substitute-command-keys - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'."))) + "\\Capture buffer. Finish \ +`\\[org-capture-finalize]', refile `\\[org-capture-refile]', \ +abort `\\[org-capture-kill]'."))) (define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) (define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) (define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) @@ -460,7 +490,7 @@ For example, if you have a capture template \"c\" and you want this template to be accessible only from `message-mode' buffers, use this: - ((\"c\" ((in-mode . \"message-mode\")))) + \\='((\"c\" ((in-mode . \"message-mode\")))) Here are the available contexts definitions: @@ -478,7 +508,7 @@ accessible if there is at least one valid check. You can also bind a key to another agenda custom command depending on contextual rules. - ((\"c\" \"d\" ((in-mode . \"message-mode\")))) + \\='((\"c\" \"d\" ((in-mode . \"message-mode\")))) Here it means: in `message-mode buffers', use \"c\" as the key for the capture template otherwise associated with \"d\". @@ -504,7 +534,8 @@ to avoid duplicates.)" (defcustom org-capture-use-agenda-date nil "Non-nil means use the date at point when capturing from agendas. -When nil, you can still capture using the date at point with \\[org-agenda-capture]." +When nil, you can still capture using the date at point with +`\\[org-agenda-capture]'." :group 'org-capture :version "24.3" :type 'boolean) @@ -513,17 +544,20 @@ When nil, you can still capture using the date at point with \\[org-agenda-captu (defun org-capture (&optional goto keys) "Capture something. \\ -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. - -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last note -stored. +This will let you select a template from `org-capture-templates', and +then file the newly captured information. The text is immediately +inserted at the target location, and an indirect buffer is shown where +you can edit it. Pressing `\\[org-capture-finalize]' brings you back to the \ +previous +state of Emacs, so that you can continue your work. + +When called interactively with a `\\[universal-argument]' prefix argument \ +GOTO, don't +capture anything, just go to the file/headline where the selected +template stores its notes. + +With a `\\[universal-argument] \\[universal-argument]' prefix argument, go to \ +the last note stored. When called with a `C-0' (zero) prefix, insert a template at point. @@ -564,7 +598,7 @@ of the day at point (if any) or the current HH:MM time." ((equal entry "C") (customize-variable 'org-capture-templates)) ((equal entry "q") - (error "Abort")) + (user-error "Abort")) (t (org-capture-set-plist entry) (org-capture-get-template) @@ -596,10 +630,10 @@ of the day at point (if any) or the current HH:MM time." (org-capture-insert-template-here) (condition-case error (org-capture-place-template - (equal (car (org-capture-get :target)) 'function)) + (eq (car (org-capture-get :target)) 'function)) ((error quit) (if (and (buffer-base-buffer (current-buffer)) - (string-match "\\`CAPTURE-" (buffer-name))) + (string-prefix-p "CAPTURE-" (buffer-name))) (kill-buffer (current-buffer))) (set-window-configuration (org-capture-get :return-to-wconf)) (error "Capture template `%s': %s" @@ -613,7 +647,7 @@ of the day at point (if any) or the current HH:MM time." (org-capture-put :interrupted-clock (copy-marker org-clock-marker))) (org-clock-in) - (org-set-local 'org-capture-clock-was-started t)) + (setq-local org-capture-clock-was-started t)) (error "Could not start the clock in this capture buffer"))) (if (org-capture-get :immediate-finish) @@ -646,7 +680,7 @@ captured item after finalizing." (setq stay-with-capture t)) (unless (and org-capture-mode (buffer-base-buffer (current-buffer))) - (error "This does not seem to be a capture buffer for Org-mode")) + (error "This does not seem to be a capture buffer for Org mode")) (run-hooks 'org-capture-prepare-finalize-hook) @@ -682,23 +716,13 @@ captured item after finalizing." (m2 (org-capture-get :end-marker 'local))) (if (and m1 m2 (= m1 beg) (= m2 end)) (progn - (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry)) + (setq m2 (if (cdr (assq 'heading org-blank-before-new-entry)) m2 (1+ m2)) m2 (if (< (point-max) m2) (point-max) m2)) (setq abort-note 'clean) (kill-region m1 m2)) (setq abort-note 'dirty))) - ;; Make sure that the empty lines after are correct - (when (and (> (point-max) end) ; indeed, the buffer was still narrowed - (member (org-capture-get :type 'local) - '(entry item checkitem plain))) - (save-excursion - (goto-char end) - (or (bolp) (newline)) - (org-capture-empty-lines-after - (or (org-capture-get :empty-lines-after 'local) - (org-capture-get :empty-lines 'local) 0)))) ;; Postprocessing: Update Statistics cookies, do the sorting (when (derived-mode-p 'org-mode) (save-excursion @@ -715,8 +739,7 @@ captured item after finalizing." ;; Store this place as the last one where we stored something ;; Do the marking in the base buffer, so that it makes sense after ;; the indirect buffer has been killed. - (when org-capture-bookmark - (org-capture-bookmark-last-stored-position)) + (org-capture-store-last-position) ;; Run the hook (run-hooks 'org-capture-before-finalize-hook)) @@ -770,11 +793,12 @@ captured item after finalizing." ;; Special cases (cond (abort-note - (cond - ((equal abort-note 'clean) - (message "Capture process aborted and target buffer cleaned up")) - ((equal abort-note 'dirty) - (error "Capture process aborted, but target buffer could not be cleaned up correctly")))) + (cl-case abort-note + (clean + (message "Capture process aborted and target buffer cleaned up")) + (dirty + (error "Capture process aborted, but target buffer could not be \ +cleaned up correctly")))) (stay-with-capture (org-capture-goto-last-stored))) ;; Return if we did store something @@ -786,19 +810,28 @@ Refiling is done from the base buffer, because the indirect buffer is then already gone. Any prefix argument will be passed to the refile command." (interactive) (unless (eq (org-capture-get :type 'local) 'entry) - (error - "Refiling from a capture buffer makes only sense for `entry'-type templates")) - (let ((pos (point)) - (base (buffer-base-buffer (current-buffer))) - (org-refile-for-capture t)) - (save-window-excursion - (with-current-buffer (or base (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (call-interactively 'org-refile))))) - (org-capture-finalize))) + (user-error "Refiling from a capture buffer makes only sense \ +for `entry'-type templates")) + (let* ((base (or (buffer-base-buffer) (current-buffer))) + (pos (make-marker)) + (org-capture-is-refiling t) + (kill-buffer (org-capture-get :kill-buffer 'local))) + ;; Since `org-capture-finalize' may alter buffer contents (e.g., + ;; empty lines) around entry, use a marker to refer to the + ;; headline to be refiled. Place the marker in the base buffer, + ;; as the current indirect one is going to be killed. + (set-marker pos (save-excursion (org-back-to-heading t) (point)) base) + (org-capture-put :kill-buffer nil) + (unwind-protect + (progn + (org-capture-finalize) + (save-window-excursion + (with-current-buffer base + (org-with-wide-buffer + (goto-char pos) + (call-interactively 'org-refile)))) + (when kill-buffer (kill-buffer base))) + (set-marker pos nil)))) (defun org-capture-kill () "Abort the current capture process." @@ -813,7 +846,8 @@ already gone. Any prefix argument will be passed to the refile command." "Go to the location where the last capture note was stored." (interactive) (org-goto-marker-or-bmk org-capture-last-stored-marker - "org-capture-last-stored") + (plist-get org-bookmark-names-plist + :last-capture)) (message "This is the last note stored by a capture process")) ;;; Supporting functions for handling the process @@ -823,7 +857,7 @@ already gone. Any prefix argument will be passed to the refile command." (org-capture-put :initial-target-region ;; Check if the buffer is currently narrowed - (when (/= (buffer-size) (- (point-max) (point-min))) + (when (org-buffer-narrowed-p) (cons (point-min) (point-max)))) ;; store the current point (org-capture-put :initial-target-position (point))) @@ -853,14 +887,14 @@ Store them in the capture property list." ((eq (car target) 'file+headline) (set-buffer (org-capture-target-buffer (nth 1 target))) + (unless (derived-mode-p 'org-mode) + (error + "Target buffer \"%s\" for file+headline should be in Org mode" + (current-buffer))) (org-capture-put-target-region-and-position) (widen) (let ((hd (nth 2 target))) (goto-char (point-min)) - (unless (derived-mode-p 'org-mode) - (error - "Target buffer \"%s\" for file+headline should be in Org mode" - (current-buffer))) (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote hd)) nil t) @@ -892,21 +926,29 @@ Store them in the capture property list." (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) (error "No match for target regexp in file %s" (nth 1 target)))) - ((memq (car target) '(file+datetree file+datetree+prompt)) + ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt)) (require 'org-datetree) (set-buffer (org-capture-target-buffer (nth 1 target))) + (unless (derived-mode-p 'org-mode) + (error "Target buffer \"%s\" for %s should be in Org mode" + (current-buffer) + (car target))) (org-capture-put-target-region-and-position) (widen) - ;; Make a date tree entry, with the current date (or yesterday, - ;; if we are extending dates for a couple of hours) - (org-datetree-find-date-create + ;; Make a date/week tree entry, with the current date (or + ;; yesterday, if we are extending dates for a couple of hours) + (funcall + (cond + ((memq (car target) '(file+weektree file+weektree+prompt)) + #'org-datetree-find-iso-week-create) + (t #'org-datetree-find-date-create)) (calendar-gregorian-from-absolute (cond (org-overriding-default-time ;; use the overriding default time (time-to-days org-overriding-default-time)) - ((eq (car target) 'file+datetree+prompt) + ((memq (car target) '(file+datetree+prompt file+weektree+prompt)) ;; prompt for date (let ((prompt-time (org-read-date nil t nil "Date for tree entry:" @@ -917,7 +959,9 @@ Store them in the capture property list." (not org-time-was-given)) (not (= (time-to-days prompt-time) (org-today)))) ;; Use 00:00 when no time is given for another date than today? - (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) + (apply #'encode-time + (append '(0 0 0) + (cl-cdddr (decode-time prompt-time))))) ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) ;; Replace any time range by its start (apply 'encode-time @@ -964,31 +1008,31 @@ Store them in the capture property list." :decrypted decrypted-hl-pos)))) (defun org-capture-expand-file (file) - "Expand functions and symbols for FILE. + "Expand functions, symbols and file names for FILE. When FILE is a function, call it. When it is a form, evaluate -it. When it is a variable, retrieve the value. Return whatever we get." +it. When it is a variable, retrieve the value. When it is +a string, treat it as a file name, possibly expanding it +according to `org-directory', and return it. If it is the empty +string, however, return `org-default-notes-file'. In any other +case, raise an error." (cond - ((org-string-nw-p file) file) + ((equal file "") org-default-notes-file) + ((stringp file) (expand-file-name file org-directory)) ((functionp file) (funcall file)) ((and (symbolp file) (boundp file)) (symbol-value file)) - ((and file (consp file)) (eval file)) + ((consp file) (eval file)) (t file))) (defun org-capture-target-buffer (file) - "Get a buffer for FILE." - (setq file (org-capture-expand-file file)) - (setq file (or (org-string-nw-p file) - org-default-notes-file - (error "No notes file specified, and no default available"))) - (or (org-find-base-buffer-visiting file) - (progn (org-capture-put :new-buffer t) - (find-file-noselect (expand-file-name file org-directory))))) - -(defun org-capture-steal-local-variables (buffer) - "Install Org-mode local variables of BUFFER." - (mapc (lambda (v) - (ignore-errors (org-set-local (car v) (cdr v)))) - (buffer-local-variables buffer))) + "Get a buffer for FILE. +FILE is a generalized file location, as handled by +`org-capture-expand-file'." + (let ((file (or (org-string-nw-p (org-capture-expand-file file)) + org-default-notes-file + (error "No notes file specified, and no default available")))) + (or (org-find-base-buffer-visiting file) + (progn (org-capture-put :new-buffer t) + (find-file-noselect file))))) (defun org-capture-place-template (&optional inhibit-wconf-store) "Insert the template at the target location, and display the buffer. @@ -1000,65 +1044,52 @@ may have been stored before." (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) (widen) - (show-all) + (outline-show-all) (goto-char (org-capture-get :pos)) - (org-set-local 'org-capture-target-marker - (point-marker)) - (org-set-local 'outline-level 'org-outline-level) - (let* ((template (org-capture-get :template)) - (type (org-capture-get :type))) - (case type - ((nil entry) (org-capture-place-entry)) - (table-line (org-capture-place-table-line)) - (plain (org-capture-place-plain-text)) - (item (org-capture-place-item)) - (checkitem (org-capture-place-item)))) + (setq-local outline-level 'org-outline-level) + (pcase (org-capture-get :type) + ((or `nil `entry) (org-capture-place-entry)) + (`table-line (org-capture-place-table-line)) + (`plain (org-capture-place-plain-text)) + (`item (org-capture-place-item)) + (`checkitem (org-capture-place-item))) (org-capture-mode 1) - (org-set-local 'org-capture-current-plist org-capture-plist)) + (setq-local org-capture-current-plist org-capture-plist)) (defun org-capture-place-entry () "Place the template as a new Org entry." - (let* ((txt (org-capture-get :template)) - (reversed (org-capture-get :prepend)) - (target-entry-p (org-capture-get :target-entry-p)) - level beg end file) - - (cond - ((org-capture-get :exact-position) + (let ((reversed? (org-capture-get :prepend)) + level) + (when (org-capture-get :exact-position) (goto-char (org-capture-get :exact-position))) - ((not target-entry-p) - ;; Insert as top-level entry, either at beginning or at end of file - (setq level 1) - (if reversed - (progn (goto-char (point-min)) - (or (org-at-heading-p) - (outline-next-heading))) - (goto-char (point-max)) - (or (bolp) (insert "\n")))) - (t - ;; Insert as a child of the current entry - (and (looking-at "\\*+") - (setq level (- (match-end 0) (match-beginning 0)))) - (setq level (org-get-valid-level (or level 1) 1)) - (if reversed - (progn - (outline-next-heading) - (or (bolp) (insert "\n"))) - (org-end-of-subtree t nil) - (or (bolp) (insert "\n"))))) + (cond + ;; Insert as a child of the current entry. + ((org-capture-get :target-entry-p) + (setq level (org-get-valid-level + (if (org-at-heading-p) (org-outline-level) 1) + 1)) + (if reversed? (outline-next-heading) (org-end-of-subtree t))) + ;; Insert as a top-level entry at the beginning of the file. + (reversed? + (goto-char (point-min)) + (unless (org-at-heading-p) (outline-next-heading))) + ;; Otherwise, insert as a top-level entry at the end of the file. + (t (goto-char (point-max)))) + (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) - (setq beg (point)) - (org-capture-verify-tree txt) - (org-paste-subtree level txt 'for-yank) - (org-capture-empty-lines-after 1) - (org-capture-position-for-last-stored beg) - (outline-next-heading) - (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")))) + (let ((beg (point)) + (template (org-capture-get :template))) + (org-capture-verify-tree template) + (org-paste-subtree level template 'for-yank) + (org-capture-empty-lines-after) + (org-capture-position-for-last-stored beg) + (unless (org-at-heading-p) (outline-next-heading)) + (let ((end (point))) + (org-capture-mark-kill-region beg end) + (org-capture-narrow beg end) + (when (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))))) (defun org-capture-place-item () "Place the template as a new plain list item." @@ -1075,21 +1106,18 @@ may have been stored before." (t (setq beg (1+ (point-at-eol)) end (save-excursion (outline-next-heading) (point))))) + (setq ind nil) (if (org-capture-get :prepend) (progn (goto-char beg) - (if (org-list-search-forward (org-item-beginning-re) end t) - (progn - (goto-char (match-beginning 0)) - (setq ind (org-get-indentation))) - (goto-char end) - (setq ind 0))) + (when (org-list-search-forward (org-item-beginning-re) end t) + (goto-char (match-beginning 0)) + (setq ind (org-get-indentation)))) (goto-char end) - (if (org-list-search-backward (org-item-beginning-re) beg t) - (progn - (setq ind (org-get-indentation)) - (org-end-of-item)) - (setq ind 0)))) + (when (org-list-search-backward (org-item-beginning-re) beg t) + (setq ind (org-get-indentation)) + (org-end-of-item))) + (unless ind (goto-char end))) ;; Remove common indentation (setq txt (org-remove-indentation txt)) ;; Make sure this is indeed an item @@ -1097,18 +1125,23 @@ may have been stored before." (setq txt (concat "- " (mapconcat 'identity (split-string txt "\n") "\n ")))) + ;; Prepare surrounding empty lines. + (org-capture-empty-lines-before) + (setq beg (point)) + (unless (eolp) (save-excursion (insert "\n"))) + (unless ind + (org-indent-line) + (setq ind (org-get-indentation)) + (delete-region beg (point))) ;; Set the correct indentation, depending on context (setq ind (make-string ind ?\ )) (setq txt (concat ind (mapconcat 'identity (split-string txt "\n") (concat "\n" ind)) "\n")) - ;; Insert, with surrounding empty lines - (org-capture-empty-lines-before) - (setq beg (point)) + ;; Insert item. (insert txt) - (or (bolp) (insert "\n")) - (org-capture-empty-lines-after 1) + (org-capture-empty-lines-after) (org-capture-position-for-last-stored beg) (forward-char 1) (setq end (point)) @@ -1124,7 +1157,7 @@ may have been stored before." (let* ((txt (org-capture-get :template)) (target-entry-p (org-capture-get :target-entry-p)) (table-line-pos (org-capture-get :table-line-pos)) - ind beg end) + beg end) (cond ((org-capture-get :exact-position) (goto-char (org-capture-get :exact-position))) @@ -1149,21 +1182,24 @@ may have been stored before." ;; Check if the template is good (if (not (string-match org-table-dataline-regexp txt)) (setq txt "| %?Bad template |\n")) + (if (functionp table-line-pos) + (setq table-line-pos (funcall table-line-pos)) + (setq table-line-pos (eval table-line-pos))) (cond ((and table-line-pos (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) - ;; we have a complex line specification (goto-char (point-min)) - (let ((nh (- (match-end 1) (match-beginning 1))) - (delta (string-to-number (match-string 2 table-line-pos))) - ll) + ;; we have a complex line specification + (let ((ll (ignore-errors + (save-match-data (org-table-analyze)) + (aref org-table-hlines + (- (match-end 1) (match-beginning 1))))) + (delta (string-to-number (match-string 2 table-line-pos)))) ;; The user wants a special position in the table - (org-table-get-specials) - (setq ll (ignore-errors (aref org-table-hlines nh))) - (unless ll (error "Invalid table line specification \"%s\"" - table-line-pos)) - (setq ll (+ ll delta (if (< delta 0) 0 -1))) - (org-goto-line ll) + (unless ll + (error "Invalid table line specification \"%s\"" table-line-pos)) + (goto-char org-table-current-begin-pos) + (forward-line (+ ll delta (if (< delta 0) 0 -1))) (org-table-insert-row 'below) (beginning-of-line 1) (delete-region (point) (1+ (point-at-eol))) @@ -1216,7 +1252,7 @@ Of course, if exact position has been required, just put it there." ;; we should place the text into this entry (if (org-capture-get :prepend) ;; Skip meta data and drawers - (org-end-of-meta-data-and-drawers) + (org-end-of-meta-data t) ;; go to ent of the entry text, before the next headline (outline-next-heading))) (t @@ -1226,7 +1262,7 @@ Of course, if exact position has been required, just put it there." (org-capture-empty-lines-before) (setq beg (point)) (insert txt) - (org-capture-empty-lines-after 1) + (org-capture-empty-lines-after) (org-capture-position-for-last-stored beg) (setq end (point)) (org-capture-mark-kill-region beg (1- end)) @@ -1256,8 +1292,8 @@ Of course, if exact position has been required, just put it there." (org-table-current-dline)))) (t (error "This should not happen")))) -(defun org-capture-bookmark-last-stored-position () - "Bookmark the last-captured position." +(defun org-capture-store-last-position () + "Store the last-captured position." (let* ((where (org-capture-get :position-for-last-stored 'local)) (pos (cond ((markerp where) @@ -1270,16 +1306,11 @@ Of course, if exact position has been required, just put it there." (point-at-bol)) (point)))))) (with-current-buffer (buffer-base-buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))))))) + (org-with-point-at pos + (when org-capture-bookmark + (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) + (when bookmark (with-demoted-errors (bookmark-set bookmark))))) + (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) "Narrow, unless configuration says not to narrow." @@ -1315,7 +1346,7 @@ Point will remain at the first line after the inserted text." (let* ((template (org-capture-get :template)) (type (org-capture-get :type)) beg end pp) - (or (bolp) (newline)) + (unless (bolp) (insert "\n")) (setq beg (point)) (cond ((and (eq type 'entry) (derived-mode-p 'org-mode)) @@ -1337,13 +1368,16 @@ Point will remain at the first line after the inserted text." (org-capture-empty-lines-after) (goto-char beg) (org-list-repair) - (org-end-of-item) - (setq end (point))) - (t (insert template))) + (org-end-of-item)) + (t + (insert template) + (org-capture-empty-lines-after) + (skip-chars-forward " \t\n") + (unless (eobp) (beginning-of-line)))) (setq end (point)) (goto-char beg) - (if (re-search-forward "%\\?" end t) - (replace-match "")))) + (when (re-search-forward "%\\?" end t) + (replace-match "")))) (defun org-capture-set-plist (entry) "Initialize the property list from the template definition." @@ -1365,13 +1399,11 @@ Point will remain at the first line after the inserted text." "Go to the target location of a capture template. The user is queried for the template." (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-capture-select-template template-key))) - (unless entry - (error "No capture template selected")) + (let ((entry (org-capture-select-template template-key))) + (unless entry (error "No capture template selected")) (org-capture-set-plist entry) (org-capture-set-target-location) - (org-pop-to-buffer-same-window (org-capture-get :buffer)) + (pop-to-buffer-same-window (org-capture-get :buffer)) (goto-char (org-capture-get :pos)))) (defun org-capture-get-indirect-buffer (&optional buffer prefix) @@ -1381,7 +1413,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." (let ((n 1) (base (buffer-name buffer)) bname) (setq bname (concat prefix "-" base)) (while (buffer-live-p (get-buffer bname)) - (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (setq bname (concat prefix "-" (number-to-string (cl-incf n)) "-" base))) (condition-case nil (make-indirect-buffer buffer bname 'clone) (error @@ -1396,6 +1428,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." (defun org-mks (table title &optional prompt specials) "Select a member of an alist with multiple keys. + TABLE is the alist which should contain entries where the car is a string. There should be two types of entries. @@ -1403,7 +1436,7 @@ There should be two types of entries. This indicates that `a' is a prefix key for multi-letter selection, and that there are entries following with keys like \"ab\", \"ax\"... -2. Selectable members must have more than two elements, with the first +2. Select-able members must have more than two elements, with the first being the string of keys that lead to selecting it, and the second a short description string of the item. @@ -1414,84 +1447,72 @@ When you press a prefix key, the commands (and maybe further prefixes) under this key will be shown and offered for selection. TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil - cursor-type nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (let (case-fold-search) - (while (and tbl (string-match re (caar tbl))) (pop tbl)))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) +PROMPT will be used when prompting for a key. SPECIAL is an +alist with (\"key\" \"description\") entries. When one of these +is selected, only the bare key is returned." + (save-window-excursion + (let ((inhibit-quit t) + (buffer (org-switch-to-buffer-other-window "*Org Select*")) + (prompt (or prompt "Select: ")) + current) + (unwind-protect + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (let ((des-keys nil) + (allowed-keys '("\C-g")) + (cursor-type nil)) + ;; Populate allowed keys and descriptions keys + ;; available with CURRENT selector. + (let ((re (format "\\`%s\\(.\\)\\'" + (if current (regexp-quote current) ""))) + (prefix (if current (concat current " ") ""))) + (dolist (entry table) + (pcase entry + ;; Description. + (`(,(and key (pred (string-match re))) ,desc) + (let ((k (match-string 1 key))) + (push k des-keys) + (push k allowed-keys) + (insert prefix "[" k "]" "..." " " desc "..." "\n"))) + ;; Usable entry. + (`(,(and key (pred (string-match re))) ,desc . ,_) + (let ((k (match-string 1 key))) + (insert prefix "[" k "]" " " desc "\n") + (push k allowed-keys))) + (_ nil)))) + ;; Insert special entries, if any. + (when specials + (insert "----------------------------------------------------\ +---------------------------\n") + (pcase-dolist (`(,key ,description) specials) + (insert (format "[%s] %s\n" key description)) + (push key allowed-keys))) + ;; Display UI and let user select an entry or + ;; a sub-level prefix. + (goto-char (point-min)) + (unless (pos-visible-in-window-p (point-max)) + (org-fit-window-to-buffer)) + (message prompt) + (let ((pressed (char-to-string (read-char-exclusive)))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (setq current (concat current pressed)) + (cond + ((equal pressed "\C-g") (user-error "Abort")) + ;; Selection is a prefix: open a new menu. + ((member pressed des-keys)) + ;; Selection matches an association: return it. + ((let ((entry (assoc current table))) + (and entry (throw 'exit entry)))) + ;; Selection matches a special entry: return the + ;; selection prefix. + ((assoc current specials) (throw 'exit current)) + (t (error "No entry available"))))))) + (when buffer (kill-buffer buffer)))))) ;;; The template code (defun org-capture-select-template (&optional keys) @@ -1511,46 +1532,41 @@ Lisp programs can force the template by setting KEYS to a string." '(("C" "Customize org-capture-templates") ("q" "Abort")))))) +(defvar org-capture--clipboards nil + "List various clipboards values.") + (defun org-capture-fill-template (&optional template initial annotation) "Fill a template and return the filled template as a string. The template may still contain \"%?\" for cursor positioning." - (setq template (or template (org-capture-get :template))) - (when (stringp initial) - (setq initial (org-no-properties initial))) - (let* ((buffer (org-capture-get :buffer)) + (let* ((template (or template (org-capture-get :template))) + (buffer (org-capture-get :buffer)) (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (ct (org-capture-get :default-time)) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (plist-p (if org-store-link-plist t nil)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (time (let* ((c (or (org-capture-get :default-time) (current-time))) + (d (decode-time c))) + (if (< (nth 2 d) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 d)) (nth 4 d) (nth 5 d)) + c))) + (v-t (format-time-string (org-time-stamp-format nil) time)) + (v-T (format-time-string (org-time-stamp-format t) time)) + (v-u (format-time-string (org-time-stamp-format nil t) time)) + (v-U (format-time-string (org-time-stamp-format t t) time)) + (v-c (and kill-ring (current-kill 0))) (v-x (or (org-get-x-clipboard 'PRIMARY) (org-get-x-clipboard 'CLIPBOARD) (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct1)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct1)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' might habe been passed. - ;; But if the property list has them, we prefer those values + ;; `initial' and `annotation' might have been passed. But if + ;; the property list has them, we prefer those values. (v-i (or (plist-get org-store-link-plist :initial) - initial + (and (stringp initial) (org-no-properties initial)) (org-capture-get :initial) "")) - (v-a (or (plist-get org-store-link-plist :annotation) - annotation - (org-capture-get :annotation) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) + (v-a + (let ((a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + ""))) + ;; Is the link empty? Then we do not want it... + (if (equal a "[[]]") "" a))) (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") (v-A (if (and v-a (string-match l-re v-a)) (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) @@ -1559,202 +1575,260 @@ The template may still contain \"%?\" for cursor positioning." (replace-match "\\1" nil nil v-a) v-a)) (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) + (v-k (and (marker-buffer org-clock-marker) + (org-no-properties org-clock-heading))) (v-K (if (marker-buffer org-clock-marker) (org-make-link-string (buffer-file-name (marker-buffer org-clock-marker)) org-clock-heading))) (v-f (or (org-capture-get :original-file-nondirectory) "")) (v-F (or (org-capture-get :original-file) "")) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar strings) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - (setq initial v-i) - - (unless template (setq template "") (message "No template") (ding) - (sit-for 1)) + (org-capture--clipboards + (delq nil + (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c)))) + + (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a)) + (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i)) + + (unless template + (setq template "") + (message "no template") (ding) + (sit-for 1)) (save-window-excursion - (delete-other-windows) - (org-pop-to-buffer-same-window (get-buffer-create "*Capture*")) + (org-switch-to-buffer-other-window (get-buffer-create "*Capture*")) (erase-buffer) + (setq buffer-file-name nil) + (setq mark-active nil) (insert template) (goto-char (point-min)) - (org-capture-steal-local-variables buffer) - (setq buffer-file-name nil mark-active nil) - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-capture-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Could not insert %s: %s]" - filename error))))))) - ;; %() embedded elisp - (org-capture-expand-embedded-elisp) + ;; %[] insert contents of a file. + (save-excursion + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (let ((filename (expand-file-name (match-string 1))) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0)))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (condition-case error + (insert-file-contents filename) + (error + (insert (format "%%![couldn not insert %s: %s]" + filename + error)))))))) - ;; The current time - (goto-char (point-min)) - (while (re-search-forward "%<\\([^>\n]+\\)>" nil t) - (replace-match (format-time-string (match-string 1)) t t)) + ;; Mark %() embedded elisp for later evaluation. + (org-capture-expand-embedded-elisp 'mark) - ;; Simple %-escapes - (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) - (unless (org-capture-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) - - ;; Turn on org-mode in temp buffer, set local variables - ;; This is to support completion in interactive prompts + ;; Expand non-interactive templates. + (let ((regexp "%\\(:[-a-za-z]+\\|<\\([^>\n]+\\)>\\|[aAcfFikKlntTuUx]\\)")) + (save-excursion + (while (re-search-forward regexp nil t) + ;; `org-capture-escaped-%' may modify buffer and cripple + ;; match-data. Use markers instead. Ditto for other + ;; templates. + (let ((pos (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (value (match-string 1)) + (time-string (match-string 2))) + (unless (org-capture-escaped-%) + (delete-region pos end) + (set-marker pos nil) + (set-marker end nil) + (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) + (replacement + (pcase (string-to-char value) + (?< (format-time-string time-string)) + (?: + (or (plist-get org-store-link-plist (intern value)) + "")) + (?i + (if inside-sexp? v-i + ;; Outside embedded Lisp, repeat leading + ;; characters before initial place holder + ;; every line. + (let ((lead (buffer-substring-no-properties + (line-beginning-position) (point)))) + (replace-regexp-in-string "\n\\(.\\)" + (concat lead "\\1") + v-i nil nil 1)))) + (?a v-a) + (?A v-A) + (?c v-c) + (?f v-f) + (?F v-F) + (?k v-k) + (?K v-K) + (?l v-l) + (?n v-n) + (?t v-t) + (?T v-T) + (?u v-u) + (?U v-U) + (?x v-x)))) + (insert + (if inside-sexp? + ;; Escape sensitive characters. + (replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement) + replacement)))))))) + + ;; Expand %() embedded Elisp. Limit to Sexp originally marked. + (org-capture-expand-embedded-elisp) + + ;; Expand interactive templates. This is the last step so that + ;; template is mostly expanded when prompting happens. Turn on + ;; Org mode and set local variables. This is to support + ;; completion in interactive prompts. (let ((org-inhibit-startup t)) (org-mode)) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-capture-escaped-%) - (setq char (if (match-end 3) (match-string-no-properties 3)) - prompt (if (match-end 2) (match-string-no-properties 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-capture-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (unless (boundp histvar) (set histvar nil)) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") - (org-agenda-files) - (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string - ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":")) - (and (org-at-heading-p) - (let ((org-ignore-region t)) - (org-set-tags nil 'align)))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (org-set-property (org-no-properties prompt) nil)) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) char) t nil - prompt)) - (if (equal (upcase char) char) (setq org-time-was-given t)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (push (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default) - strings) - (insert (car strings))))))) - ;; Replace %n escapes with nth %^{...} string - (setq strings (nreverse strings)) - (goto-char (point-min)) - (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) - (unless (org-capture-escaped-%) - (replace-match - (nth (1- (string-to-number (match-string 1))) strings) - nil t))) + (org-clone-local-variables buffer "\\`org-") + (let (strings) ; Stores interactive answers. + (save-excursion + (let ((regexp "%\\^\\(?:{\\([^}]*\\)}\\)?\\([CgGLptTuU]\\)?")) + (while (re-search-forward regexp nil t) + (let* ((items (and (match-end 1) + (save-match-data + (split-string (match-string-no-properties 1) + "|")))) + (key (match-string 2)) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0))) + (prompt (nth 0 items)) + (default (nth 1 items)) + (completions (nthcdr 2 items))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (pcase key + ((or "G" "g") + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (cond ((equal key "G") (org-agenda-files)) + (file (list file)) + (t nil)))) + (org-add-colon-after-tag-completion t) + (ins (mapconcat + #'identity + (org-split-string + (completing-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history) + "[^[:alnum:]_@#%]+") + ":"))) + (when (org-string-nw-p ins) + (unless (eq (char-before) ?:) (insert ":")) + (insert ins) + (unless (eq (char-after) ?:) (insert ":")) + (and (org-at-heading-p) + (let ((org-ignore-region t)) + (org-set-tags nil 'align)))))) + ((or "C" "L") + (let ((insert-fun (if (equal key "C") #'insert + (lambda (s) (org-insert-link 0 s))))) + (pcase org-capture--clipboards + (`nil nil) + (`(,value) (funcall insert-fun value)) + (`(,first-value . ,_) + (funcall insert-fun + (read-string "Clipboard/kill value: " + first-value + 'org-capture--clipboards + first-value))) + (_ (error "Invalid `org-capture--clipboards' value: %S" + org-capture--clipboards))))) + ("p" (org-set-property prompt nil)) + ((guard key) + ;; These are the date/time related ones. + (let* ((upcase? (equal (upcase key) key)) + (org-time-was-given upcase?) + (org-end-time-was-given) + (time (org-read-date upcase? t nil prompt))) + (org-insert-time-stamp + time org-time-was-given + (member key '("u" "U")) + nil nil (list org-end-time-was-given)))) + (_ + (push (org-completing-read + (concat (or prompt "Enter string") + (and default (format " [%s]" default)) + ": ") + completions nil nil nil nil default) + strings) + (insert (car strings))))))))) + + ;; Replace %n escapes with nth %^{...} string. + (setq strings (nreverse strings)) + (save-excursion + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))))) + ;; Make sure there are no empty lines before the text, and that - ;; it ends with a newline character - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) - ;; Return the expanded template and kill the temporary buffer + ;; it ends with a newline character. + (skip-chars-forward " \t\n") + (delete-region (point-min) (line-beginning-position)) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (delete-region (point) (point-max)) + (insert "\n") + + ;; Return the expanded template and kill the capture buffer. (untabify (point-min) (point-max)) (set-buffer-modified-p nil) - (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + (prog1 (buffer-substring-no-properties (point-min) (point-max)) + (kill-buffer (current-buffer)))))) (defun org-capture-escaped-% () - "Check if % was escaped - if yes, unescape it now." - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - -(defun org-capture-expand-embedded-elisp () - "Evaluate embedded elisp %(sexp) and replace with the result." - (goto-char (point-min)) - (while (re-search-forward "%(" nil t) - (unless (org-capture-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let* ((sexp (read (current-buffer))) - (result (org-eval - (org-capture--expand-keyword-in-embedded-elisp sexp)))) - (delete-region template-start (point)) - (when result - (if (stringp result) - (insert result) - (error "Capture template sexp `%s' must evaluate to string or nil" - sexp)))))))) + "Non-nil if % was escaped. +If yes, unescape it now. Assume match-data contains the +placeholder to check." + (save-excursion + (goto-char (match-beginning 0)) + (let ((n (abs (skip-chars-backward "\\\\")))) + (delete-char (/ (1+ n) 2)) + (= (% n 2) 1)))) + +(defun org-capture-expand-embedded-elisp (&optional mark) + "Evaluate embedded elisp %(sexp) and replace with the result. +When optional MARK argument is non-nil, mark Sexp with a text +property (`org-embedded-elisp') for later evaluation. Only +marked Sexp are evaluated when this argument is nil." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (cond + ((get-text-property (match-beginning 0) 'org-embedded-elisp) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp + sexp)))) + (delete-region template-start (point)) + (cond + ((not result) nil) + ((stringp result) (insert result)) + (t (error + "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))) + ((not mark) nil) + ;; Only mark valid and non-escaped sexp. + ((org-capture-escaped-%) nil) + (t + (let ((end (with-syntax-table emacs-lisp-mode-syntax-table + (ignore-errors (scan-sexps (1- (point)) 1))))) + (when end + (put-text-property (- (point) 2) end 'org-embedded-elisp t)))))))) (defun org-capture--expand-keyword-in-embedded-elisp (attr) "Recursively replace capture link keywords in ATTR sexp. @@ -1771,20 +1845,10 @@ Such keywords are prefixed with \"%:\". See (t attr))) (defun org-capture-inside-embedded-elisp-p () - "Return non-nil if point is inside of embedded elisp %(sexp)." - (let (beg end) - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - ;; `looking-at' and `search-backward' below do not match the "%(" if - ;; point is in its middle - (when (equal (char-before) ?%) - (backward-char)) - (save-match-data - (when (or (looking-at "%(") (search-backward "%(" nil t)) - (setq beg (point)) - (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) - (when (and beg end) - (and (<= (point) end) (>= (point) beg)))))) + "Non-nil if point is inside of embedded elisp %(sexp). +Assume sexps have been marked with +`org-capture-expand-embedded-elisp' beforehand." + (get-text-property (point) 'org-embedded-elisp)) ;;;###autoload (defun org-capture-import-remember-templates () @@ -1828,6 +1892,9 @@ Such keywords are prefixed with \"%:\". See (if jump-to-captured '(:jump-to-captured t))))) org-remember-templates)))) +;;; The function was made obsolete by commit 65399674d5 of +;;; 2013-02-22. This make-obsolete call was added 2016-09-01. +(make-obsolete 'org-capture-import-remember-templates "use the `org-capture-templates' variable instead." "Org 9.0") (provide 'org-capture) diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 0bba92550f..cb6a6c9ad1 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -1,4 +1,4 @@ -;;; org-clock.el --- The time clocking code for Org-mode +;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,40 +24,49 @@ ;; ;;; Commentary: -;; This file contains the time clocking code for Org-mode +;; This file contains the time clocking code for Org mode ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) (declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function notifications-notify "notifications" (&rest params)) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-refresh-properties "org" (dprop tprop)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-table-goto-line "org-table" (n)) + +(defvar org-frame-title-format-backup frame-title-format) (defvar org-time-stamp-formats) (defvar org-ts-what) -(defvar org-frame-title-format-backup frame-title-format) + (defgroup org-clock nil - "Options concerning clocking working time in Org-mode." + "Options concerning clocking working time in Org mode." :tag "Org Clock" :group 'org-progress) -(defcustom org-clock-into-drawer org-log-into-drawer - "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :LOGBOOK: drawer. -If necessary, the drawer will be created. -When nil, the drawer will not be created, but used when present. -When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created. -When a string, it names the drawer to be used. - -The default for this variable is the value of `org-log-into-drawer', -which see." +(defcustom org-clock-into-drawer t + "Non-nil when clocking info should be wrapped into a drawer. + +When non-nil, clocking info will be inserted into the same drawer +as log notes (see variable `org-log-into-drawer'), if it exists, +or \"LOGBOOK\" otherwise. If necessary, the drawer will be +created. + +When an integer, the drawer is created only when the number of +clocking entries in an item reaches or exceeds this value. + +When a string, it becomes the name of the drawer, ignoring the +log notes drawer altogether. + +Do not check directly this variable in a Lisp program. Call +function `org-clock-into-drawer' instead." :group 'org-todo :group 'org-clock + :version "26.1" + :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) (const :tag "Only when drawer exists" nil) @@ -66,26 +75,29 @@ which see." (string :tag "Into Drawer named..."))) (defun org-clock-into-drawer () - "Return the value of `org-clock-into-drawer', but let properties overrule. + "Value of `org-clock-into-drawer'. but let properties overrule. + If the current entry has or inherits a CLOCK_INTO_DRAWER -property, it will be used instead of the default value; otherwise -if the current entry has or inherits a LOG_INTO_DRAWER property, -it will be used instead of the default value. -The default is the value of the customizable variable `org-clock-into-drawer', -which see." - (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit)) - (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))) - (cond - ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer) - ((or (equal p "t") (equal q "t")) "LOGBOOK") - ((not p) q) - (t p)))) +property, it will be used instead of the default value. + +Return value is either a string, an integer, or nil." + (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit t))) + (cond ((equal p "nil") nil) + ((equal p "t") (or (org-log-into-drawer) "LOGBOOK")) + ((org-string-nw-p p) + (if (string-match-p "\\`[0-9]+\\'" p) (string-to-number p) p)) + ((org-string-nw-p org-clock-into-drawer)) + ((integerp org-clock-into-drawer) org-clock-into-drawer) + ((not org-clock-into-drawer) nil) + ((org-log-into-drawer)) + (t "LOGBOOK")))) (defcustom org-clock-out-when-done t "When non-nil, clock will be stopped when the clocked entry is marked DONE. +\\\ DONE here means any DONE-like state. A nil value means clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item. +`\\[org-clock-out]', or until the clock is started in a different item. Instead of t, this can also be a list of TODO states that should trigger clocking out." :group 'org-clock @@ -223,9 +235,6 @@ file name Play this sound file, fall back to beep" (const :tag "Standard beep" t) (file :tag "Play sound file"))) -(define-obsolete-variable-alias 'org-clock-modeline-total - 'org-clock-mode-line-total "24.3") - (defcustom org-clock-mode-line-total 'auto "Default setting for the time included for the mode line clock. This can be overruled locally using the CLOCK_MODELINE_TOTAL property. @@ -244,7 +253,7 @@ auto Automatically, either `all', or `repeat' for repeating tasks" (const :tag "All task time" all) (const :tag "Automatically, `all' or since `repeat'" auto))) -(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) (defcustom org-clock-task-overrun-text nil "Extra mode line text to indicate that the clock is overrun. The can be nil to indicate that instead of adding text, the clock time @@ -268,14 +277,14 @@ string as argument." (function :tag "Function"))) (defgroup org-clocktable nil - "Options concerning the clock table in Org-mode." + "Options concerning the clock table in Org mode." :tag "Org Clock Table" :group 'org-clock) (defcustom org-clocktable-defaults (list :maxlevel 2 - :lang (or (org-bound-and-true-p org-export-default-language) "en") + :lang (or (bound-and-true-p org-export-default-language) "en") :scope 'file :block nil :wstart 1 @@ -312,7 +321,9 @@ For more information, see `org-clocktable-write-default'." '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") - ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) + ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at") + ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" + "Gesamtdauer" "Dateizeit" "Erstellt am")) "Terms used in clocktable, translated to different languages." :group 'org-clocktable :version "24.1" @@ -371,7 +382,7 @@ play with them." :type 'string) (defcustom org-clock-clocked-in-display 'mode-line - "When clocked in for a task, org-mode can display the current + "When clocked in for a task, Org can display the current task and accumulated time in the mode line and/or frame title. Allowed values are: @@ -413,6 +424,26 @@ if you are using Debian." :package-version '(Org . "8.0") :type 'string) +(defcustom org-clock-goto-before-context 2 + "Number of lines of context to display before currently clocked-in entry. +This applies when using `org-clock-goto'." + :group 'org-clock + :type 'integer) + +(defcustom org-clock-display-default-range 'thisyear + "Default range when displaying clocks with `org-clock-display'." + :group 'org-clock + :type '(choice (const today) + (const yesterday) + (const thisweek) + (const lastweek) + (const thismonth) + (const lastmonth) + (const thisyear) + (const lastyear) + (const untilnow) + (const :tag "Select range interactively" interactive))) + (defvar org-clock-in-prepare-hook nil "Hook run when preparing the clock. This hook is run before anything happens to the task that @@ -430,6 +461,33 @@ to add an effort property.") (defvar org-clock-has-been-used nil "Has the clock been used during the current Emacs session?") +(defvar org-clock-stored-history nil + "Clock history, populated by `org-clock-load'") +(defvar org-clock-stored-resume-clock nil + "Clock to resume, saved by `org-clock-load'") + +(defconst org-clock--oldest-date + (let* ((dichotomy + (lambda (min max pred) + (if (funcall pred min) min + (cl-incf min) + (while (> (- max min) 1) + (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) + (if (funcall pred mean) (setq max mean) (setq min mean))))) + max)) + (high + (funcall dichotomy + most-negative-fixnum + 0 + (lambda (m) (ignore-errors (decode-time (list m 0)))))) + (low + (funcall dichotomy + most-negative-fixnum + 0 + (lambda (m) (ignore-errors (decode-time (list high m))))))) + (list high low)) + "Internal time for oldest date representable on the system.") + ;;; The clock for measuring work time. (defvar org-mode-line-string "") @@ -500,8 +558,17 @@ of a different task.") (org-check-and-save-marker org-clock-hd-marker beg end) (org-check-and-save-marker org-clock-default-task beg end) (org-check-and-save-marker org-clock-interrupted-task beg end) - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-clock-history)) + (dolist (m org-clock-history) + (org-check-and-save-marker m beg end))) + +(defun org-clock-drawer-name () + "Return clock drawer's name for current entry, or nil." + (let ((drawer (org-clock-into-drawer))) + (cond ((integerp drawer) + (let ((log-drawer (org-log-into-drawer))) + (if (stringp log-drawer) log-drawer "LOGBOOK"))) + ((stringp drawer) drawer) + (t nil)))) (defun org-clocking-buffer () "Return the clocking buffer if we are currently clocking a task or nil." @@ -519,8 +586,8 @@ of a different task.") (interactive) (let (och chl sel-list rpl (i 0) s) ;; Remove successive dups from the clock history to consider - (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) - org-clock-history) + (dolist (c org-clock-history) + (unless (equal c (car och)) (push c och))) (setq och (reverse och) chl (length och)) (if (zerop chl) (user-error "No recent clock") @@ -541,17 +608,15 @@ of a different task.") (setq s (org-clock-insert-selection-line ?c org-clock-marker)) (push s sel-list)) (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) - (mapc - (lambda (m) - (when (marker-buffer m) - (setq i (1+ i) - s (org-clock-insert-selection-line - (if (< i 10) - (+ i ?0) - (+ i (- ?A 10))) m)) - (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) - (push s sel-list))) - och) + (dolist (m och) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) (run-hooks 'org-clock-before-select-task-hook) (goto-char (point-min)) ;; Set min-height relatively to circumvent a possible but in @@ -559,6 +624,7 @@ of a different task.") (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) (message (or prompt "Select task for clocking:")) (setq cursor-type nil rpl (read-char-exclusive)) + (kill-buffer) (cond ((eq rpl ?q) nil) ((eq rpl ?x) nil) @@ -570,25 +636,22 @@ of a different task.") And return a cons cell with the selection character integer and the marker pointing to it." (when (marker-buffer marker) - (let (file cat task heading prefix) + (let (cat task heading prefix) (with-current-buffer (org-base-buffer (marker-buffer marker)) - (save-excursion - (save-restriction - (widen) - (ignore-errors - (goto-char marker) - (setq file (buffer-file-name (marker-buffer marker)) - cat (org-get-category) - heading (org-get-heading 'notags) - prefix (save-excursion - (org-back-to-heading t) - (looking-at org-outline-regexp) - (match-string 0)) - task (substring - (org-fontify-like-in-org-mode - (concat prefix heading) - org-odd-levels-only) - (length prefix))))))) + (org-with-wide-buffer + (ignore-errors + (goto-char marker) + (setq cat (org-get-category) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at org-outline-regexp) + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix)))))) (when (and cat task) (insert (format "[%c] %-12s %s\n" i cat task)) (cons i marker))))) @@ -608,19 +671,19 @@ If not, show simply the clocked time like 01:50." (let* ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) (work-done-str - (org-propertize + (propertize (org-minutes-to-clocksum-string clocked-time) 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) 'org-mode-line-clock-overrun 'org-mode-line-clock))) (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) - (clockstr (org-propertize + (clockstr (propertize (concat " [%s/" effort-str "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") 'face 'org-mode-line-clock))) (format clockstr work-done-str)) - (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) - (format " (%s)" org-clock-heading) "]") - 'face 'org-mode-line-clock)))) + (propertize (concat " [" (org-minutes-to-clocksum-string clocked-time) + "]" (format " (%s)" org-clock-heading)) + 'face 'org-mode-line-clock)))) (defun org-clock-get-last-clock-out-time () "Get the last clock-out time for the current subtree." @@ -635,20 +698,21 @@ If not, show simply the clocked time like 01:50." (org-clock-notify-once-if-expired) (setq org-clock-task-overrun nil)) (setq org-mode-line-string - (org-propertize + (propertize (let ((clock-string (org-clock-get-clock-string)) - (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) + (help-text "Org mode clock is running.\nmouse-1 shows a \ +menu\nmouse-2 will jump to task")) (if (and (> org-clock-string-limit 0) (> (length clock-string) org-clock-string-limit)) - (org-propertize + (propertize (substring clock-string 0 org-clock-string-limit) 'help-echo (concat help-text ": " org-clock-heading)) - (org-propertize clock-string 'help-echo help-text))) + (propertize clock-string 'help-echo help-text))) 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) + 'mouse-face 'mode-line-highlight)) (if (and org-clock-task-overrun org-clock-task-overrun-text) (setq org-mode-line-string - (concat (org-propertize + (concat (propertize org-clock-task-overrun-text 'face 'org-mode-line-clock-overrun) org-mode-line-string))) (force-mode-line-update)) @@ -739,7 +803,7 @@ use libnotify if available, or fall back on a message." org-show-notification-handler notification)) ((fboundp 'notifications-notify) (notifications-notify - :title "Org-mode message" + :title "Org mode message" :body notification ;; FIXME how to link to the Org icon? ;; :app-icon "~/.emacs.d/icons/mail.png" @@ -776,11 +840,12 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." "Search through the given file and find all open clocks." (let ((buf (or (get-file-buffer file) (find-file-noselect file))) + (org-clock-re (concat org-clock-string " \\(\\[.*?\\]\\)$")) clocks) (with-current-buffer buf (save-excursion (goto-char (point-min)) - (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) + (while (re-search-forward org-clock-re nil t) (push (cons (copy-marker (match-end 1) t) (org-time-string-to-time (match-string 1))) clocks)))) clocks)) @@ -793,12 +858,10 @@ If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." (defmacro org-with-clock-position (clock &rest forms) "Evaluate FORMS with CLOCK as the current active clock." `(with-current-buffer (marker-buffer (car ,clock)) - (save-excursion - (save-restriction - (widen) - (goto-char (car ,clock)) - (beginning-of-line) - ,@forms)))) + (org-with-wide-buffer + (goto-char (car ,clock)) + (beginning-of-line) + ,@forms))) (def-edebug-spec org-with-clock-position (form body)) (put 'org-with-clock-position 'lisp-indent-function 1) @@ -812,7 +875,7 @@ This macro also protects the current active clock from being altered." (org-clock-effort) (org-clock-marker (car ,clock)) (org-clock-hd-marker (save-excursion - (outline-back-to-heading t) + (org-back-to-heading t) (point-marker)))) ,@forms))) (def-edebug-spec org-with-clock (form body)) @@ -885,7 +948,7 @@ If necessary, clock-out of the currently active clock." (defun org-clock-jump-to-current-clock (&optional effective-clock) (interactive) - (let ((org-clock-into-drawer (org-clock-into-drawer)) + (let ((drawer (org-clock-into-drawer)) (clock (or effective-clock (cons org-clock-marker org-clock-start-time)))) (unless (marker-buffer (car clock)) @@ -893,26 +956,21 @@ If necessary, clock-out of the currently active clock." (org-with-clock clock (org-clock-goto)) (with-current-buffer (marker-buffer (car clock)) (goto-char (car clock)) - (if org-clock-into-drawer - (let ((logbook - (if (stringp org-clock-into-drawer) - (concat ":" org-clock-into-drawer ":") - ":LOGBOOK:"))) - (ignore-errors - (outline-flag-region - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (goto-char (match-beginning 0))) - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (search-forward ":END:") - (goto-char (match-end 0))) - nil))))))) + (when drawer + (org-with-wide-buffer + (let ((drawer-re (format "^[ \t]*:%s:[ \t]*$" + (regexp-quote (if (stringp drawer) drawer "LOGBOOK")))) + (beg (save-excursion (org-back-to-heading t) (point)))) + (catch 'exit + (while (re-search-backward drawer-re beg t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'drawer) + (when (> (org-element-property :end element) (car clock)) + (org-flag-drawer nil element)) + (throw 'exit nil))))))))))) (defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) - "Resolve an open org-mode clock. + "Resolve an open Org clock. An open clock was found, with `dangling' possibly being non-nil. If this function was invoked with a prefix argument, non-dangling open clocks are ignored. The given clock requires some sort of @@ -930,7 +988,7 @@ The format of clock is (CONS MARKER START-TIME), where MARKER identifies the buffer and position the clock is open at (and thus, the heading it's under), and START-TIME is when the clock was started." - (assert clock) + (cl-assert clock) (let* ((ch (save-window-excursion (save-excursion @@ -947,7 +1005,7 @@ k/K Keep X minutes of the idle time (default is all). If this that many minutes after the time that idling began, and then clocked back in at the present time. -g/G Indicate that you “got back” X minutes ago. This is quite +g/G Indicate that you \"got back\" X minutes ago. This is quite different from `k': it clocks you out from the beginning of the idle period and clock you back in X minutes ago. @@ -963,10 +1021,6 @@ For all these options, using uppercase makes your final state to be CLOCKED OUT.")))) (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) (let (char-pressed) - (when (featurep 'xemacs) - (message (concat (funcall prompt-fn clock) - " [jkKgGsScCiq]? ")) - (setq char-pressed (read-char-exclusive))) (while (or (null char-pressed) (and (not (memq char-pressed '(?k ?K ?g ?G ?s ?S ?C @@ -1028,7 +1082,7 @@ to be CLOCKED OUT.")))) ;;;###autoload (defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) - "Resolve all currently open org-mode clocks. + "Resolve all currently open Org clocks. If `only-dangling-p' is non-nil, only ask to resolve dangling \(i.e., not currently open and valid) clocks." (interactive "P") @@ -1091,7 +1145,7 @@ This routine returns a floating point number." (defvar org-clock-user-idle-seconds) (defun org-resolve-clocks-if-idle () - "Resolve all currently open org-mode clocks. + "Resolve all currently open Org clocks. This is performed after `org-clock-idle-time' minutes, to check if the user really wants to stay clocked in after being idle for so long." @@ -1106,13 +1160,12 @@ so long." (org-clock-resolve (cons org-clock-marker org-clock-start-time) - (function - (lambda (clock) - (format "Clocked in & idle for %.1f mins" - (/ (float-time - (time-subtract (current-time) - org-clock-user-idle-start)) - 60.0)))) + (lambda (_) + (format "Clocked in & idle for %.1f mins" + (/ (float-time + (time-subtract (current-time) + org-clock-user-idle-start)) + 60.0))) org-clock-user-idle-start))))) (defvar org-clock-current-task nil "Task currently clocked in.") @@ -1122,18 +1175,27 @@ so long." ;;;###autoload (defun org-clock-in (&optional select start-time) "Start the clock on the current item. + If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked -tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task -and mark it as the default task, a special task that will always be offered -in the clocking selection, associated with the letter `d'. -When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ -clock in by using the last clock-out -time as the start time \(see `org-clock-continuously' to -make this the default behavior.)" + +With a `\\[universal-argument]' prefix argument SELECT, offer a list of \ +recently clocked +tasks to clock into. + +When SELECT is `\\[universal-argument] \ \\[universal-argument]', \ +clock into the current task and mark it as +the default task, a special task that will always be offered in the +clocking selection, associated with the letter `d'. + +When SELECT is `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]', clock in by using the last clock-out +time as the start time. See `org-clock-continuously' to make this +the default behavior." (interactive "P") (setq org-clock-notification-was-shown nil) - (org-refresh-properties org-effort-property 'org-effort) + (org-refresh-properties + org-effort-property '((effort . identity) + (effort-minutes . org-duration-string-to-minutes))) (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (org-clocking-p))) @@ -1148,7 +1210,7 @@ make this the default behavior.)" (not org-clock-resolving-clocks)) (setq org-clock-leftover-time nil) (let ((org-clock-clocking-in t)) - (org-resolve-clocks))) ; check if any clocks are dangling + (org-resolve-clocks))) ; check if any clocks are dangling (when (equal select '(64)) ;; Set start-time to `org-clock-out-time' @@ -1201,116 +1263,116 @@ make this the default behavior.)" (set-buffer (org-base-buffer (marker-buffer selected-task))) (setq target-pos (marker-position selected-task)) (move-marker selected-task nil)) - (save-excursion - (save-restriction - (widen) - (goto-char target-pos) - (org-back-to-heading t) - (or interrupting (move-marker org-clock-interrupted-task nil)) - (run-hooks 'org-clock-in-prepare-hook) - (org-clock-history-push) - (setq org-clock-current-task (nth 4 (org-heading-components))) - (cond ((functionp org-clock-in-switch-to-state) - (looking-at org-complex-heading-regexp) - (let ((newstate (funcall org-clock-in-switch-to-state - (match-string 2)))) - (if newstate (org-todo newstate)))) - ((and org-clock-in-switch-to-state - (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-in-switch-to-state - "\\>")))) - (org-todo org-clock-in-switch-to-state))) - (setq org-clock-heading - (cond ((and org-clock-heading-function - (functionp org-clock-heading-function)) - (funcall org-clock-heading-function)) - ((nth 4 (org-heading-components)) - (replace-regexp-in-string - "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" - (match-string-no-properties 4))) - (t "???"))) - (org-clock-find-position org-clock-in-resume) - (cond - ((and org-clock-in-resume - (looking-at - (concat "^[ \t]*" org-clock-string - " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) - (message "Matched %s" (match-string 1)) - (setq ts (concat "[" (match-string 1) "]")) - (goto-char (match-end 1)) - (setq org-clock-start-time - (apply 'encode-time - (org-parse-time-string (match-string 1)))) - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start)))) - ((eq org-clock-in-resume 'auto-restart) - ;; called from org-clock-load during startup, - ;; do not interrupt, but warn! - (message "Cannot restart clock because task does not contain unfinished clock") - (ding) - (sit-for 2) - (throw 'abort nil)) - (t - (insert-before-markers "\n") - (backward-char 1) - (org-indent-line) - (when (and (save-excursion - (end-of-line 0) - (org-in-item-p))) - (beginning-of-line 1) - (org-indent-line-to (- (org-get-indentation) 2))) - (insert org-clock-string " ") - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start))) - (setq org-clock-start-time - (or (and org-clock-continuously org-clock-out-time) - (and leftover - (y-or-n-p - (format - "You stopped another clock %d mins ago; start this one from then? " - (/ (- (float-time - (org-current-time org-clock-rounding-minutes t)) - (float-time leftover)) 60))) - leftover) - start-time - (org-current-time org-clock-rounding-minutes t))) - (setq ts (org-insert-time-stamp org-clock-start-time - 'with-hm 'inactive)))) - (move-marker org-clock-marker (point) (buffer-base-buffer)) - (move-marker org-clock-hd-marker - (save-excursion (org-back-to-heading t) (point)) - (buffer-base-buffer)) - (setq org-clock-has-been-used t) - ;; add to mode line - (when (or (eq org-clock-clocked-in-display 'mode-line) - (eq org-clock-clocked-in-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string))))) - ;; add to frame title - (when (or (eq org-clock-clocked-in-display 'frame-title) - (eq org-clock-clocked-in-display 'both)) - (setq frame-title-format org-clock-frame-title-format)) - (org-clock-update-mode-line) - (when org-clock-mode-line-timer - (cancel-timer org-clock-mode-line-timer) - (setq org-clock-mode-line-timer nil)) - (when org-clock-clocked-in-display - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line))) - (when org-clock-idle-timer - (cancel-timer org-clock-idle-timer) - (setq org-clock-idle-timer nil)) - (setq org-clock-idle-timer - (run-with-timer 60 60 'org-resolve-clocks-if-idle)) - (message "Clock starts at %s - %s" ts org--msg-extra) - (run-hooks 'org-clock-in-hook))))))) + (org-with-wide-buffer + (goto-char target-pos) + (org-back-to-heading t) + (or interrupting (move-marker org-clock-interrupted-task nil)) + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push) + (setq org-clock-current-task (nth 4 (org-heading-components))) + (cond ((functionp org-clock-in-switch-to-state) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((newstate (funcall org-clock-in-switch-to-state + (match-string 2)))) + (when newstate (org-todo newstate)))) + ((and org-clock-in-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-in-switch-to-state + "\\>")))) + (org-todo org-clock-in-switch-to-state))) + (setq org-clock-heading + (cond ((and org-clock-heading-function + (functionp org-clock-heading-function)) + (funcall org-clock-heading-function)) + ((nth 4 (org-heading-components)) + (replace-regexp-in-string + "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" + (match-string-no-properties 4))) + (t "???"))) + (org-clock-find-position org-clock-in-resume) + (cond + ((and org-clock-in-resume + (looking-at + (concat "^[ \t]*" org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\sw+.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + (message "Matched %s" (match-string 1)) + (setq ts (concat "[" (match-string 1) "]")) + (goto-char (match-end 1)) + (setq org-clock-start-time + (apply 'encode-time + (org-parse-time-string (match-string 1)))) + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start)))) + ((eq org-clock-in-resume 'auto-restart) + ;; called from org-clock-load during startup, + ;; do not interrupt, but warn! + (message "Cannot restart clock because task does not contain unfinished clock") + (ding) + (sit-for 2) + (throw 'abort nil)) + (t + (insert-before-markers "\n") + (backward-char 1) + (org-indent-line) + (when (and (save-excursion + (end-of-line 0) + (org-in-item-p))) + (beginning-of-line 1) + (indent-line-to (- (org-get-indentation) 2))) + (insert org-clock-string " ") + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start))) + (setq org-clock-start-time + (or (and org-clock-continuously org-clock-out-time) + (and leftover + (y-or-n-p + (format + "You stopped another clock %d mins ago; start this one from then? " + (/ (- (float-time + (org-current-time org-clock-rounding-minutes t)) + (float-time leftover)) + 60))) + leftover) + start-time + (org-current-time org-clock-rounding-minutes t))) + (setq ts (org-insert-time-stamp org-clock-start-time + 'with-hm 'inactive)))) + (move-marker org-clock-marker (point) (buffer-base-buffer)) + (move-marker org-clock-hd-marker + (save-excursion (org-back-to-heading t) (point)) + (buffer-base-buffer)) + (setq org-clock-has-been-used t) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) + (org-clock-update-mode-line) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) + (when org-clock-idle-timer + (cancel-timer org-clock-idle-timer) + (setq org-clock-idle-timer nil)) + (setq org-clock-idle-timer + (run-with-timer 60 60 'org-resolve-clocks-if-idle)) + (message "Clock starts at %s - %s" ts org--msg-extra) + (run-hooks 'org-clock-in-hook)))))) ;;;###autoload (defun org-clock-in-last (&optional arg) @@ -1324,8 +1386,7 @@ With three universal prefix arguments, interactively prompt for a todo state to switch to, overriding the existing value `org-clock-in-switch-to-state'." (interactive "P") - (if (equal arg '(4)) - (org-clock-in (org-clock-select-task)) + (if (equal arg '(4)) (org-clock-in arg) (let ((start-time (if (or org-clock-continuously (equal arg '(16))) (or org-clock-out-time (org-current-time org-clock-rounding-minutes t)) @@ -1371,10 +1432,12 @@ decides which time to use." (current-time)) ((equal cmt "today") (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time))) - (setq dt (append (list 0 0 0) (nthcdr 3 dt))) - (if org-extend-today-until - (setf (nth 2 dt) org-extend-today-until)) + (let* ((dt (decode-time)) + (hour (nth 2 dt)) + (day (nth 3 dt))) + (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day))) + (setf (nth 2 dt) org-extend-today-until) + (setq dt (append (list 0 0) (nthcdr 2 dt))) (apply 'encode-time dt))) ((or (equal cmt "all") (and (or (not cmt) (equal cmt "auto")) @@ -1396,87 +1459,93 @@ When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock line and position cursor in that line." (org-back-to-heading t) (catch 'exit - (let* ((org-clock-into-drawer (org-clock-into-drawer)) - (beg (save-excursion - (beginning-of-line 2) - (or (bolp) (newline)) - (point))) - (end (progn (outline-next-heading) (point))) - (re (concat "^[ \t]*" org-clock-string)) - (cnt 0) - (drawer (if (stringp org-clock-into-drawer) - org-clock-into-drawer "LOGBOOK")) - first last ind-last) - (goto-char beg) - (when (and find-unclosed - (re-search-forward - (concat "^[ \t]*" org-clock-string - " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") - end t)) - (beginning-of-line 1) - (throw 'exit t)) - (when (eobp) (newline) (setq end (max (point) end))) - (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t) - ;; we seem to have a CLOCK drawer, so go there. - (beginning-of-line 2) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))) - (throw 'exit t)) - ;; Lets count the CLOCK lines + (let* ((beg (line-beginning-position)) + (end (save-excursion (outline-next-heading) (point))) + (org-clock-into-drawer (org-clock-into-drawer)) + (drawer (org-clock-drawer-name))) + ;; Look for a running clock if FIND-UNCLOSED in non-nil. + (when find-unclosed + (let ((open-clock-re + (concat "^[ \t]*" + org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + (while (re-search-forward open-clock-re end t) + (let ((element (org-element-at-point))) + (when (and (eq (org-element-type element) 'clock) + (eq (org-element-property :status element) 'running)) + (beginning-of-line) + (throw 'exit t)))))) + ;; Look for an existing clock drawer. + (when drawer + (goto-char beg) + (let ((drawer-re (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$"))) + (while (re-search-forward drawer-re end t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'drawer) + (let ((cend (org-element-property :contents-end element))) + (if (and (not org-log-states-order-reversed) cend) + (goto-char cend) + (forward-line)) + (throw 'exit t))))))) (goto-char beg) - (while (re-search-forward re end t) - (setq first (or first (match-beginning 0)) - last (match-beginning 0) - cnt (1+ cnt))) - (when (and (integerp org-clock-into-drawer) - last - (>= (1+ cnt) org-clock-into-drawer)) - ;; Wrap current entries into a new drawer - (goto-char last) - (setq ind-last (org-get-indentation)) - (beginning-of-line 2) - (if (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) - (when (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-bottom-point struct))))) - (insert ":END:\n") - (beginning-of-line 0) - (org-indent-line-to ind-last) - (goto-char first) - (insert ":" drawer ":\n") - (beginning-of-line 0) - (org-indent-line) - (org-flag-drawer t) - (beginning-of-line 2) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))) - (throw 'exit nil)) - - (goto-char beg) - (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) - (not (equal (match-string 1) org-clock-string))) - ;; Planning info, skip to after it - (beginning-of-line 2) - (or (bolp) (newline))) - (when (or (eq org-clock-into-drawer t) - (stringp org-clock-into-drawer) - (and (integerp org-clock-into-drawer) - (< org-clock-into-drawer 2))) - (insert ":" drawer ":\n:END:\n") - (beginning-of-line -1) - (org-indent-line) - (org-flag-drawer t) - (beginning-of-line 2) - (org-indent-line) - (beginning-of-line) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))))))) + (let ((clock-re (concat "^[ \t]*" org-clock-string)) + (count 0) + positions) + ;; Count the CLOCK lines and store their positions. + (save-excursion + (while (re-search-forward clock-re end t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'clock) + (setq positions (cons (line-beginning-position) positions) + count (1+ count)))))) + (cond + ((null positions) + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (unless (bolp) (insert "\n")) + ;; Create a new drawer if necessary. + (when (and org-clock-into-drawer + (or (not (wholenump org-clock-into-drawer)) + (< org-clock-into-drawer 2))) + (let ((beg (point))) + (insert ":" drawer ":\n:END:\n") + (org-indent-region beg (point)) + (goto-char beg) + (org-flag-drawer t) + (forward-line)))) + ;; When a clock drawer needs to be created because of the + ;; number of clock items or simply if it is missing, collect + ;; all clocks in the section and wrap them within the drawer. + ((if (wholenump org-clock-into-drawer) + (>= (1+ count) org-clock-into-drawer) + drawer) + ;; Skip planning line and property drawer, if any. + (org-end-of-meta-data) + (let ((beg (point))) + (insert + (mapconcat + (lambda (p) + (save-excursion + (goto-char p) + (org-trim (delete-and-extract-region + (save-excursion (skip-chars-backward " \r\t\n") + (line-beginning-position 2)) + (line-beginning-position 2))))) + positions "\n") + "\n:END:\n") + (let ((end (point-marker))) + (goto-char beg) + (save-excursion (insert ":" drawer ":\n")) + (org-flag-drawer t) + (org-indent-region (point) end) + (forward-line) + (unless org-log-states-order-reversed + (goto-char end) + (beginning-of-line -1)) + (set-marker end nil)))) + (org-log-states-order-reversed (goto-char (car (last positions)))) + (t (goto-char (car positions)))))))) ;;;###autoload (defun org-clock-out (&optional switch-to-state fail-quietly at-time) @@ -1504,7 +1573,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." ts te s h m remove) (setq org-clock-out-time now) (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) + (with-no-warnings (set-buffer (org-clocking-buffer))) (save-restriction (widen) (goto-char org-clock-marker) @@ -1517,24 +1586,28 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (delete-region (point) (point-at-eol)) (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (- (float-time (apply 'encode-time (org-parse-time-string te))) - (float-time (apply 'encode-time (org-parse-time-string ts)))) + (setq s (- (float-time + (apply #'encode-time (org-parse-time-string te nil t))) + (float-time + (apply #'encode-time (org-parse-time-string ts nil t)))) h (floor (/ s 3600)) s (- s (* 3600 h)) m (floor (/ s 60)) s (- s (* 60 s))) (insert " => " (format "%2d:%02d" h m)) - (when (setq remove (and org-clock-out-remove-zero-time-clocks - (= (+ h m) 0))) - (beginning-of-line 1) - (delete-region (point) (point-at-eol)) - (and (looking-at "\n") (> (point-max) (1+ (point))) - (delete-char 1))) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) - (when org-log-note-clock-out - (org-add-log-setup 'clock-out nil nil nil nil - (concat "# Task: " (org-get-heading t) "\n\n"))) + ;; Possibly remove zero time clocks. However, do not add + ;; a note associated to the CLOCK line in this case. + (cond ((and org-clock-out-remove-zero-time-clocks + (= (+ h m) 0)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-log-note-clock-out + (org-add-log-setup + 'clock-out nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n")))) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) @@ -1551,10 +1624,11 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (org-clock-out-when-done nil)) (cond ((functionp org-clock-out-switch-to-state) - (looking-at org-complex-heading-regexp) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) (let ((newstate (funcall org-clock-out-switch-to-state (match-string 2)))) - (if newstate (org-todo newstate)))) + (when newstate (org-todo newstate)))) ((and org-clock-out-switch-to-state (not (looking-at (concat org-outline-regexp "[ \t]*" org-clock-out-switch-to-state @@ -1564,34 +1638,25 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (message (concat "Clock stopped at %s after " (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") te (if remove " => LINE REMOVED" "")) - (let ((h org-clock-out-hook)) - ;; If a closing note needs to be stored in the drawer - ;; where clocks are stored, let's temporarily disable - ;; `org-clock-remove-empty-clock-drawer' - (if (and (equal org-clock-into-drawer org-log-into-drawer) - (eq org-log-done 'note) - org-clock-out-when-done) - (setq h (delq 'org-clock-remove-empty-clock-drawer h))) - (mapc (lambda (f) (funcall f)) h)) + (run-hooks 'org-clock-out-hook) (unless (org-clocking-p) (setq org-clock-current-task nil))))))) (add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) -(defun org-clock-remove-empty-clock-drawer nil - "Remove empty clock drawer in the current subtree." - (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER") - org-log-into-drawer)) - (clock-drawer (if (eq t olid) "LOGBOOK" olid)) - (end (save-excursion (org-end-of-subtree t t)))) - (when clock-drawer - (save-excursion - (org-back-to-heading t) - (while (and (< (point) end) - (search-forward clock-drawer end t)) - (goto-char (match-beginning 0)) - (org-remove-empty-drawer-at clock-drawer (point)) - (forward-line 1)))))) +(defun org-clock-remove-empty-clock-drawer () + "Remove empty clock drawers in current subtree." + (save-excursion + (org-back-to-heading t) + (org-map-tree + (lambda () + (let ((drawer (org-clock-drawer-name)) + (case-fold-search t)) + (when drawer + (let ((re (format "^[ \t]*:%s:[ \t]*$" (regexp-quote drawer))) + (end (save-excursion (outline-next-heading)))) + (while (re-search-forward re end t) + (org-remove-empty-drawer-at (point)))))))))) (defun org-clock-timestamps-up (&optional n) "Increase CLOCK timestamps at cursor. @@ -1607,7 +1672,7 @@ Optional argument N tells to change by that many units." (defun org-clock-timestamps-change (updown &optional n) "Change CLOCK timestamps synchronously at cursor. -UPDOWN tells whether to change 'up or 'down. +UPDOWN tells whether to change `up' or `down'. Optional argument N tells to change by that many units." (setq org-ts-what nil) (when (org-at-timestamp-p t) @@ -1654,13 +1719,13 @@ Optional argument N tells to change by that many units." (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (error "No active clock")) - (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) + (save-excursion ; Do not replace this with `with-current-buffer'. + (with-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) - (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*") - (line-beginning-position)) + (if (looking-back (concat "^[ \t]*" org-clock-string ".*") + (line-beginning-position)) (progn (delete-region (1- (point-at-bol)) (point-at-eol)) - (org-remove-empty-drawer-at "LOGBOOK" (point))) + (org-remove-empty-drawer-at (point))) (message "Clock gone, cancel the timer anyway") (sit-for 2))) (move-marker org-clock-marker nil) @@ -1672,12 +1737,6 @@ Optional argument N tells to change by that many units." (message "Clock canceled") (run-hooks 'org-clock-cancel-hook)) -(defcustom org-clock-goto-before-context 2 - "Number of lines of context to display before currently clocked-in entry. -This applies when using `org-clock-goto'." - :group 'org-clock - :type 'integer) - ;;;###autoload (defun org-clock-goto (&optional select) "Go to the currently clocked-in entry, or to the most recently clocked one. @@ -1695,7 +1754,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (setq recent t) (car org-clock-history)) (t (error "No active or recent clock task"))))) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (if (or (< m (point-min)) (> m (point-max))) (widen)) (goto-char m) (org-show-entry) @@ -1707,15 +1766,27 @@ With prefix arg SELECT, offer recently clocked tasks for selection." (message "No running clock, this is the most recently clocked task")) (run-hooks 'org-clock-goto-hook))) -(defvar org-clock-file-total-minutes nil +(defvar-local org-clock-file-total-minutes nil "Holds the file total time in minutes, after a call to `org-clock-sum'.") -(make-variable-buffer-local 'org-clock-file-total-minutes) (defun org-clock-sum-today (&optional headline-filter) "Sum the times for each subtree for today." - (interactive) (let ((range (org-clock-special-range 'today))) - (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today))) + (org-clock-sum (car range) (cadr range) + headline-filter :org-clock-minutes-today))) + +(defun org-clock-sum-custom (&optional headline-filter range propname) + "Sum the times for each subtree for today." + (let ((r (or (and (symbolp range) (org-clock-special-range range)) + (org-clock-special-range + (intern (completing-read + "Range: " + '("today" "yesterday" "thisweek" "lastweek" + "thismonth" "lastmonth" "thisyear" "lastyear" + "interactive") + nil t)))))) + (org-clock-sum (car r) (cadr r) + headline-filter (or propname :org-clock-minutes-custom)))) ;;;###autoload (defun org-clock-sum (&optional tstart tend headline-filter propname) @@ -1726,7 +1797,6 @@ HEADLINE-FILTER is a zero-arg function that, if specified, is called for each headline in the time range with point at the headline. Headlines for which HEADLINE-FILTER returns nil are excluded from the clock summation. PROPNAME lets you set a custom text property instead of :org-clock-minutes." - (interactive) (org-with-silent-modifications (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" org-clock-string @@ -1753,9 +1823,9 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (setq ts (match-string 2) te (match-string 3) ts (float-time - (apply 'encode-time (org-parse-time-string ts))) + (apply #'encode-time (org-parse-time-string ts nil t))) te (float-time - (apply 'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te nil t))) ts (if tstart (max ts tstart) ts) te (if tend (min te tend) te) dt (- te ts) @@ -1774,7 +1844,8 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (>= (float-time org-clock-start-time) tstart) (<= (float-time org-clock-start-time) tend)) (let ((time (floor (- (float-time) - (float-time org-clock-start-time)) 60))) + (float-time org-clock-start-time)) + 60))) (setq t1 (+ t1 time)))) (let* ((headline-forced (get-text-property (point) @@ -1784,27 +1855,27 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (save-excursion (save-match-data (funcall headline-filter)))))) (setq level (- (match-end 1) (match-beginning 1))) + (when (>= level lmax) + (setq ltimes (vconcat ltimes (make-vector lmax 0)) lmax (* 2 lmax))) (when (or (> t1 0) (> (aref ltimes level) 0)) (when (or headline-included headline-forced) (if headline-included - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) + (cl-loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) (setq time (aref ltimes level)) (goto-char (match-beginning 0)) (put-text-property (point) (point-at-eol) (or propname :org-clock-minutes) time) - (if headline-filter - (save-excursion - (save-match-data - (while - (> (funcall outline-level) 1) - (outline-up-heading 1 t) - (put-text-property - (point) (point-at-eol) - :org-clock-force-headline-inclusion t)))))) + (when headline-filter + (save-excursion + (save-match-data + (while (org-up-heading-safe) + (put-text-property + (point) (line-end-position) + :org-clock-force-headline-inclusion t)))))) (setq t1 0) - (loop for l from level to (1- lmax) do - (aset ltimes l 0))))))) + (cl-loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) (setq org-clock-file-total-minutes (aref ltimes 0)))))) (defun org-clock-sum-current-item (&optional tstart) @@ -1816,74 +1887,99 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." org-clock-file-total-minutes))) ;;;###autoload -(defun org-clock-display (&optional total-only) +(defun org-clock-display (&optional arg) "Show subtree times in the entire buffer. -If TOTAL-ONLY is non-nil, only show the total time for the entire file -in the echo area. -Use \\[org-clock-remove-overlays] to remove the subtree times." - (interactive) +By default, show the total time for the range defined in +`org-clock-display-default-range'. With `\\[universal-argument]' \ +prefix, show +the total time for today instead. + +With `\\[universal-argument] \\[universal-argument]' prefix, \ +use a custom range, entered at prompt. + +With `\\[universal-argument] \ \\[universal-argument] \ +\\[universal-argument]' prefix, display the total time in the +echo area. + +Use `\\[org-clock-remove-overlays]' to remove the subtree times." + (interactive "P") (org-clock-remove-overlays) - (let (time h m p) - (org-clock-sum) - (unless total-only + (let* ((todayp (equal arg '(4))) + (customp (member arg '((16) today yesterday + thisweek lastweek thismonth + lastmonth thisyear lastyear + untilnow interactive))) + (prop (cond ((not arg) :org-clock-minutes-default) + (todayp :org-clock-minutes-today) + (customp :org-clock-minutes-custom) + (t :org-clock-minutes))) + time h m p) + (cond ((not arg) (org-clock-sum-custom + nil org-clock-display-default-range prop)) + (todayp (org-clock-sum-today)) + (customp (org-clock-sum-custom nil arg)) + (t (org-clock-sum))) + (unless (eq arg '(64)) (save-excursion (goto-char (point-min)) (while (or (and (equal (setq p (point)) (point-min)) - (get-text-property p :org-clock-minutes)) + (get-text-property p prop)) (setq p (next-single-property-change - (point) :org-clock-minutes))) + (point) prop))) (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (org-clock-put-overlay time (funcall outline-level)))) + (when (setq time (get-text-property p prop)) + (org-clock-put-overlay time))) (setq h (/ org-clock-file-total-minutes 60) m (- org-clock-file-total-minutes (* 60 h))) ;; Arrange to remove the overlays upon next change. (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-clock-remove-overlays + (add-hook 'before-change-functions 'org-clock-remove-overlays nil 'local)))) - (message (concat "Total file time: " - (org-minutes-to-clocksum-string org-clock-file-total-minutes) - " (%d hours and %d minutes)") h m))) - -(defvar org-clock-overlays nil) -(make-variable-buffer-local 'org-clock-overlays) - -(defun org-clock-put-overlay (time &optional level) + (message (concat (format "Total file time%s: " + (cond (todayp " for today") + (customp " (custom)") + (t ""))) + (org-minutes-to-clocksum-string + org-clock-file-total-minutes) + " (%d hours and %d minutes)") + h m))) + +(defvar-local org-clock-overlays nil) + +(defun org-clock-put-overlay (time) "Put an overlays on the current line, displaying TIME. -If LEVEL is given, prefix time with a corresponding number of stars. This creates a new overlay and stores it in `org-clock-overlays', so that it will be easy to remove." - (let* ((l (if level (org-get-valid-level level 0) 0)) - ov tx) + (let (ov tx) (beginning-of-line) - (when (looking-at org-complex-heading-regexp) - (goto-char (match-beginning 4))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (goto-char (match-beginning 4)))) (setq ov (make-overlay (point) (point-at-eol)) - tx (concat (buffer-substring-no-properties (point) (match-end 4)) - (make-string - (max 0 (- (- 60 (current-column)) - (- (match-end 4) (match-beginning 4)) - (length (org-get-at-bol 'line-prefix)))) ?.) - (org-add-props (concat (make-string l ?*) " " - (org-minutes-to-clocksum-string time) - (make-string (- 16 l) ?\ )) - (list 'face 'org-clock-overlay)) + tx (concat (buffer-substring-no-properties (point) (match-end 4)) + (org-add-props + (make-string + (max 0 (- (- 60 (current-column)) + (- (match-end 4) (match-beginning 4)) + (length (org-get-at-bol 'line-prefix)))) + ?\·) + '(face shadow)) + (org-add-props + (format " %9s " (org-minutes-to-clocksum-string time)) + '(face org-clock-overlay)) "")) - (if (not (featurep 'xemacs)) - (overlay-put ov 'display tx) - (overlay-put ov 'invisible t) - (overlay-put ov 'end-glyph (make-glyph tx))) + (overlay-put ov 'display tx) (push ov org-clock-overlays))) ;;;###autoload -(defun org-clock-remove-overlays (&optional beg end noremove) +(defun org-clock-remove-overlays (&optional _beg _end noremove) "Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer." +If NOREMOVE is nil, remove this function from the +`before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-clock-overlays) + (mapc #'delete-overlay org-clock-overlays) (setq org-clock-overlays nil) (unless noremove (remove-hook 'before-change-functions @@ -2020,127 +2116,159 @@ buffer and update it." (defun org-clock-special-range (key &optional time as-strings wstart mstart) "Return two times bordering a special time range. -Key is a symbol specifying the range and can be one of `today', `yesterday', -`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. -By default, a week starts Monday 0:00 and ends Sunday 24:00. -The range is determined relative to TIME, which defaults to current time. -The return value is a cons cell with two internal times like the ones -returned by `current time' or `encode-time'. -If AS-STRINGS is non-nil, the returned times will be formatted strings. -If WSTART is non-nil, use this number to specify the starting day of a -week (monday is 1). -If MSTART is non-nil, use this number to specify the starting day of a -month (1 is the first day of the month). -If you can combine both, the month starting day will have priority." - (if (integerp key) (setq key (intern (number-to-string key)))) + +KEY is a symbol specifying the range and can be one of `today', +`yesterday', `thisweek', `lastweek', `thismonth', `lastmonth', +`thisyear', `lastyear' or `untilnow'. If set to `interactive', +user is prompted for range boundaries. It can be a string or an +integer. + +By default, a week starts Monday 0:00 and ends Sunday 24:00. The +range is determined relative to TIME, which defaults to current +time. + +The return value is a list containing two internal times, one for +the beginning of the range and one for its end, like the ones +returned by `current time' or `encode-time' and a string used to +display information. If AS-STRINGS is non-nil, the returned +times will be formatted strings. + +If WSTART is non-nil, use this number to specify the starting day +of a week (monday is 1). If MSTART is non-nil, use this number +to specify the starting day of a month (1 is the first day of the +month). If you can combine both, the month starting day will +have priority." (let* ((tm (decode-time time)) - (s 0) (m (nth 1 tm)) (h (nth 2 tm)) - (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) + (m (nth 1 tm)) + (h (nth 2 tm)) + (d (nth 3 tm)) + (month (nth 4 tm)) + (y (nth 5 tm)) (dow (nth 6 tm)) - (ws (or wstart 1)) - (ms (or mstart 1)) - (skey (symbol-name key)) + (skey (format "%s" key)) (shift 0) - (q (cond ((>= (nth 4 tm) 10) 4) - ((>= (nth 4 tm) 7) 3) - ((>= (nth 4 tm) 4) 2) - ((>= (nth 4 tm) 1) 1))) - s1 m1 h1 d1 month1 y1 diff ts te fm txt w date - interval tmp shiftedy shiftedm shiftedq) + (q (cond ((>= month 10) 4) + ((>= month 7) 3) + ((>= month 4) 2) + (t 1))) + m1 h1 d1 month1 y1 shiftedy shiftedm shiftedq) (cond - ((string-match "^[0-9]+$" skey) - (setq y (string-to-number skey) m 1 d 1 key 'year)) - ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey) + ((string-match "\\`[0-9]+\\'" skey) + (setq y (string-to-number skey) month 1 d 1 key 'year)) + ((string-match "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)\\'" skey) (setq y (string-to-number (match-string 1 skey)) month (string-to-number (match-string 2 skey)) - d 1 key 'month)) - ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey) + d 1 + key 'month)) + ((string-match "\\`\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)\\'" skey) (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey)) - w (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list w 1 y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) - dow 1 - key 'week)) - ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) + (let ((date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute + (list (string-to-number (match-string 2 skey)) + 1 + (string-to-number (match-string 1 skey))))))) + (setq d (nth 1 date) + month (car date) + y (nth 2 date) + dow 1 + key 'week))) + ((string-match "\\`\\([0-9]+\\)-[qQ]\\([1-4]\\)\\'" skey) (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey))) (setq q (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date q y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) - dow 1 - key 'quarter)) - ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) + (let ((date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute + (org-quarter-to-date + q (string-to-number (match-string 1 skey))))))) + (setq d (nth 1 date) + month (car date) + y (nth 2 date) + dow 1 + key 'quarter))) + ((string-match + "\\`\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)\\'" + skey) (setq y (string-to-number (match-string 1 skey)) month (string-to-number (match-string 2 skey)) d (string-to-number (match-string 3 skey)) key 'day)) - ((string-match "\\([-+][0-9]+\\)$" skey) + ((string-match "\\([-+][0-9]+\\)\\'" skey) (setq shift (string-to-number (match-string 1 skey)) - key (intern (substring skey 0 (match-beginning 1)))) - (if (and (memq key '(quarter thisq)) (> shift 0)) - (error "Looking forward with quarters isn't implemented")))) - + key (intern (substring skey 0 (match-beginning 1)))) + (when (and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented")))) (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) - ((eq key 'lastweek) (setq key 'week shift -1)) - ((eq key 'lastmonth) (setq key 'month shift -1)) - ((eq key 'lastyear) (setq key 'year shift -1)) - ((eq key 'lastq) (setq key 'quarter shift -1)))) - (cond - ((memq key '(day today)) - (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) - ((memq key '(week thisweek)) - (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) - m 0 h 0 d (- d diff) d1 (+ 7 d))) - ((memq key '(month thismonth)) - (setq d (or ms 1) h 0 m 0 d1 (or ms 1) - month (+ month shift) month1 (1+ month) h1 0 m1 0)) - ((memq key '(quarter thisq)) - ;; Compute if this shift remains in this year. If not, compute - ;; how many years and quarters we have to shift (via floor*) and - ;; compute the shifted years, months and quarters. - (cond - ((< (+ (- q 1) shift) 0) ; shift not in this year - (setq interval (* -1 (+ (- q 1) shift))) - ;; Set tmp to ((years to shift) (quarters to shift)). - (setq tmp (org-floor* interval 4)) - ;; Due to the use of floor, 0 quarters actually means 4. - (if (= 0 (nth 1 tmp)) - (setq shiftedy (- y (nth 0 tmp)) - shiftedm 1 - shiftedq 1) - (setq shiftedy (- y (+ 1 (nth 0 tmp))) - shiftedm (- 13 (* 3 (nth 1 tmp))) - shiftedq (- 5 (nth 1 tmp)))) - (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) - ((> (+ q shift) 0) ; shift is within this year - (setq shiftedq (+ q shift)) - (setq shiftedy y) - (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) - ((memq key '(year thisyear)) - (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) - (t (error "No such time block %s" key))) - (setq ts (encode-time s m h d month y) - te (encode-time (or s1 s) (or m1 m) (or h1 h) - (or d1 d) (or month1 month) (or y1 y))) - (setq fm (cdr org-time-stamp-formats)) - (cond - ((memq key '(day today)) - (setq txt (format-time-string "%A, %B %d, %Y" ts))) - ((memq key '(week thisweek)) - (setq txt (format-time-string "week %G-W%V" ts))) - ((memq key '(month thismonth)) - (setq txt (format-time-string "%B %Y" ts))) - ((memq key '(year thisyear)) - (setq txt (format-time-string "the year %Y" ts))) - ((memq key '(quarter thisq)) - (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))) - (if as-strings - (list (format-time-string fm ts) (format-time-string fm te) txt) - (list ts te txt)))) + (pcase key + (`yesterday (setq key 'today shift -1)) + (`lastweek (setq key 'week shift -1)) + (`lastmonth (setq key 'month shift -1)) + (`lastyear (setq key 'year shift -1)) + (`lastq (setq key 'quarter shift -1)))) + ;; Prepare start and end times depending on KEY's type. + (pcase key + ((or `day `today) (setq m 0 h 0 h1 24 d (+ d shift))) + ((or `week `thisweek) + (let* ((ws (or wstart 1)) + (diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))))) + (setq m 0 h 0 d (- d diff) d1 (+ 7 d)))) + ((or `month `thismonth) + (setq h 0 m 0 d (or mstart 1) month (+ month shift) month1 (1+ month))) + ((or `quarter `thisq) + ;; Compute if this shift remains in this year. If not, compute + ;; how many years and quarters we have to shift (via floor*) and + ;; compute the shifted years, months and quarters. + (cond + ((< (+ (- q 1) shift) 0) ; Shift not in this year. + (let* ((interval (* -1 (+ (- q 1) shift))) + ;; Set tmp to ((years to shift) (quarters to shift)). + (tmp (cl-floor interval 4))) + ;; Due to the use of floor, 0 quarters actually means 4. + (if (= 0 (nth 1 tmp)) + (setq shiftedy (- y (nth 0 tmp)) + shiftedm 1 + shiftedq 1) + (setq shiftedy (- y (+ 1 (nth 0 tmp))) + shiftedm (- 13 (* 3 (nth 1 tmp))) + shiftedq (- 5 (nth 1 tmp))))) + (setq m 0 h 0 d 1 month shiftedm month1 (+ 3 shiftedm) y shiftedy)) + ((> (+ q shift) 0) ; Shift is within this year. + (setq shiftedq (+ q shift)) + (setq shiftedy y) + (let ((qshift (* 3 (1- (+ q shift))))) + (setq m 0 h 0 d 1 month (+ 1 qshift) month1 (+ 4 qshift)))))) + ((or `year `thisyear) + (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) + ((or `interactive `untilnow)) ; Special cases, ignore them. + (_ (user-error "No such time block %s" key))) + ;; Format start and end times according to AS-STRINGS. + (let* ((start (pcase key + (`interactive (org-read-date nil t nil "Range start? ")) + (`untilnow org-clock--oldest-date) + (_ (encode-time 0 m h d month y)))) + (end (pcase key + (`interactive (org-read-date nil t nil "Range end? ")) + (`untilnow (current-time)) + (_ (encode-time 0 + (or m1 m) + (or h1 h) + (or d1 d) + (or month1 month) + (or y1 y))))) + (text + (pcase key + ((or `day `today) (format-time-string "%A, %B %d, %Y" start)) + ((or `week `thisweek) (format-time-string "week %G-W%V" start)) + ((or `month `thismonth) (format-time-string "%B %Y" start)) + ((or `year `thisyear) (format-time-string "the year %Y" start)) + ((or `quarter `thisq) + (concat (org-count-quarter shiftedq) + " quarter of " (number-to-string shiftedy))) + (`interactive "(Range interactively set)") + (`untilnow "now")))) + (if (not as-strings) (list start end text) + (let ((f (cdr org-time-stamp-formats))) + (list (format-time-string f start) + (format-time-string f end) + text)))))) (defun org-count-quarter (n) (cond @@ -2196,7 +2324,7 @@ the currently selected interval size." ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) (require 'cal-iso) (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list (+ mw n) 1 y)))) + (calendar-iso-to-absolute (list (+ mw n) 1 y)))) (setq ins (format-time-string "%G-W%V" (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) @@ -2213,7 +2341,7 @@ the currently selected interval size." y (- y 1)) ()) (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) + (calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y)))) (setq ins (format-time-string (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) @@ -2238,25 +2366,32 @@ the currently selected interval size." (setq params (org-combine-plists org-clocktable-defaults params)) (catch 'exit (let* ((scope (plist-get params :scope)) + (files (pcase scope + (`agenda + (org-agenda-files t)) + (`agenda-with-archives + (org-add-archive-files (org-agenda-files t))) + (`file-with-archives + (and buffer-file-name + (org-add-archive-files (list buffer-file-name)))) + ((pred consp) scope) + (_ (or (buffer-file-name) (current-buffer))))) (block (plist-get params :block)) (ts (plist-get params :tstart)) (te (plist-get params :tend)) - (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) (ws (plist-get params :wstart)) (ms (plist-get params :mstart)) (step (plist-get params :step)) - (timestamp (plist-get params :timestamp)) (formatter (or (plist-get params :formatter) org-clock-clocktable-formatter 'org-clocktable-write-default)) - cc range-text ipos pos one-file-with-archives - scope-is-list tbls level) + cc) ;; Check if we need to do steps (when block ;; Get the range text for the header (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (when step ;; Write many tables, in steps (unless (or block (and ts te)) @@ -2264,63 +2399,49 @@ the currently selected interval size." (org-clocktable-steps params) (throw 'exit nil)) - (setq ipos (point)) ; remember the insertion position - - ;; Get the right scope - (setq pos (point)) - (cond - ((and scope (listp scope) (symbolp (car scope))) - (setq scope (eval scope))) - ((eq scope 'agenda) - (setq scope (org-agenda-files t))) - ((eq scope 'agenda-with-archives) - (setq scope (org-agenda-files t)) - (setq scope (org-add-archive-files scope))) - ((eq scope 'file-with-archives) - (setq scope (org-add-archive-files (list (buffer-file-name))) - one-file-with-archives t))) - (setq scope-is-list (and scope (listp scope))) - (if scope-is-list - ;; we collect from several files - (let* ((files scope) - file) - (org-agenda-prepare-buffers files) - (while (setq file (pop files)) - (with-current-buffer (find-buffer-visiting file) - (save-excursion - (save-restriction - (push (org-clock-get-table-data file params) tbls)))))) - ;; Just from the current file - (save-restriction - ;; get the right range into the restriction - (org-agenda-prepare-buffers (list (buffer-file-name))) - (cond - ((not scope)) ; use the restriction as it is now - ((eq scope 'file) (widen)) - ((eq scope 'subtree) (org-narrow-to-subtree)) - ((eq scope 'tree) - (while (org-up-heading-safe)) - (org-narrow-to-subtree)) - ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" - (symbol-name scope))) - (setq level (string-to-number (match-string 1 (symbol-name scope)))) - (catch 'exit - (while (org-up-heading-safe) - (looking-at org-outline-regexp) - (if (<= (org-reduced-level (funcall outline-level)) level) - (throw 'exit nil)))) - (org-narrow-to-subtree))) - ;; do the table, with no file name. - (push (org-clock-get-table-data nil params) tbls))) - - ;; OK, at this point we tbls as a list of tables, one per file - (setq tbls (nreverse tbls)) - - (setq params (plist-put params :multifile scope-is-list)) - (setq params (plist-put params :one-file-with-archives - one-file-with-archives)) - - (funcall formatter ipos tbls params)))) + (org-agenda-prepare-buffers (if (consp files) files (list files))) + + (let ((origin (point)) + (tables + (if (consp files) + (mapcar (lambda (file) + (with-current-buffer (find-buffer-visiting file) + (save-excursion + (save-restriction + (org-clock-get-table-data file params))))) + files) + ;; Get the right restriction for the scope. + (save-restriction + (cond + ((not scope)) ;use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) + (string-match "\\`tree\\([0-9]+\\)\\'" + (symbol-name scope))) + (let ((level (string-to-number + (match-string 1 (symbol-name scope))))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at org-outline-regexp) + (when (<= (org-reduced-level (funcall outline-level)) + level) + (throw 'exit nil)))) + (org-narrow-to-subtree)))) + (list (org-clock-get-table-data nil params))))) + (multifile + ;; Even though `file-with-archives' can consist of + ;; multiple files, we consider this is one extended file + ;; instead. + (and (consp files) (not (eq scope 'file-with-archives))))) + + (funcall formatter + origin + tables + (org-combine-plists params `(:multifile ,multifile))))))) (defun org-clocktable-write-default (ipos tables params) "Write out a clock table at position IPOS in the current buffer. @@ -2335,43 +2456,46 @@ from the dynamic block definition." ;; well-defined number of columns... (let* ((hlchars '((1 . "*") (2 . "/"))) (lwords (assoc (or (plist-get params :lang) - (org-bound-and-true-p org-export-default-language) + (bound-and-true-p org-export-default-language) "en") org-clock-clocktable-language-setup)) (multifile (plist-get params :multifile)) (block (plist-get params :block)) - (ts (plist-get params :tstart)) - (te (plist-get params :tend)) - (header (plist-get params :header)) - (narrow (plist-get params :narrow)) + (sort (plist-get params :sort)) + (header (plist-get params :header)) (ws (or (plist-get params :wstart) 1)) (ms (or (plist-get params :mstart) 1)) (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) - (emph (plist-get params :emphasize)) - (level-p (plist-get params :level)) (org-time-clocksum-use-effort-durations (plist-get params :effort-durations)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (emph (plist-get params :emphasize)) + (compact? (plist-get params :compact)) + (narrow (or (plist-get params :narrow) (and compact? '40!))) + (level? (and (not compact?) (plist-get params :level))) (timestamp (plist-get params :timestamp)) (properties (plist-get params :properties)) - (ntcol (max 1 (or (plist-get params :tcolumns) 100))) - (rm-file-column (plist-get params :one-file-with-archives)) - (indent (plist-get params :indent)) + (time-columns + (if (or compact? (< maxlevel 2)) 1 + ;; Deepest headline level is a hard limit for the number + ;; of time columns. + (let ((levels + (cl-mapcan + (lambda (table) + (pcase table + (`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries) + (mapcar #'car entries)))) + tables))) + (min maxlevel + (or (plist-get params :tcolumns) 100) + (if (null levels) 1 (apply #'max levels)))))) + (indent (or compact? (plist-get params :indent))) + (formula (plist-get params :formula)) (case-fold-search t) - range-text total-time tbl level hlc formula pcol - file-time entries entry headline - recalc content narrow-cut-p tcol) - - ;; Implement abbreviations - (when (plist-get params :compact) - (setq level nil indent t narrow (or narrow '40!) ntcol 1)) - - ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) + range-text total-time recalc narrow-cut-p) (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link + ;; We cannot have both integer narrow and link. (message "Using hard narrowing in clocktable to allow for links") (setq narrow (intern (format "%d!" narrow)))) @@ -2389,19 +2513,19 @@ from the dynamic block definition." narrow)))) (when block - ;; Get the range text for the header + ;; Get the range text for the header. (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) + ;; Compute the total time. + (setq total-time (apply #'+ (mapcar #'cadr tables))) - ;; Now we need to output this tsuff + ;; Now we need to output this tsuff. (goto-char ipos) - ;; Insert the text *before* the actual table + ;; Insert the text *before* the actual table. (insert-before-markers (or header - ;; Format the standard header + ;; Format the standard header. (concat "#+CAPTION: " (nth 9 lwords) " [" @@ -2415,155 +2539,144 @@ from the dynamic block definition." ;; Insert the narrowing line (when (and narrow (integerp narrow) (not narrow-cut-p)) (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns + "|" ;table line starter + (if multifile "|" "") ;file column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (format "<%d>| |\n" narrow))) ; headline and time columns ;; Insert the table header line (insert-before-markers - "|" ; table line starter - (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe - (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe - (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe - (concat (nth 4 lwords) "|" - (nth 5 lwords) "|\n")) ; headline and time columns + "|" ;table line starter + (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe + (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe + (if properties ;properties columns, maybe + (concat (mapconcat #'identity properties "|") "|") + "") + (concat (nth 4 lwords) "|") ;headline + (concat (nth 5 lwords) "|") ;time column + (make-string (max 0 (1- time-columns)) ?|) ;other time columns + (if (eq formula '%) "%|\n" "\n")) ;; Insert the total time in the table (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter + "|-\n" ;a hline + "|" ;table line starter (if multifile (concat "| " (nth 6 lwords) " ") "") - ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ; properties columns, maybe - (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + ;file column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (make-string (length properties) ?|) ;properties columns, maybe + (concat (format org-clock-total-time-cell-format (nth 7 lwords)) + "| ") (format org-clock-total-time-cell-format - (org-minutes-to-clocksum-string (or total-time 0))) ; the time - "|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected + (org-minutes-to-clocksum-string (or total-time 0))) ;time + "|" + (make-string (max 0 (1- time-columns)) ?|) + (cond ((not (eq formula '%)) "") + ((or (not total-time) (= total-time 0)) "0.0|") + (t "100.0|")) + "\n") + + ;; Now iterate over the tables and insert the data but only if any + ;; time has been collected. (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) + (pcase-dolist (`(,file-name ,file-time ,entries) tables) (when (or (and file-time (> file-time 0)) (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files + (insert-before-markers "|-\n") ;hline at new file + ;; First the file time, if we have multiple files. (when multifile - ;; Summarize the time collected from this file + ;; Summarize the time collected from this file. (insert-before-markers (format (concat "| %s %s | %s%s" - (format org-clock-file-time-cell-format (nth 8 lwords)) + (format org-clock-file-time-cell-format + (nth 8 lwords)) " | *%s*|\n") - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time + (file-name-nondirectory file-name) + (if level? "| " "") ;level column, maybe + (if timestamp "| " "") ;timestamp column, maybe + (if properties ;properties columns, maybe + (make-string (length properties) ?|) + "") + (org-minutes-to-clocksum-string file-time)))) ;time ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if properties - (concat - (mapconcat - (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) - properties "|") "|") "") ;properties columns, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) - ; empty fields for higher levels - hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - ;; When exporting subtrees or regions the region might be - ;; activated, so let's disable ̀delete-active-region' - (let ((delete-active-region nil)) (backward-delete-char 1)) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "Invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (when (> maxlevel 0) + (pcase-dolist (`(,level ,headline ,ts ,time ,props) entries) + (when narrow-cut-p + (setq headline + (if (and (string-match + (format "\\`%s\\'" org-bracket-link-regexp) + headline) + (match-end 3)) + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow)) + (org-shorten-string headline narrow)))) + (let ((hlc (if emph (or (cdr (assoc level hlchars)) "") ""))) + (insert-before-markers + "|" ;start the table line + (if multifile "|" "") ;free space for file name column? + (if level? (format "%d|" level) "") ;level, maybe + (if timestamp (concat ts "|") "") ;timestamp, maybe + (if properties ;properties columns, maybe + (concat (mapconcat (lambda (p) + (or (cdr (assoc p props)) "")) + properties + "|") + "|") + "") + (if indent ;indentation + (org-clocktable-indent-string level) + "") + hlc headline hlc "|" ;headline + ;; Empty fields for higher levels. + (make-string (max 0 (1- (min time-columns level))) ?|) + hlc (org-minutes-to-clocksum-string time) hlc "|" ; time + (make-string (max 0 (- time-columns level)) ?|) + (if (eq formula '%) + (format "%.1f |" (* 100 (/ time (float total-time)))) + "") + "\n"))))))) + (delete-char -1) + (cond + ;; Possibly rescue old formula? + ((or (not formula) (eq formula '%)) + (let ((contents (org-string-nw-p (plist-get params :content)))) + (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents)) (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) + (insert "\n" (match-string 1 contents)) (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary + ;; Insert specified formula line. + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t + (user-error "Invalid :formula parameter in clocktable"))) + ;; Back to beginning, align the table, recalculate if necessary. (goto-char ipos) (skip-chars-forward "^|") (org-table-align) (when org-hide-emphasis-markers - ;; we need to align a second time + ;; We need to align a second time. (org-table-align)) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) + (when sort + (save-excursion + (org-table-goto-line 3) + (org-table-goto-column (car sort)) + (org-table-sort-lines nil (cdr sort)))) + (when recalc (org-table-recalculate 'all)) total-time)) (defun org-clocktable-indent-string (level) + "Return indentation string according to LEVEL. +LEVEL is an integer. Indent by two spaces per level above 1." (if (= level 1) "" - (let ((str " ")) - (dotimes (k (1- level) str) - (setq str (concat "\\emsp" str)))))) + (concat "\\_" (make-string (* 2 (1- level)) ?\s)))) (defun org-clocktable-steps (params) "Step through the range to make a number of clock tables." @@ -2576,26 +2689,28 @@ from the dynamic block definition." (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) (stepskip0 (plist-get p1 :stepskip0)) (block (plist-get p1 :block)) - cc range-text step-time tsb) + cc step-time tsb) (when block (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (cond ((numberp ts) - ;; If ts is a number, it's an absolute day number from org-agenda. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) + ;; If ts is a number, it's an absolute day number from + ;; org-agenda. + (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts))) (setq ts (float-time (encode-time 0 0 0 day month year))))) (ts (setq ts (float-time - (apply 'encode-time (org-parse-time-string ts)))))) + (apply #'encode-time (org-parse-time-string ts nil t)))))) (cond ((numberp te) ;; Likewise for te. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) + (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te))) (setq te (float-time (encode-time 0 0 0 day month year))))) (te (setq te (float-time - (apply 'encode-time (org-parse-time-string te)))))) + (apply #'encode-time (org-parse-time-string te nil t)))))) (setq tsb (if (eq step0 'week) (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) @@ -2635,19 +2750,22 @@ file time (in minutes) as 1st and 2nd elements. The third element of this list will be a list of headline entries. Each entry has the following structure: - (LEVEL HEADLINE TIMESTAMP TIME) - -LEVEL: The level of the headline, as an integer. This will be - the reduced leve, so 1,2,3,... even if only odd levels - are being used. -HEADLINE: The text of the headline. Depending on PARAMS, this may - already be formatted like a link. -TIMESTAMP: If PARAMS require it, this will be a time stamp found in the - entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, - in this sequence. -TIME: The sum of all time spend in this tree, in minutes. This time - will of cause be restricted to the time block and tags match - specified in PARAMS." + (LEVEL HEADLINE TIMESTAMP TIME PROPERTIES) + +LEVEL: The level of the headline, as an integer. This will be + the reduced level, so 1,2,3,... even if only odd levels + are being used. +HEADLINE: The text of the headline. Depending on PARAMS, this may + already be formatted like a link. +TIMESTAMP: If PARAMS require it, this will be a time stamp found in the + entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, + in this sequence. +TIME: The sum of all time spend in this tree, in minutes. This time + will of cause be restricted to the time block and tags match + specified in PARAMS. +PROPERTIES: The list properties specified in the `:properties' parameter + along with their value, as an alist following the pattern + (NAME . VALUE)." (let* ((maxlevel (or (plist-get params :maxlevel) 3)) (timestamp (plist-get params :timestamp)) (ts (plist-get params :tstart)) @@ -2659,14 +2777,14 @@ TIME: The sum of all time spend in this tree, in minutes. This time (tags (plist-get params :tags)) (properties (plist-get params :properties)) (inherit-property-p (plist-get params :inherit-props)) - todo-only - (matcher (if tags (cdr (org-make-tags-matcher tags)))) - cc range-text st p time level hdl props tsp tbl) + (matcher (and tags (cdr (org-make-tags-matcher tags)))) + cc st p tbl) (setq org-clock-file-total-minutes nil) (when block (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + ts (car cc) + te (nth 1 cc))) (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) (when (and ts (listp ts)) @@ -2678,12 +2796,12 @@ TIME: The sum of all time spend in this tree, in minutes. This time (if te (setq te (org-matcher-time te))) (save-excursion (org-clock-sum ts te - (unless (null matcher) - (lambda () - (let* ((tags-list (org-get-tags-at)) - (org-scanner-tags tags-list) - (org-trust-scanner-tags t)) - (eval matcher))))) + (when matcher + `(lambda () + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) + (funcall ,matcher nil tags-list nil))))) (goto-char (point-min)) (setq st t) (while (or (and (bobp) (prog1 st (setq st nil)) @@ -2692,66 +2810,46 @@ TIME: The sum of all time spend in this tree, in minutes. This time (setq p (next-single-property-change (point) :org-clock-minutes))) (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (save-excursion - (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1)))) - (<= level maxlevel)) - (setq hdl (if (not link) - (match-string 2) - (org-make-link-string - (format "file:%s::%s" - (buffer-file-name) - (save-match-data - (match-string 2))) - (org-make-org-heading-search-string - (replace-regexp-in-string - org-bracket-link-regexp - (lambda (m) (or (match-string 3 m) - (match-string 1 m))) - (match-string 2))))) - tsp (when timestamp - (setq props (org-entry-properties (point))) - (or (cdr (assoc "SCHEDULED" props)) - (cdr (assoc "DEADLINE" props)) - (cdr (assoc "TIMESTAMP" props)) - (cdr (assoc "TIMESTAMP_IA" props)))) - props (when properties - (remove nil - (mapcar - (lambda (p) - (when (org-entry-get (point) p inherit-property-p) - (cons p (org-entry-get (point) p inherit-property-p)))) - properties)))) - (when (> time 0) (push (list level hdl tsp time props) tbl)))))) - (setq tbl (nreverse tbl)) - (list file org-clock-file-total-minutes tbl)))) - -(defun org-clock-time% (total &rest strings) - "Compute a time fraction in percent. -TOTAL s a time string like 10:21 specifying the total times. -STRINGS is a list of strings that should be checked for a time. -The first string that does have a time will be used. -This function is made for clock tables." - (let ((re "\\([0-9]+\\):\\([0-9]+\\)") - tot s) - (save-match-data - (catch 'exit - (if (not (string-match re total)) - (throw 'exit 0.) - (setq tot (+ (string-to-number (match-string 2 total)) - (* 60 (string-to-number (match-string 1 total))))) - (if (= tot 0.) (throw 'exit 0.))) - (while (setq s (pop strings)) - (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (throw 'exit - (/ (* 100.0 (+ (string-to-number (match-string 2 s)) - (* 60 (string-to-number - (match-string 1 s))))) - tot)))) - 0)))) + (let ((time (get-text-property p :org-clock-minutes))) + (when (and time (> time 0) (org-at-heading-p)) + (let ((level (org-reduced-level (org-current-level)))) + (when (<= level maxlevel) + (let* ((headline (replace-regexp-in-string + (format "\\`%s[ \t]+" org-comment-string) "" + (nth 4 (org-heading-components)))) + (hdl + (if (not link) headline + (let ((search + (org-make-org-heading-search-string headline))) + (org-make-link-string + (if (not (buffer-file-name)) search + (format "file:%s::%s" (buffer-file-name) search)) + ;; Prune statistics cookies. Replace + ;; links with their description, or + ;; a plain link if there is none. + (org-trim + (org-link-display-format + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + headline))))))) + (tsp + (and timestamp + (let ((p (org-entry-properties (point) 'special))) + (or (cdr (assoc "SCHEDULED" p)) + (cdr (assoc "DEADLINE" p)) + (cdr (assoc "TIMESTAMP" p)) + (cdr (assoc "TIMESTAMP_IA" p)))))) + (props + (and properties + (delq nil + (mapcar + (lambda (p) + (let ((v (org-entry-get + (point) p inherit-property-p))) + (and v (cons p v)))) + properties))))) + (push (list level hdl tsp time props) tbl))))))) + (list file org-clock-file-total-minutes (nreverse tbl))))) ;; Saving and loading the clock @@ -2789,9 +2887,9 @@ Otherwise, return nil." (setq ts (match-string 1) te (match-string 3)) (setq s (- (float-time - (apply 'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te nil t))) (float-time - (apply 'encode-time (org-parse-time-string ts)))) + (apply #'encode-time (org-parse-time-string ts nil t)))) neg (< s 0) s (abs s) h (floor (/ s 3600)) @@ -2809,86 +2907,67 @@ The details of what will be saved are regulated by the variable (or org-clock-loaded org-clock-has-been-used (not (file-exists-p org-clock-persist-file)))) - (let (b) - (with-current-buffer (find-file (expand-file-name org-clock-persist-file)) - (progn - (delete-region (point-min) (point-max)) - ;;Store clock - (insert (format ";; org-persist.el - %s at %s\n" - (system-name) (format-time-string - (cdr org-time-stamp-formats)))) - (if (and (memq org-clock-persist '(t clock)) - (setq b (org-clocking-buffer)) - (setq b (or (buffer-base-buffer b) b)) - (buffer-live-p b) - (buffer-file-name b) - (or (not org-clock-persist-query-save) - (y-or-n-p (concat "Save current clock (" - org-clock-heading ") ")))) - (insert "(setq resume-clock '(\"" - (buffer-file-name (org-clocking-buffer)) - "\" . " (int-to-string (marker-position org-clock-marker)) - "))\n")) - ;; Store clocked task history. Tasks are stored reversed to make - ;; reading simpler - (when (and (memq org-clock-persist '(t history)) - org-clock-history) - (insert - "(setq stored-clock-history '(" - (mapconcat - (lambda (m) - (when (and (setq b (marker-buffer m)) - (setq b (or (buffer-base-buffer b) b)) - (buffer-live-p b) - (buffer-file-name b)) - (concat "(\"" (buffer-file-name b) - "\" . " (int-to-string (marker-position m)) - ")"))) - (reverse org-clock-history) " ") "))\n")) - (save-buffer) - (kill-buffer (current-buffer))))))) + (with-temp-file org-clock-persist-file + (insert (format ";; %s - %s at %s\n" + (file-name-nondirectory org-clock-persist-file) + (system-name) + (format-time-string (org-time-stamp-format t)))) + ;; Store clock to be resumed. + (when (and (memq org-clock-persist '(t clock)) + (let ((b (org-base-buffer (org-clocking-buffer)))) + (and (buffer-live-p b) + (buffer-file-name b) + (or (not org-clock-persist-query-save) + (y-or-n-p (format "Save current clock (%s) " + org-clock-heading)))))) + (insert + (format "(setq org-clock-stored-resume-clock '(%S . %d))\n" + (buffer-file-name (org-base-buffer (org-clocking-buffer))) + (marker-position org-clock-marker)))) + ;; Store clocked task history. Tasks are stored reversed to + ;; make reading simpler. + (when (and (memq org-clock-persist '(t history)) + org-clock-history) + (insert + (format "(setq org-clock-stored-history '(%s))\n" + (mapconcat + (lambda (m) + (let ((b (org-base-buffer (marker-buffer m)))) + (when (and (buffer-live-p b) + (buffer-file-name b)) + (format "(%S . %d)" + (buffer-file-name b) + (marker-position m))))) + (reverse org-clock-history) + " "))))))) (defun org-clock-load () "Load clock-related data from disk, maybe resuming a stored clock." (when (and org-clock-persist (not org-clock-loaded)) - (let ((filename (expand-file-name org-clock-persist-file)) - (org-clock-in-resume 'auto-restart) - resume-clock stored-clock-history) - (if (not (file-readable-p filename)) - (message "Not restoring clock data; %s not found" - org-clock-persist-file) - (message "%s" "Restoring clock data") - (setq org-clock-loaded t) - (load-file filename) - ;; load history - (when stored-clock-history - (save-window-excursion - (mapc (lambda (task) - (if (file-exists-p (car task)) - (org-clock-history-push (cdr task) - (find-file (car task))))) - stored-clock-history))) - ;; resume clock - (when (and resume-clock org-clock-persist - (file-exists-p (car resume-clock)) - (or (not org-clock-persist-query-resume) - (y-or-n-p - (concat - "Resume clock (" - (with-current-buffer (find-file (car resume-clock)) - (save-excursion - (goto-char (cdr resume-clock)) - (org-back-to-heading t) - (and (looking-at org-complex-heading-regexp) - (match-string 4)))) - ") ")))) - (when (file-exists-p (car resume-clock)) - (with-current-buffer (find-file (car resume-clock)) - (goto-char (cdr resume-clock)) - (let ((org-clock-auto-clock-resolution nil)) - (org-clock-in) - (if (outline-invisible-p) - (org-show-context)))))))))) + (if (not (file-readable-p org-clock-persist-file)) + (message "Not restoring clock data; %S not found" org-clock-persist-file) + (message "Restoring clock data") + ;; Load history. + (load-file org-clock-persist-file) + (setq org-clock-loaded t) + (pcase-dolist (`(,(and file (pred file-exists-p)) . ,position) + org-clock-stored-history) + (org-clock-history-push position (find-file-noselect file))) + ;; Resume clock. + (pcase org-clock-stored-resume-clock + (`(,(and file (pred file-exists-p)) . ,position) + (with-current-buffer (find-file-noselect file) + (when (or (not org-clock-persist-query-resume) + (y-or-n-p (format "Resume clock (%s) " + (save-excursion + (goto-char position) + (org-get-heading t t))))) + (goto-char position) + (let ((org-clock-in-resume 'auto-restart) + (org-clock-auto-clock-resolution nil)) + (org-clock-in) + (when (org-invisible-p) (org-show-context)))))) + (_ nil))))) ;; Suggested bindings (org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) diff --git a/lisp/org/org-colview.el b/lisp/org/org-colview.el index a2046af29e..ac8f36ad40 100644 --- a/lisp/org/org-colview.el +++ b/lisp/org/org-colview.el @@ -1,4 +1,4 @@ -;;; org-colview.el --- Column View in Org-mode +;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -28,42 +28,117 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'org) (declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-agenda-do-context-action "org-agenda" ()) (declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) - -(when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory")) - +(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-type "org-element" (element)) + +(defvar org-agenda-columns-add-appointments-to-effort-sum) +(defvar org-agenda-columns-compute-summary-properties) +(defvar org-agenda-columns-show-summaries) +(defvar org-agenda-view-columns-initially) +(defvar org-inlinetask-min-level) + + +;;; Configuration + +(defcustom org-columns-modify-value-for-display-function nil + "Function that modifies values for display in column view. +For example, it can be used to cut out a certain part from a time stamp. +The function must take 2 arguments: + +column-title The title of the column (*not* the property name) +value The value that should be modified. + +The function should return the value that should be displayed, +or nil if the normal value should be used." + :group 'org-properties + :type '(choice (const nil) (function))) + +(defcustom org-columns-summary-types nil + "Alist between operators and summarize functions. + +Each association follows the pattern (LABEL . SUMMARIZE) where + + LABEL is a string used in #+COLUMNS definition describing the + summary type. It can contain any character but \"}\". It is + case-sensitive. + + SUMMARIZE is a function called with two arguments. The first + argument is a non-empty list of values, as non-empty strings. + The second one is a format string or nil. It has to return + a string summarizing the list of values. + +Note that the return value can become one value for an higher +order summary, so the function is expected to handle its own +output. + +Types defined in this variable take precedence over those defined +in `org-columns-summary-types-default', which see." + :group 'org-properties + :version "26.1" + :package-version '(Org . "9.0") + :type '(alist :key-type (string :tag " Label") + :value-type (function :tag "Summarize"))) + + + ;;; Column View (defvar org-columns-overlays nil "Holds the list of current column overlays.") -(defvar org-columns-current-fmt nil +(defvar org-columns--time 0.0 + "Number of seconds since the epoch, as a floating point number.") + +(defvar-local org-columns-current-fmt nil "Local variable, holds the currently active column format.") -(make-variable-buffer-local 'org-columns-current-fmt) -(defvar org-columns-current-fmt-compiled nil + +(defvar-local org-columns-current-fmt-compiled nil "Local variable, holds the currently active column format. This is the compiled version of the format.") -(make-variable-buffer-local 'org-columns-current-fmt-compiled) -(defvar org-columns-current-widths nil - "Loval variable, holds the currently widths of fields.") -(make-variable-buffer-local 'org-columns-current-widths) -(defvar org-columns-current-maxwidths nil - "Loval variable, holds the currently active maximum column widths.") -(make-variable-buffer-local 'org-columns-current-maxwidths) + +(defvar-local org-columns-current-maxwidths nil + "Currently active maximum column widths, as a vector.") + (defvar org-columns-begin-marker (make-marker) "Points to the position where last a column creation command was called.") + (defvar org-columns-top-level-marker (make-marker) "Points to the position where current columns region starts.") (defvar org-columns-map (make-sparse-keymap) "The keymap valid in column display.") +(defconst org-columns-summary-types-default + '(("+" . org-columns--summary-sum) + ("$" . org-columns--summary-currencies) + ("X" . org-columns--summary-checkbox) + ("X/" . org-columns--summary-checkbox-count) + ("X%" . org-columns--summary-checkbox-percent) + ("max" . org-columns--summary-max) + ("mean" . org-columns--summary-mean) + ("min" . org-columns--summary-min) + (":" . org-columns--summary-sum-times) + (":max" . org-columns--summary-max-time) + (":mean" . org-columns--summary-mean-time) + (":min" . org-columns--summary-min-time) + ("@max" . org-columns--summary-max-age) + ("@mean" . org-columns--summary-mean-age) + ("@min" . org-columns--summary-min-age) + ("est+" . org-columns--summary-estimate)) + "Map operators to summarize functions. +See `org-columns-summary-types' for details.") + (defun org-columns-content () "Switch to contents view while in columns view." (interactive) @@ -146,121 +221,181 @@ This is the compiled version of the format.") "--" ["Quit" org-columns-quit t])) -(defun org-columns-new-overlay (beg end &optional string face) +(defun org-columns--displayed-value (spec value) + "Return displayed value for specification SPEC in current entry. +SPEC is a column format specification as stored in +`org-columns-current-fmt-compiled'. VALUE is the real value to +display, as a string." + (or (and (functionp org-columns-modify-value-for-display-function) + (funcall org-columns-modify-value-for-display-function + (nth 1 spec) ;column name + value)) + (pcase spec + (`("ITEM" . ,_) + (concat (make-string (1- (org-current-level)) + (if org-hide-leading-stars ?\s ?*)) + "* " + (org-columns-compact-links value))) + (`(,_ ,_ ,_ ,_ nil) value) + ;; If PRINTF is set, assume we are displaying a number and + ;; obey to the format string. + (`(,_ ,_ ,_ ,_ ,printf) (format printf (string-to-number value))) + (_ (error "Invalid column specification format: %S" spec))))) + +(defun org-columns--collect-values (&optional compiled-fmt) + "Collect values for columns on the current line. + +Return a list of triplets (SPEC VALUE DISPLAYED) suitable for +`org-columns--display-here'. + +This function assumes `org-columns-current-fmt-compiled' is +initialized is set in the current buffer. However, it is +possible to override it with optional argument COMPILED-FMT." + (let ((summaries (get-text-property (point) 'org-summaries))) + (mapcar + (lambda (spec) + (pcase spec + (`(,p . ,_) + (let* ((v (or (cdr (assoc spec summaries)) + (org-entry-get (point) p 'selective t) + (and compiled-fmt ;assume `org-agenda-columns' + ;; Effort property is not defined. Try + ;; to use appointment duration. + org-agenda-columns-add-appointments-to-effort-sum + (string= p (upcase org-effort-property)) + (get-text-property (point) 'duration) + (propertize (org-minutes-to-clocksum-string + (get-text-property (point) 'duration)) + 'face 'org-warning)) + ""))) + (list spec v (org-columns--displayed-value spec v)))))) + (or compiled-fmt org-columns-current-fmt-compiled)))) + +(defun org-columns--set-widths (cache) + "Compute the maximum column widths from the format and CACHE. +This function sets `org-columns-current-maxwidths' as a vector of +integers greater than 0." + (setq org-columns-current-maxwidths + (apply #'vector + (mapcar + (lambda (spec) + (pcase spec + (`(,_ ,_ ,(and width (pred wholenump)) . ,_) width) + (`(,_ ,name . ,_) + ;; No width is specified in the columns format. + ;; Compute it by checking all possible values for + ;; PROPERTY. + (let ((width (length name))) + (dolist (entry cache width) + (let ((value (nth 2 (assoc spec (cdr entry))))) + (setq width (max (length value) width)))))))) + org-columns-current-fmt-compiled)))) + +(defun org-columns--new-overlay (beg end &optional string face) "Create a new column overlay and add it to the list." (let ((ov (make-overlay beg end))) (overlay-put ov 'face (or face 'secondary-selection)) - (remove-text-properties 0 (length string) '(face nil) string) (org-overlay-display ov string face) (push ov org-columns-overlays) ov)) -(defun org-columns-display-here (&optional props dateline) - "Overlay the current line with column display." - (interactive) - (let* ((fmt org-columns-current-fmt-compiled) - (beg (point-at-bol)) - (level-face (save-excursion - (beginning-of-line 1) - (and (looking-at "\\(\\**\\)\\(\\* \\)") - (org-get-level-face 2)))) - (ref-face (or level-face - (and (eq major-mode 'org-agenda-mode) - (get-text-property (point-at-bol) 'face)) - 'default)) - (color (list :foreground (face-attribute ref-face :foreground))) - (font (list :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (face (list color font 'org-column ref-face)) - (face1 (list color font 'org-agenda-column-dateline ref-face)) - (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) - pom property ass width f fc string fm ov column val modval s2 title calc) - ;; Check if the entry is in another buffer. - (unless props - (if (eq major-mode 'org-agenda-mode) - (setq pom (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)) - props (if pom (org-entry-properties pom) nil)) - (setq props (org-entry-properties nil)))) - ;; Walk the format - (while (setq column (pop fmt)) - (setq property (car column) - title (nth 1 column) - ass (if (equal property "ITEM") - (cons "ITEM" - ;; When in a buffer, get the whole line, - ;; we'll clean it later… - (if (derived-mode-p 'org-mode) - (save-match-data - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))) - ;; In agenda, just get the `txt' property - (or (org-get-at-bol 'txt) - (buffer-substring-no-properties - (point) (progn (end-of-line) (point)))))) - (assoc property props)) - width (or (cdr (assoc property org-columns-current-maxwidths)) - (nth 2 column) - (length property)) - f (format "%%-%d.%ds | " width width) - fm (nth 4 column) - fc (nth 5 column) - calc (nth 7 column) - val (or (cdr ass) "") - modval (cond ((and org-columns-modify-value-for-display-function - (functionp - org-columns-modify-value-for-display-function)) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") - (org-columns-cleanup-item - val org-columns-current-fmt-compiled - (or org-complex-heading-regexp cphr))) - (fc (org-columns-number-to-string - (org-columns-string-to-number val fm) fm fc)) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number - val fm)) fm)))) - (setq s2 (org-columns-add-ellipses (or modval val) width)) - (setq string (format f s2)) - ;; Create the overlay +(defun org-columns--summarize (operator) + "Return summary function associated to string OPERATOR." + (if (not operator) nil + (cdr (or (assoc operator org-columns-summary-types) + (assoc operator org-columns-summary-types-default) + (error "Unknown %S operator" operator))))) + +(defun org-columns--overlay-text (value fmt width property original) + "Return text " + (format fmt + (let ((v (org-columns-add-ellipses value width))) + (pcase property + ("PRIORITY" + (propertize v 'face (org-get-priority-face original))) + ("TAGS" + (if (not org-tags-special-faces-re) + (propertize v 'face 'org-tag) + (replace-regexp-in-string + org-tags-special-faces-re + (lambda (m) (propertize m 'face (org-get-tag-face m))) + v nil nil 1))) + ("TODO" (propertize v 'face (org-get-todo-face original))) + (_ v))))) + +(defun org-columns--display-here (columns &optional dateline) + "Overlay the current line with column display. +COLUMNS is an alist (SPEC VALUE DISPLAYED). Optional argument +DATELINE is non-nil when the face used should be +`org-agenda-column-dateline'." + (save-excursion + (beginning-of-line) + (let* ((level-face (and (looking-at "\\(\\**\\)\\(\\* \\)") + (org-get-level-face 2))) + (ref-face (or level-face + (and (eq major-mode 'org-agenda-mode) + (org-get-at-bol 'face)) + 'default)) + (color (list :foreground (face-attribute ref-face :foreground))) + (font (list :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (face (list color font 'org-column ref-face)) + (face1 (list color font 'org-agenda-column-dateline ref-face))) + ;; Each column is an overlay on top of a character. So there has + ;; to be at least as many characters available on the line as + ;; columns to display. + (let ((columns (length org-columns-current-fmt-compiled)) + (chars (- (line-end-position) (line-beginning-position)))) + (when (> columns chars) + (save-excursion + (end-of-line) + (let ((inhibit-read-only t)) + (insert (make-string (- columns chars) ?\s)))))) + ;; Display columns. Create and install the overlay for the + ;; current column on the next character. + (let ((i 0) + (last (1- (length columns)))) + (dolist (column columns) + (pcase column + (`(,spec ,original ,value) + (let* ((property (car spec)) + (width (aref org-columns-current-maxwidths i)) + (fmt (format (if (= i last) "%%-%d.%ds |" + "%%-%d.%ds | ") + width width)) + (ov (org-columns--new-overlay + (point) (1+ (point)) + (org-columns--overlay-text + value fmt width property original) + (if dateline face1 face)))) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value original) + (overlay-put ov 'org-columns-value-modified value) + (overlay-put ov 'org-columns-format fmt) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (forward-char)))) + (cl-incf i))) + ;; Make the rest of the line disappear. + (let ((ov (org-columns--new-overlay (point) (line-end-position)))) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) + (let ((ov (make-overlay (1- (line-end-position)) + (line-beginning-position 2)))) + (overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays)) (org-with-silent-modifications - (setq ov (org-columns-new-overlay - beg (setq beg (1+ beg)) string (if dateline face1 face))) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "")) - (if (or (not (char-after beg)) - (equal (char-after beg) ?\n)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'intangible t) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) - (min (point-max) (1+ (point-at-eol))) - 'read-only "Type `e' to edit property"))))) + (let ((inhibit-read-only t)) + (put-text-property + (line-end-position 0) + (line-beginning-position 2) + 'read-only + (substitute-command-keys + "Type \\`\\[org-columns-edit-value]' \ +to edit property"))))))) (defun org-columns-add-ellipses (string width) "Truncate STRING with WIDTH characters, with ellipses." @@ -285,34 +420,27 @@ for the duration of the command.") (defvar header-line-format) (defvar org-columns-previous-hscroll 0) -(defun org-columns-display-here-title () +(defun org-columns--display-here-title () "Overlay the newline before the current line with the table title." (interactive) - (let ((fmt org-columns-current-fmt-compiled) - string (title "") - property width f column str widths) - (while (setq column (pop fmt)) - (setq property (car column) - str (or (nth 1 column) property) - width (or (cdr (assoc property org-columns-current-maxwidths)) - (nth 2 column) - (length str)) - widths (push width widths) - f (format "%%-%d.%ds | " width width) - string (format f str) - title (concat title string))) - (setq title (concat - (org-add-props " " nil 'display '(space :align-to 0)) - ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default)))) - (org-add-props title nil 'face 'org-column-title))) - (org-set-local 'org-previous-header-line-format header-line-format) - (org-set-local 'org-columns-current-widths (nreverse widths)) - (setq org-columns-full-header-line-format title) + (let ((title "") + (i 0)) + (dolist (column org-columns-current-fmt-compiled) + (pcase column + (`(,property ,name . ,_) + (let* ((width (aref org-columns-current-maxwidths i)) + (fmt (format "%%-%d.%ds | " width width))) + (setq title (concat title (format fmt (or name property))))))) + (cl-incf i)) + (setq-local org-previous-header-line-format header-line-format) + (setq org-columns-full-header-line-format + (concat + (org-add-props " " nil 'display '(space :align-to 0)) + (org-add-props (substring title 0 -1) nil 'face 'org-column-title))) (setq org-columns-previous-hscroll -1) - ; (org-columns-hscoll-title) - (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) + (add-hook 'post-command-hook 'org-columns-hscroll-title nil 'local))) -(defun org-columns-hscoll-title () +(defun org-columns-hscroll-title () "Set the `header-line-format' so that it scrolls along with the table." (sit-for .0001) ; need to force a redisplay to update window-hscroll (when (not (= (window-hscroll) org-columns-previous-hscroll)) @@ -335,7 +463,7 @@ for the duration of the command.") (when (local-variable-p 'org-previous-header-line-format) (setq header-line-format org-previous-header-line-format) (kill-local-variable 'org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) + (remove-hook 'post-command-hook 'org-columns-hscroll-title 'local)) (move-marker org-columns-begin-marker nil) (move-marker org-columns-top-level-marker nil) (org-with-silent-modifications @@ -348,29 +476,6 @@ for the duration of the command.") (when (local-variable-p 'org-colview-initial-truncate-line-value) (setq truncate-lines org-colview-initial-truncate-line-value))))) -(defun org-columns-cleanup-item (item fmt cphr) - "Remove from ITEM what is a column in the format FMT. -CPHR is the complex heading regexp to use for parsing ITEM." - (let (fixitem) - (if (not cphr) - item - (unless (string-match "^\\*+ " item) - (setq item (concat "* " item) fixitem t)) - (if (string-match cphr item) - (setq item - (concat - (org-add-props (match-string 1 item) nil - 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) - (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item))) - (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item))) - " " (save-match-data (org-columns-compact-links (or (match-string 4 item) ""))) - (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item))))) - (add-text-properties - 0 (1+ (match-end 1)) - (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) - item)) - (if fixitem (replace-regexp-in-string "^\\*+ " "" item) item)))) - (defun org-columns-compact-links (s) "Replace [[link][desc]] with [desc] or [link]." (while (string-match org-bracket-link-regexp s) @@ -394,25 +499,26 @@ CPHR is the complex heading regexp to use for parsing ITEM." (org-columns-remove-overlays) (let ((inhibit-read-only t)) (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when (eq major-mode 'org-agenda-mode) + (if (not (eq major-mode 'org-agenda-mode)) + (setq org-columns-current-fmt nil) (setq org-agenda-columns-active nil) (message "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) (defun org-columns-check-computed () - "Check if this column value is computed. -If yes, throw an error indicating that changing it does not make sense." - (let ((val (get-char-property (point) 'org-columns-value))) - (when (and (stringp val) - (get-char-property 0 'org-computed val)) - (error "This value is computed from the entry's children")))) - -(defun org-columns-todo (&optional arg) + "Throw an error if current column value is computed." + (let ((spec (nth (current-column) org-columns-current-fmt-compiled))) + (and + (nth 3 spec) + (assoc spec (get-text-property (line-beginning-position) 'org-summaries)) + (error "This value is computed from the entry's children")))) + +(defun org-columns-todo (&optional _arg) "Change the TODO state during column view." (interactive "P") (org-columns-edit-value "TODO")) -(defun org-columns-set-tags-or-toggle (&optional arg) +(defun org-columns-set-tags-or-toggle (&optional _arg) "Toggle checkbox at point, or set tags for current headline." (interactive "P") (if (string-match "\\`\\[[ xX-]\\]\\'" @@ -430,107 +536,76 @@ Where possible, use the standard interface for changing this line." (interactive) (org-columns-check-computed) (let* ((col (current-column)) + (bol (line-beginning-position)) + (eol (line-end-position)) + (pom (or (get-text-property bol 'org-hd-marker) (point))) (key (or key (get-char-property (point) 'org-columns-key))) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (org-columns-time (time-to-number-of-days (current-time))) - nval eval allowed) + (org-columns--time (float-time (current-time))) + (action + (pcase key + ("CLOCKSUM" + (error "This special column cannot be edited")) + ("ITEM" + (lambda () (org-with-point-at pom (org-edit-headline)))) + ("TODO" + (lambda () + (org-with-point-at pom (call-interactively #'org-todo)))) + ("PRIORITY" + (lambda () + (org-with-point-at pom + (call-interactively #'org-priority)))) + ("TAGS" + (lambda () + (org-with-point-at pom + (let ((org-fast-tag-selection-single-key + (if (eq org-fast-tag-selection-single-key 'expert) + t + org-fast-tag-selection-single-key))) + (call-interactively #'org-set-tags))))) + ("DEADLINE" + (lambda () + (org-with-point-at pom (call-interactively #'org-deadline)))) + ("SCHEDULED" + (lambda () + (org-with-point-at pom (call-interactively #'org-schedule)))) + ("BEAMER_ENV" + (lambda () + (org-with-point-at pom + (call-interactively #'org-beamer-select-environment)))) + (_ + (let* ((allowed (org-property-get-allowed-values pom key 'table)) + (value (get-char-property (point) 'org-columns-value)) + (nval (org-trim + (if (null allowed) (read-string "Edit: " value) + (completing-read + "Value: " allowed nil + (not (get-text-property + 0 'org-unrestricted (caar allowed)))))))) + (and (not (equal nval value)) + (lambda () (org-entry-put pom key nval)))))))) (cond - ((equal key "CLOCKSUM") - (error "This special column cannot be edited")) - ((equal key "ITEM") - (setq eval '(org-with-point-at pom - (org-edit-headline)))) - ((equal key "TODO") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) - ((equal key "PRIORITY") - (setq eval '(org-with-point-at pom - (call-interactively 'org-priority)))) - ((equal key "TAGS") - (setq eval '(org-with-point-at pom - (let ((org-fast-tag-selection-single-key - (if (eq org-fast-tag-selection-single-key 'expert) - t org-fast-tag-selection-single-key))) - (call-interactively 'org-set-tags))))) - ((equal key "DEADLINE") - (setq eval '(org-with-point-at pom - (call-interactively 'org-deadline)))) - ((equal key "SCHEDULED") - (setq eval '(org-with-point-at pom - (call-interactively 'org-schedule)))) - ((equal key "BEAMER_env") - (setq eval '(org-with-point-at pom - (call-interactively 'org-beamer-select-environment)))) + ((null action)) + ((eq major-mode 'org-agenda-mode) + (org-columns--call action) + ;; The following let preserves the current format, and makes + ;; sure that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) (t - (setq allowed (org-property-get-allowed-values pom key 'table)) - (if allowed - (setq nval (org-icompleting-read - "Value: " allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed))))) - (setq nval (read-string "Edit: " value))) - (setq nval (org-trim nval)) - (when (not (equal nval value)) - (setq eval '(org-entry-put pom key nval))))) - (when eval - - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval eval) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (org-with-silent-modifications - (remove-text-properties - (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here))) - (org-move-to-column col) - (if (and (derived-mode-p 'org-mode) - (nth 3 (assoc key org-columns-current-fmt-compiled))) - (org-columns-update key))))))) - -(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? - "Edit the current headline, the part without TODO keyword, TAGS." - (org-back-to-heading) - (when (looking-at org-todo-line-regexp) - (let ((pos (point)) - (pre (buffer-substring (match-beginning 0) (match-beginning 3))) - (txt (match-string 3)) - (post "") - txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) - (setq post (match-string 0 txt) - txt (substring txt 0 (match-beginning 0)))) - (setq txt2 (read-string "Edit: " txt)) - (when (not (equal txt txt2)) - (goto-char pos) - (insert pre txt2 post) - (delete-region (point) (point-at-eol)) - (org-set-tags nil t))))) + (let ((inhibit-read-only t)) + (org-with-silent-modifications + (remove-text-properties (max (point-min) (1- bol)) eol '(read-only t))) + (org-columns--call action)) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column col))))) (defun org-columns-edit-allowed () "Edit the list of allowed values for the current property." @@ -553,15 +628,15 @@ Where possible, use the standard interface for changing this line." (t pom)) key1 nval))) -(defun org-columns-eval (form) - (let (hidep) - (save-excursion - (beginning-of-line 1) - ;; `next-line' is needed here, because it skips invisible line. - (condition-case nil (org-no-warnings (next-line 1)) (error nil)) - (setq hidep (org-at-heading-p 1))) - (eval form) - (and hidep (hide-entry)))) +(defun org-columns--call (fun) + "Call function FUN while preserving heading visibility. +FUN is a function called with no argument." + (let ((hide-body (and (/= (line-end-position) (point-max)) + (save-excursion + (move-beginning-of-line 2) + (org-at-heading-p t))))) + (unwind-protect (funcall fun) + (when hide-body (outline-hide-entry))))) (defun org-columns-previous-allowed-value () "Switch to the previous allowed value for this column." @@ -574,72 +649,57 @@ When PREVIOUS is set, go to the previous value. When NTH is an integer, select that value." (interactive) (org-columns-check-computed) - (let* ((col (current-column)) + (let* ((column (current-column)) (key (get-char-property (point) 'org-columns-key)) (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (allowed (or (org-property-get-allowed-values pom key) - (and (memq - (nth 4 (assoc key org-columns-current-fmt-compiled)) - '(checkbox checkbox-n-of-m checkbox-percent)) - '("[ ]" "[X]")) - (org-colview-construct-allowed-dates value))) - nval) - (when (integerp nth) - (setq nth (1- nth)) - (if (= nth -1) (setq nth 9))) - (when (equal key "ITEM") - (error "Cannot edit item headline from here")) + (pom (or (get-text-property (line-beginning-position) 'org-hd-marker) + (point))) + (allowed + (let ((all + (or (org-property-get-allowed-values pom key) + (pcase (nth column org-columns-current-fmt-compiled) + (`(,_ ,_ ,_ ,(or "X" "X/" "X%") ,_) '("[ ]" "[X]"))) + (org-colview-construct-allowed-dates value)))) + (if previous (reverse all) all)))) + (when (equal key "ITEM") (error "Cannot edit item headline from here")) (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) - (setq nval (if previous 'earlier 'later)) - (if previous (setq allowed (reverse allowed))) + (let* ((l (length allowed)) + (new + (cond + ((member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) + (if previous 'earlier 'later)) + ((integerp nth) + (when (> (abs nth) l) + (user-error "Only %d allowed values for property `%s'" l key)) + (nth (mod (1- nth) l) allowed)) + ((member value allowed) + (when (= l 1) (error "Only one allowed value for this property")) + (or (nth 1 (member value allowed)) (car allowed))) + (t (car allowed)))) + (action (lambda () (org-entry-put pom key new)))) (cond - (nth - (setq nval (nth nth allowed)) - (if (not nval) - (error "There are only %d allowed values for property `%s'" - (length allowed) key))) - ((member value allowed) - (setq nval (or (car (cdr (member value allowed))) - (car allowed))) - (if (equal nval value) - (error "Only one allowed value for this property"))) - (t (setq nval (car allowed))))) - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval '(org-entry-put pom key nval)) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (remove-text-properties (1- bol) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval '(org-entry-put pom key nval))) - (org-columns-display-here))) - (org-move-to-column col) - (and (nth 3 (assoc key org-columns-current-fmt-compiled)) - (org-columns-update key)))))) + ((eq major-mode 'org-agenda-mode) + (org-columns--call action) + ;; The following let preserves the current format, and makes + ;; sure that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (remove-text-properties (line-end-position 0) (line-end-position) + '(read-only t)) + (org-columns--call action)) + ;; Some properties can modify headline (e.g., "TODO"), and + ;; possible shuffle overlays. Make sure they are still all at + ;; the right place on the current line. + (let ((org-columns-inhibit-recalculation)) (org-columns-redo)) + (org-columns-update key) + (org-move-to-column column)))))) (defun org-colview-construct-allowed-dates (s) "Construct a list of three dates around the date in S. @@ -662,13 +722,6 @@ around it." (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x))) (list time-before time time-after))))) -(defun org-verify-version (task) - (cond - ((eq task 'columns) - (if (or (featurep 'xemacs) - (< emacs-major-version 22)) - (error "Emacs 22 is required for the columns feature"))))) - (defun org-columns-open-link (&optional arg) (interactive "P") (let ((value (get-char-property (point) 'org-columns-value))) @@ -681,179 +734,165 @@ around it." fmt)) (defun org-columns-get-format (&optional fmt-string) + "Return columns format specifications. +When optional argument FMT-STRING is non-nil, use it as the +current specifications. This function also sets +`org-columns-current-fmt-compiled' and +`org-columns-current-fmt'." (interactive) - (let (fmt-as-property fmt) - (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - fmt)) + (let ((format + (or fmt-string + (org-entry-get nil "COLUMNS" t) + (org-with-wide-buffer + (goto-char (point-min)) + (catch :found + (let ((case-fold-search t)) + (while (re-search-forward "^[ \t]*#\\+COLUMNS: .+$" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (throw :found (org-element-property :value element))))) + nil))) + org-columns-default-format))) + (setq org-columns-current-fmt format) + (org-columns-compile-format format) + format)) (defun org-columns-goto-top-level () - (when (condition-case nil (org-back-to-heading) (error nil)) - (org-entry-get nil "COLUMNS" t)) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point)))) + "Move to the beginning of the column view area. +Also sets `org-columns-top-level-marker' to the new position." + (goto-char + (move-marker + org-columns-top-level-marker + (cond ((org-before-first-heading-p) (point-min)) + ((org-entry-get nil "COLUMNS" t) org-entry-property-inherited-from) + (t (org-back-to-heading) (point)))))) ;;;###autoload -(defun org-columns (&optional columns-fmt-string) - "Turn on column view on an org-mode file. +(defun org-columns (&optional global columns-fmt-string) + "Turn on column view on an Org mode file. + +Column view applies to the whole buffer if point is before the +first headline. Otherwise, it applies to the first ancestor +setting \"COLUMNS\" property. If there is none, it defaults to +the current headline. With a `\\[universal-argument]' prefix \ +argument, turn on column +view for the whole buffer unconditionally. + When COLUMNS-FMT-STRING is non-nil, use it as the column format." - (interactive) - (org-verify-version 'columns) + (interactive "P") (org-columns-remove-overlays) + (when global (goto-char (point-min))) (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - beg end fmt cache maxwidths) - (org-columns-goto-top-level) - (setq fmt (org-columns-get-format columns-fmt-string)) + (org-columns-goto-top-level) + ;; Initialize `org-columns-current-fmt' and + ;; `org-columns-current-fmt-compiled'. + (let ((org-columns--time (float-time (current-time)))) + (org-columns-get-format columns-fmt-string) + (unless org-columns-inhibit-recalculation (org-columns-compute-all)) (save-excursion - (goto-char org-columns-top-level-marker) - (setq beg (point)) - (unless org-columns-inhibit-recalculation - (org-columns-compute-all)) - (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) - (point-max))) - ;; Get and cache the properties - (goto-char beg) - (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (org-clock-sum)))) - (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (org-clock-sum-today)))) - (while (re-search-forward org-outline-regexp-bol end t) - (if (and org-columns-skip-archived-trees - (looking-at (concat ".*:" org-archive-tag ":"))) - (org-end-of-subtree t) - (push (cons (org-current-line) (org-entry-properties)) cache))) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) - (flyspell-mode 0)) - (unless (local-variable-p 'org-colview-initial-truncate-line-value) - (org-set-local 'org-colview-initial-truncate-line-value - truncate-lines)) - (setq truncate-lines t) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache))))) - -(eval-when-compile (defvar org-columns-time)) - -(defvar org-columns-compile-map - '(("none" none +) - (":" add_times +) - ("+" add_numbers +) - ("$" currency +) - ("X" checkbox +) - ("X/" checkbox-n-of-m +) - ("X%" checkbox-percent +) - ("max" max_numbers max) - ("min" min_numbers min) - ("mean" mean_numbers - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - (":max" max_times max) - (":min" min_times min) - (":mean" mean_times - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("@min" min_age min (lambda (x) (- org-columns-time x))) - ("@max" max_age max (lambda (x) (- org-columns-time x))) - ("@mean" mean_age - (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x))) - ("est+" estimate org-estimate-combine)) - "Operator <-> format,function,calc map. -Used to compile/uncompile columns format and completing read in -interactive function `org-columns-new'. - -operator string used in #+COLUMNS definition describing the - summary type -format symbol describing summary type selected interactively in - `org-columns-new' and internally in - `org-columns-number-to-string' and - `org-columns-string-to-number' -function called with a list of values as argument to calculate - the summary value -calc function called on every element before summarizing. This is - optional and should only be specified if needed") - -(defun org-columns-new (&optional prop title width op fmt fun &rest rest) - "Insert a new column, to the left of the current column." + (save-restriction + (when (and (not global) (org-at-heading-p)) + (narrow-to-region (point) (org-end-of-subtree t t))) + (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) + (org-clock-sum)) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (org-clock-sum-today)) + (let ((cache + ;; Collect contents of columns ahead of time so as to + ;; compute their maximum width. + (org-map-entries + (lambda () (cons (point) (org-columns--collect-values))) + nil nil (and org-columns-skip-archived-trees 'archive)))) + (when cache + (org-columns--set-widths cache) + (org-columns--display-here-title) + (when (setq-local org-columns-flyspell-was-active + (bound-and-true-p flyspell-mode)) + (flyspell-mode 0)) + (unless (local-variable-p 'org-colview-initial-truncate-line-value) + (setq-local org-colview-initial-truncate-line-value + truncate-lines)) + (setq truncate-lines t) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry))))))))) + +(defun org-columns-new (&optional spec &rest attributes) + "Insert a new column, to the left of the current column. +Interactively fill attributes for new column. When column format +specification SPEC is provided, edit it instead. + +When optional argument attributes can be a list of columns +specifications attributes to create the new column +non-interactively. See `org-columns-compile-format' for +details." (interactive) - (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) - cell) - (setq prop (org-icompleting-read - "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) - nil nil prop)) - (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) - (setq width (read-string "Column width: " (if width (number-to-string width)))) - (if (string-match "\\S-" width) - (setq width (string-to-number width)) - (setq width nil)) - (setq fmt (org-icompleting-read - "Summary [none]: " - (mapcar (lambda (x) (list (symbol-name (cadr x)))) - org-columns-compile-map) - nil t)) - (setq fmt (intern fmt) - fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) - (if (eq fmt 'none) (setq fmt nil)) - (if editp - (progn - (setcar editp prop) - (setcdr editp (list title width nil fmt nil fun))) - (setq cell (nthcdr (1- (current-column)) - org-columns-current-fmt-compiled)) - (setcdr cell (cons (list prop title width nil fmt nil - (car fun) (cadr fun)) - (cdr cell)))) + (let ((new (or attributes + (let ((prop + (completing-read + "Property: " + (mapcar #'list (org-buffer-property-keys t nil t)) + nil nil (nth 0 spec)))) + (list prop + (read-string (format "Column title [%s]: " prop) + (nth 1 spec)) + ;; Use `read-string' instead of `read-number' + ;; to allow empty width. + (let ((w (read-string + "Column width: " + (and (nth 2 spec) + (number-to-string (nth 2 spec)))))) + (and (org-string-nw-p w) (string-to-number w))) + (org-string-nw-p + (completing-read + "Summary: " + (delete-dups + (cons '("") ;Allow empty operator. + (mapcar (lambda (x) (list (car x))) + (append + org-columns-summary-types + org-columns-summary-types-default)))) + nil t (nth 3 spec))) + (org-string-nw-p + (read-string "Format: " (nth 4 spec)))))))) + (if spec + (progn (setcar spec (car new)) + (setcdr spec (cdr new))) + (push new (nthcdr (current-column) org-columns-current-fmt-compiled))) (org-columns-store-format) (org-columns-redo))) (defun org-columns-delete () "Delete the column at point from columns view." (interactive) - (let* ((n (current-column)) - (title (nth 1 (nth n org-columns-current-fmt-compiled)))) - (when (y-or-n-p - (format "Are you sure you want to remove column \"%s\"? " title)) + (let ((spec (nth (current-column) org-columns-current-fmt-compiled))) + (when (y-or-n-p (format "Are you sure you want to remove column %S? " + (nth 1 spec))) (setq org-columns-current-fmt-compiled - (delq (nth n org-columns-current-fmt-compiled) - org-columns-current-fmt-compiled)) + (delq spec org-columns-current-fmt-compiled)) (org-columns-store-format) - (org-columns-redo) - (if (>= (current-column) (length org-columns-current-fmt-compiled)) - (backward-char 1))))) + ;; This may leave a now wrong value in a node property. However + ;; updating it may prove counter-intuitive. See comments in + ;; `org-columns-move-right' for details. + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)) + (when (>= (current-column) (length org-columns-current-fmt-compiled)) + (backward-char))))) (defun org-columns-edit-attributes () "Edit the attributes of the current column." (interactive) - (let* ((n (current-column)) - (info (nth n org-columns-current-fmt-compiled))) - (apply 'org-columns-new info))) + (org-columns-new (nth (current-column) org-columns-current-fmt-compiled))) (defun org-columns-widen (arg) "Make the column wider by ARG characters." (interactive "p") (let* ((n (current-column)) (entry (nth n org-columns-current-fmt-compiled)) - (width (or (nth 2 entry) - (cdr (assoc (car entry) org-columns-current-maxwidths))))) + (width (aref org-columns-current-maxwidths n))) (setq width (max 1 (+ width arg))) (setcar (nthcdr 2 entry) width) (org-columns-store-format) - (org-columns-redo))) + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)))) (defun org-columns-narrow (arg) "Make the column narrower by ARG characters." @@ -872,7 +911,16 @@ calc function called on every element before summarizing. This is (setcar cell (car (cdr cell))) (setcdr cell (cons e (cdr (cdr cell)))) (org-columns-store-format) - (org-columns-redo) + ;; Do not compute again properties, since we're just moving + ;; columns around. It can put a property value a bit off when + ;; switching between an non-computed and a computed value for the + ;; same property, e.g. from "%A %A{+}" to "%A{+} %A". + ;; + ;; In this case, the value needs to be updated since the first + ;; column related to a property determines how its value is + ;; computed. However, (correctly) updating the value could be + ;; surprising, so we leave it as-is nonetheless. + (let ((org-columns-inhibit-recalculation t)) (org-columns-redo)) (forward-char 1))) (defun org-columns-move-left () @@ -886,358 +934,455 @@ calc function called on every element before summarizing. This is (backward-char 1))) (defun org-columns-store-format () - "Store the text version of the current columns format in appropriate place. -This is either in the COLUMNS property of the node starting the current column -display, or in the #+COLUMNS line of the current buffer." - (let (fmt (cnt 0)) - (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) - (org-set-local 'org-columns-current-fmt fmt) - (if (marker-position org-columns-top-level-marker) - (save-excursion - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) - (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - ;; Overwrite all #+COLUMNS lines.... - (while (re-search-forward "^#\\+COLUMNS:.*" nil t) - (setq cnt (1+ cnt)) - (replace-match (concat "#+COLUMNS: " fmt) t t)) - (unless (> cnt 0) - (goto-char (point-min)) - (or (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n"))) - (org-set-local 'org-columns-default-format fmt)))))) - -(defun org-columns-get-autowidth-alist (s cache) - "Derive the maximum column widths from the format and the cache." - (let ((start 0) rtn) - (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) - (push (cons (match-string 1 s) 1) rtn) - (setq start (match-end 0))) - (mapc (lambda (x) - (setcdr x (apply 'max - (mapcar - (lambda (y) - (length (or (cdr (assoc (car x) (cdr y))) " "))) - cache)))) - rtn) - rtn)) - -(defun org-columns-compute-all () - "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (let ((columns org-columns-current-fmt-compiled) - (org-columns-time (time-to-number-of-days (current-time))) - col) - (while (setq col (pop columns)) - (when (nth 3 col) - (save-excursion - (org-columns-compute (car col))))))) + "Store the text version of the current columns format. +The format is stored either in the COLUMNS property of the node +starting the current column display, or in a #+COLUMNS line of +the current buffer." + (let ((fmt (org-columns-uncompile-format org-columns-current-fmt-compiled))) + (setq-local org-columns-current-fmt fmt) + (when (marker-position org-columns-top-level-marker) + (org-with-wide-buffer + (goto-char org-columns-top-level-marker) + (if (and (org-at-heading-p) (org-entry-get nil "COLUMNS")) + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + (let ((case-fold-search t)) + ;; Try to replace the first COLUMNS keyword available. + (catch :found + (while (re-search-forward "^[ \t]*#\\+COLUMNS:\\(.*\\)" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (and (eq (org-element-type element) 'keyword) + (equal (org-element-property :key element) + "COLUMNS")) + (replace-match (concat " " fmt) t t nil 1) + (throw :found nil)))) + ;; No COLUMNS keyword in the buffer. Insert one at the + ;; beginning, right before the first heading, if any. + (goto-char (point-min)) + (unless (org-at-heading-p t) (outline-next-heading)) + (let ((inhibit-read-only t)) + (insert-before-markers "#+COLUMNS: " fmt "\n")))) + (setq-local org-columns-default-format fmt)))))) (defun org-columns-update (property) "Recompute PROPERTY, and update the columns display for it." (org-columns-compute property) - (let (fmt val pos) - (save-excursion - (mapc (lambda (ov) - (when (equal (overlay-get ov 'org-columns-key) property) - (setq pos (overlay-start ov)) - (goto-char pos) - (when (setq val (cdr (assoc property - (get-text-property - (point-at-bol) 'org-summaries)))) - (setq fmt (overlay-get ov 'org-columns-format)) - (overlay-put ov 'org-columns-value val) - (overlay-put ov 'display (format fmt val))))) - org-columns-overlays)))) - -(defvar org-inlinetask-min-level - (if (featurep 'org-inlinetask) org-inlinetask-min-level 15)) - -;;;###autoload -(defun org-columns-compute (property) - "Sum the values of property PROPERTY hierarchically, for the entire buffer." - (interactive) - (let* ((re org-outline-regexp-bol) - (lmax 30) ; Does anyone use deeper levels??? - (lvals (make-vector lmax nil)) - (lflag (make-vector lmax nil)) - (level 0) - (ass (assoc property org-columns-current-fmt-compiled)) - (format (nth 4 ass)) - (printf (nth 5 ass)) - (fun (nth 6 ass)) - (calc (or (nth 7 ass) 'identity)) - (beg org-columns-top-level-marker) - (inminlevel org-inlinetask-min-level) - (last-level org-inlinetask-min-level) - val valflag flag end sumpos sum-alist sum str str1 useval) - (save-excursion - ;; Find the region to compute - (goto-char beg) - (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) - (goto-char end) - ;; Walk the tree from the back and do the computations - (while (re-search-backward re beg t) - (setq sumpos (match-beginning 0) - last-level (if (not (or (zerop level) (eq level inminlevel))) - level last-level) - level (org-outline-level) - val (org-entry-get nil property) - valflag (and val (string-match "\\S-" val))) - (cond - ((< level last-level) - ;; put the sum of lower levels here as a property - (setq sum (+ (if (and (/= last-level inminlevel) - (aref lvals last-level)) - (apply fun (aref lvals last-level)) 0) - (if (aref lvals inminlevel) - (apply fun (aref lvals inminlevel)) 0)) - flag (or (aref lflag last-level) ; any valid entries from children? - (aref lflag inminlevel)) ; or inline tasks? - str (org-columns-number-to-string sum format printf) - str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) - useval (if flag str1 (if valflag val "")) - sum-alist (get-text-property sumpos 'org-summaries)) - (if (assoc property sum-alist) - (setcdr (assoc property sum-alist) useval) - (push (cons property useval) sum-alist) - (org-with-silent-modifications - (add-text-properties sumpos (1+ sumpos) - (list 'org-summaries sum-alist)))) - (when (and val (not (equal val (if flag str val)))) - (org-entry-put nil property (if flag str val))) - ;; add current to current level accumulator - (when (or flag valflag) - (push (if flag - sum - (funcall calc (org-columns-string-to-number - (if flag str val) format))) - (aref lvals level)) - (aset lflag level t)) - ;; clear accumulators for deeper levels - (loop for l from (1+ level) to (1- lmax) do - (aset lvals l nil) - (aset lflag l nil))) - ((>= level last-level) - ;; add what we have here to the accumulator for this level - (when valflag - (push (funcall calc (org-columns-string-to-number val format)) - (aref lvals level)) - (aset lflag level t))) - (t (error "This should not happen"))))))) + (org-with-wide-buffer + (let ((p (upcase property))) + (dolist (ov org-columns-overlays) + (let ((key (overlay-get ov 'org-columns-key))) + (when (and key (equal key p) (overlay-start ov)) + (goto-char (overlay-start ov)) + (let* ((spec (nth (current-column) org-columns-current-fmt-compiled)) + (value + (or (cdr (assoc spec + (get-text-property (line-beginning-position) + 'org-summaries))) + (org-entry-get (point) key)))) + (when value + (let ((displayed (org-columns--displayed-value spec value)) + (format (overlay-get ov 'org-columns-format)) + (width + (aref org-columns-current-maxwidths (current-column)))) + (overlay-put ov 'org-columns-value value) + (overlay-put ov 'org-columns-value-modified displayed) + (overlay-put ov + 'display + (org-columns--overlay-text + displayed format width property value))))))))))) (defun org-columns-redo () "Construct the column display again." (interactive) (message "Recomputing columns...") - (let ((line (org-current-line)) - (col (current-column))) - (save-excursion - (if (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - (call-interactively 'org-columns) - (org-agenda-redo) - (call-interactively 'org-agenda-columns))) - (org-goto-line line) - (move-to-column col)) + (org-with-wide-buffer + (when (marker-position org-columns-begin-marker) + (goto-char org-columns-begin-marker)) + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + ;; Since we already know the columns format, provide it instead + ;; of computing again. + (call-interactively #'org-columns org-columns-current-fmt) + (org-agenda-redo) + (call-interactively #'org-agenda-columns))) (message "Recomputing columns...done")) -(defun org-columns-not-in-agenda () - (if (eq major-mode 'org-agenda-mode) - (error "This command is only allowed in Org-mode buffers"))) - -(defun org-string-to-number (s) - "Convert string to number, and interpret hh:mm:ss." - (if (not (string-match ":" s)) - (string-to-number s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum))) - -;;;###autoload -(defun org-columns-number-to-string (n fmt &optional printf) - "Convert a computed column number to a string value, according to FMT." - (cond - ((memq fmt '(estimate)) (org-estimate-print n printf)) - ((not (numberp n)) "") - ((memq fmt '(add_times max_times min_times mean_times)) - (org-hours-to-clocksum-string n)) - ((eq fmt 'checkbox) - (cond ((= n (floor n)) "[X]") - ((> n 1.) "[-]") - (t "[ ]"))) - ((memq fmt '(checkbox-n-of-m checkbox-percent)) - (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1)))))) - (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent)))) - (printf (format printf n)) - ((eq fmt 'currency) - (format "%.2f" n)) - ((memq fmt '(min_age max_age mean_age)) - (org-format-time-period n)) - (t (number-to-string n)))) - -(defun org-nofm-to-completion (n m &optional percent) - (if (not percent) - (format "[%d/%d]" n m) - (format "[%d%%]" (round (* 100.0 n) m)))) - - -(defun org-columns-string-to-number (s fmt) - "Convert a column value to a number that can be used for column computing." - (if s - (cond - ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) - ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((string-match (concat "\\([0-9.]+\\) *\\(" - (regexp-opt (mapcar 'car org-effort-durations)) - "\\)") s) - (setq s (concat "0:" (org-duration-string-to-minutes s t))) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) - ((memq fmt '(estimate)) (org-string-to-estimate s)) - (t (string-to-number s))))) - -(defun org-columns-uncompile-format (cfmt) - "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op op-match width fmt printf fun calc) - (while (setq e (pop cfmt)) - (setq prop (car e) - title (nth 1 e) - width (nth 2 e) - op (nth 3 e) - fmt (nth 4 e) - printf (nth 5 e) - fun (nth 6 e) - calc (nth 7 e)) - (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map)) - (setq op (car op-match))) - (if (and op printf) (setq op (concat op ";" printf))) - (if (equal title prop) (setq title nil)) - (setq s (concat "%" (if width (number-to-string width)) - prop - (if title (concat "(" title ")")) - (if op (concat "{" op "}")))) - (setq rtn (concat rtn " " s))) - (org-trim rtn))) +(defun org-columns-uncompile-format (compiled) + "Turn the compiled columns format back into a string representation. +COMPILED is an alist, as returned by +`org-columns-compile-format', which see." + (mapconcat + (lambda (spec) + (pcase spec + (`(,prop ,title ,width ,op ,printf) + (concat "%" + (and width (number-to-string width)) + prop + (and title (not (equal prop title)) (format "(%s)" title)) + (cond ((not op) nil) + (printf (format "{%s;%s}" op printf)) + (t (format "{%s}" op))))))) + compiled " ")) (defun org-columns-compile-format (fmt) - "Turn a column format string into an alist of specifications. + "Turn a column format string FMT into an alist of specifications. + The alist has one entry for each column in the format. The elements of that list are: -property the property -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the operator if any -format the output format for computed results, derived from operator -printf a printf format for computed values -fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements" - (let ((start 0) width prop title op op-match f printf fun calc) - (setq org-columns-current-fmt-compiled nil) +property the property name, as an upper-case string +title the title field for the columns, as a string +width the column width in characters, can be nil for automatic width +operator the summary operator, as a string, or nil +printf a printf format for computed values, as a string, or nil + +This function updates `org-columns-current-fmt-compiled'." + (setq org-columns-current-fmt-compiled nil) + (let ((start 0)) (while (string-match - (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") + "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\ +\\(?:{\\([^}]+\\)}\\)?\\s-*" fmt start) - (setq start (match-end 0) - width (match-string 1 fmt) - prop (match-string 2 fmt) - title (or (match-string 3 fmt) prop) - op (match-string 4 fmt) - f nil - printf nil - fun '+ - calc nil) - (if width (setq width (string-to-number width))) - (when (and op (string-match ";" op)) - (setq printf (substring op (match-end 0)) - op (substring op 0 (match-beginning 0)))) - (when (setq op-match (assoc op org-columns-compile-map)) - (setq f (cadr op-match) - fun (caddr op-match) - calc (cadddr op-match))) - (push (list prop title width op f printf fun calc) - org-columns-current-fmt-compiled)) + (setq start (match-end 0)) + (let* ((width (and (match-end 1) (string-to-number (match-string 1 fmt)))) + (prop (match-string-no-properties 2 fmt)) + (title (or (match-string-no-properties 3 fmt) prop)) + (operator (match-string-no-properties 4 fmt))) + (push (if (not operator) (list (upcase prop) title width nil nil) + (let (printf) + (when (string-match ";" operator) + (setq printf (substring operator (match-end 0))) + (setq operator (substring operator 0 (match-beginning 0)))) + (list (upcase prop) title width operator printf))) + org-columns-current-fmt-compiled))) (setq org-columns-current-fmt-compiled (nreverse org-columns-current-fmt-compiled)))) + +;;;; Column View Summary + +(defconst org-columns--duration-re + (concat "[0-9.]+ *" (regexp-opt (mapcar #'car org-effort-durations))) + "Regexp matching a duration.") + +(defun org-columns--time-to-seconds (s) + "Turn time string S into a number of seconds. +A time is expressed as HH:MM, HH:MM:SS, or with units defined in +`org-effort-durations'. Plain numbers are considered as hours." + (cond + ((string-match-p org-columns--duration-re s) + (* 60 (org-duration-string-to-minutes s))) + ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" s) + (+ (* 3600 (string-to-number (match-string 1 s))) + (* 60 (string-to-number (match-string 2 s))) + (if (match-end 3) (string-to-number (match-string 3 s)) 0))) + (t (* 3600 (string-to-number s))))) + +(defun org-columns--age-to-seconds (s) + "Turn age string S into a number of seconds. +An age is either computed from a given time-stamp, or indicated +as days/hours/minutes/seconds." + (cond + ((string-match-p org-ts-regexp s) + (floor + (- org-columns--time + (float-time (apply #'encode-time (org-parse-time-string s nil t)))))) + ;; Match own output for computations in upper levels. + ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s) + (+ (* 86400 (string-to-number (match-string 1 s))) + (* 3600 (string-to-number (match-string 2 s))) + (* 60 (string-to-number (match-string 3 s))) + (string-to-number (match-string 4 s)))) + (t (user-error "Invalid age: %S" s)))) + +(defun org-columns--summary-apply-times (fun times) + "Apply FUN to time values TIMES. +If TIMES contains any time value expressed as a duration, return +the result as a duration. If it contains any H:M:S, use that +format instead. Otherwise, use H:M format." + (let* ((hms-flag nil) + (duration-flag nil) + (seconds + (apply fun + (mapcar + (lambda (time) + (cond + (duration-flag) + ((string-match-p org-columns--duration-re time) + (setq duration-flag t)) + (hms-flag) + ((string-match-p "\\`[0-9]+:[0-9]+:[0-9]+\\'" time) + (setq hms-flag t))) + (org-columns--time-to-seconds time)) + times)))) + (cond (duration-flag (org-minutes-to-clocksum-string (/ seconds 60.0))) + (hms-flag (format-seconds "%h:%.2m:%.2s" seconds)) + (t (format-seconds "%h:%.2m" seconds))))) + +(defun org-columns--compute-spec (spec &optional update) + "Update tree according to SPEC. +SPEC is a column format specification. When optional argument +UPDATE is non-nil, summarized values can replace existing ones in +properties drawers." + (let* ((lmax (if (bound-and-true-p org-inlinetask-min-level) + org-inlinetask-min-level + 29)) ;Hard-code deepest level. + (lvals (make-vector (1+ lmax) nil)) + (level 0) + (inminlevel lmax) + (last-level lmax) + (property (car spec)) + (printf (nth 4 spec)) + (summarize (org-columns--summarize (nth 3 spec)))) + (org-with-wide-buffer + ;; Find the region to compute. + (goto-char org-columns-top-level-marker) + (goto-char (condition-case nil (org-end-of-subtree t) (error (point-max)))) + ;; Walk the tree from the back and do the computations. + (while (re-search-backward + org-outline-regexp-bol org-columns-top-level-marker t) + (unless (or (= level 0) (eq level inminlevel)) + (setq last-level level)) + (setq level (org-reduced-level (org-outline-level))) + (let* ((pos (match-beginning 0)) + (value (org-entry-get nil property)) + (value-set (org-string-nw-p value))) + (cond + ((< level last-level) + ;; Collect values from lower levels and inline tasks here + ;; and summarize them using SUMMARIZE. Store them in text + ;; property `org-summaries', in alist whose key is SPEC. + (let* ((summary + (and summarize + (let ((values (append (and (/= last-level inminlevel) + (aref lvals last-level)) + (aref lvals inminlevel)))) + (and values (funcall summarize values printf)))))) + ;; Leaf values are not summaries: do not mark them. + (when summary + (let* ((summaries-alist (get-text-property pos 'org-summaries)) + (old (assoc spec summaries-alist))) + (if old (setcdr old summary) + (push (cons spec summary) summaries-alist) + (org-with-silent-modifications + (add-text-properties + pos (1+ pos) (list 'org-summaries summaries-alist))))) + ;; When PROPERTY exists in current node, even if empty, + ;; but its value doesn't match the one computed, use + ;; the latter instead. + ;; + ;; Ignore leading or trailing white spaces that might + ;; have been introduced in summary, since those are not + ;; significant in properties value. + (let ((new-value (org-trim summary))) + (when (and update value (not (equal value new-value))) + (org-entry-put (point) property new-value)))) + ;; Add current to current level accumulator. + (when (or summary value-set) + (push (or summary value) (aref lvals level))) + ;; Clear accumulators for deeper levels. + (cl-loop for l from (1+ level) to lmax do (aset lvals l nil)))) + (value-set (push value (aref lvals level))) + (t nil))))))) + +;;;###autoload +(defun org-columns-compute (property) + "Summarize the values of PROPERTY hierarchically. +Also update existing values for PROPERTY according to the first +column specification." + (interactive) + (let ((main-flag t) + (upcase-prop (upcase property))) + (dolist (spec org-columns-current-fmt-compiled) + (pcase spec + (`(,(pred (equal upcase-prop)) . ,_) + (org-columns--compute-spec spec main-flag) + ;; Only the first summary can update the property value. + (when main-flag (setq main-flag nil))))))) +(defun org-columns-compute-all () + "Compute all columns that have operators defined." + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (let ((org-columns--time (float-time (current-time))) + seen) + (dolist (spec org-columns-current-fmt-compiled) + (let ((property (car spec))) + ;; Property value is updated only the first time a given + ;; property is encountered. + (org-columns--compute-spec spec (not (member property seen))) + (push property seen))))) + +(defun org-columns--summary-sum (values printf) + "Compute the sum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") (apply #'+ (mapcar #'string-to-number values)))) + +(defun org-columns--summary-currencies (values _) + "Compute the sum of VALUES, with two decimals." + (format "%.2f" (apply #'+ (mapcar #'string-to-number values)))) + +(defun org-columns--summary-checkbox (check-boxes _) + "Summarize CHECK-BOXES with a check-box." + (let ((done (cl-count "[X]" check-boxes :test #'equal)) + (all (length check-boxes))) + (cond ((= done all) "[X]") + ((> done 0) "[-]") + (t "[ ]")))) + +(defun org-columns--summary-checkbox-count (check-boxes _) + "Summarize CHECK-BOXES with a check-box cookie." + (format "[%d/%d]" + (cl-count-if (lambda (b) (or (equal b "[X]") + (string-match-p "\\[\\([1-9]\\)/\\1\\]" b))) + check-boxes) + (length check-boxes))) + +(defun org-columns--summary-checkbox-percent (check-boxes _) + "Summarize CHECK-BOXES with a check-box percent." + (format "[%d%%]" + (round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]"))) + check-boxes)) + (length check-boxes)))) + +(defun org-columns--summary-min (values printf) + "Compute the minimum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (apply #'min (mapcar #'string-to-number values)))) + +(defun org-columns--summary-max (values printf) + "Compute the maximum of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (apply #'max (mapcar #'string-to-number values)))) + +(defun org-columns--summary-mean (values printf) + "Compute the mean of VALUES. +When PRINTF is non-nil, use it to format the result." + (format (or printf "%s") + (/ (apply #'+ (mapcar #'string-to-number values)) + (float (length values))))) + +(defun org-columns--summary-sum-times (times _) + "Sum TIMES." + (org-columns--summary-apply-times #'+ times)) + +(defun org-columns--summary-min-time (times _) + "Compute the minimum time among TIMES." + (org-columns--summary-apply-times #'min times)) + +(defun org-columns--summary-max-time (times _) + "Compute the maximum time among TIMES." + (org-columns--summary-apply-times #'max times)) + +(defun org-columns--summary-mean-time (times _) + "Compute the mean time among TIMES." + (org-columns--summary-apply-times + (lambda (&rest values) (/ (apply #'+ values) (float (length values)))) + times)) + +(defun org-columns--summary-min-age (ages _) + "Compute the minimum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (apply #'min (mapcar #'org-columns--age-to-seconds ages)))) + +(defun org-columns--summary-max-age (ages _) + "Compute the maximum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (apply #'max (mapcar #'org-columns--age-to-seconds ages)))) + +(defun org-columns--summary-mean-age (ages _) + "Compute the minimum time among AGES." + (format-seconds + "%dd %.2hh %mm %ss" + (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages)) + (float (length ages))))) + +(defun org-columns--summary-estimate (estimates _) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (dolist (e estimates) + (pcase (mapcar #'string-to-number (split-string e "-")) + (`(,low ,high) + (let ((m (/ (+ low high) 2.0))) + (cl-incf mean m) + (cl-incf var (- (/ (+ (* low low) (* high high)) 2.0) (* m m))))) + (`(,value) (cl-incf mean value)))) + (let ((sd (sqrt var))) + (format "%s-%s" + (format "%.0f" (- mean sd)) + (format "%.0f" (+ mean sd)))))) + + + ;;; Dynamic block for Column view -(defvar org-heading-regexp) ; defined in org.el -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defun org-columns-capture-view (&optional maxlevel skip-empty-rows) - "Get the column view of the current buffer or subtree. -The first optional argument MAXLEVEL sets the level limit. A -second optional argument SKIP-EMPTY-ROWS tells whether to skip +(defun org-columns--capture-view (maxlevel skip-empty format local) + "Get the column view of the current buffer. + +MAXLEVEL sets the level limit. SKIP-EMPTY tells whether to skip empty rows, an empty row being one where all the column view -specifiers except ITEM are empty. This function returns a list -containing the title row and all other rows. Each row is a list -of fields." - (save-excursion - (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) - (re-comment (format org-heading-keyword-regexp-format - org-comment-string)) - (re-archive (concat ".*:" org-archive-tag ":")) - (n (length title)) row tbl) - (goto-char (point-min)) - (while (re-search-forward org-heading-regexp nil t) - (catch 'next - (when (and (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1))))) - (get-char-property (match-beginning 0) 'org-columns-key)) - (when (save-excursion - (goto-char (point-at-bol)) - (or (looking-at re-comment) - (looking-at re-archive))) - (org-end-of-subtree t) - (throw 'next t)) - (setq row nil) - (loop for i from 0 to (1- n) do - (push - (org-quote-vert - (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) - (get-char-property (+ (match-beginning 0) i) 'org-columns-value) - "")) - row)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) - (push row tbl))))) - (append (list title 'hline) (nreverse tbl))))) +specifiers but ITEM are empty. FORMAT is a format string for +columns, or nil. When LOCAL is non-nil, only capture headings in +current subtree. + +This function returns a list containing the title row and all +other rows. Each row is a list of fields, as strings, or +`hline'." + (org-columns (not local) format) + (goto-char org-columns-top-level-marker) + (let ((columns (length org-columns-current-fmt-compiled)) + (has-item (assoc "ITEM" org-columns-current-fmt-compiled)) + table) + (org-map-entries + (lambda () + (when (get-char-property (point) 'org-columns-key) + (let (row) + (dotimes (i columns) + (let* ((col (+ (line-beginning-position) i)) + (p (get-char-property col 'org-columns-key))) + (push (org-quote-vert + (get-char-property col + (if (string= p "ITEM") + 'org-columns-value + 'org-columns-value-modified))) + row))) + (unless (and skip-empty + (let ((r (delete-dups (remove "" row)))) + (or (null r) (and has-item (= (length r) 1))))) + (push (cons (org-reduced-level (org-current-level)) (nreverse row)) + table))))) + (and maxlevel (format "LEVEL<=%d" maxlevel)) + (and local 'tree) + 'archive 'comment) + (org-columns-quit) + ;; Add column titles and a horizontal rule in front of the table. + (cons (mapcar #'cadr org-columns-current-fmt-compiled) + (cons 'hline (nreverse table))))) + +(defun org-columns--clean-item (item) + "Remove sensitive contents from string ITEM. +This includes objects that may not be duplicated within +a document, e.g., a target, or those forbidden in tables, e.g., +an inline src-block." + (let ((data (org-element-parse-secondary-string + item (org-element-restriction 'headline)))) + (org-element-map data + '(footnote-reference inline-babel-call inline-src-block target + radio-target statistics-cookie) + #'org-element-extract-element) + (org-no-properties (org-element-interpret-data data)))) ;;;###autoload (defun org-dblock-write:columnview (params) "Write the column view table. PARAMS is a property list of parameters: -:width enforce same column widths with specifiers. :id the :ID: property of the entry where the columns view should be built. When the symbol `local', call locally. When `global' call column view with the cursor at the beginning @@ -1247,339 +1392,269 @@ PARAMS is a property list of parameters: using `org-id-find'. :hlines When t, insert a hline before each item. When a number, insert a hline before each level <= that number. +:indent When non-nil, indent each ITEM field according to its level. :vlines When t, make each column a colgroup to enforce vertical lines. :maxlevel When set to a number, don't capture headlines below this level. :skip-empty-rows When t, skip rows where all specifiers other than ITEM are empty. +:width apply widths specified in columns format using specifiers. :format When non-nil, specify the column view format to use." - (let ((pos (point-marker)) - (hlines (plist-get params :hlines)) - (vlines (plist-get params :vlines)) - (maxlevel (plist-get params :maxlevel)) - (content-lines (org-split-string (plist-get params :content) "\n")) - (skip-empty-rows (plist-get params :skip-empty-rows)) - (columns-fmt (plist-get params :format)) - (case-fold-search t) - tbl id idpos nfields tmp recalc line - id-as-string view-file view-pos) - (when (setq id (plist-get params :id)) - (setq id-as-string (cond ((numberp id) (number-to-string id)) - ((symbolp id) (symbol-name id)) - ((stringp id) id) - (t ""))) - (cond ((not id) nil) - ((eq id 'global) (setq view-pos (point-min))) - ((eq id 'local)) - ((string-match "^file:\\(.*\\)" id-as-string) - (setq view-file (match-string 1 id-as-string) - view-pos 1) - (unless (file-exists-p view-file) - (error "No such file: \"%s\"" id-as-string))) - ((setq idpos (org-find-entry-with-id id)) - (setq view-pos idpos)) - ((setq idpos (org-id-find id)) - (setq view-file (car idpos)) - (setq view-pos (cdr idpos))) - (t (error "Cannot find entry with :ID: %s" id)))) - (with-current-buffer (if view-file - (get-file-buffer view-file) - (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (or view-pos (point))) - (org-columns columns-fmt) - (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) - (setq nfields (length (car tbl))) - (org-columns-quit)))) - (goto-char pos) - (move-marker pos nil) - (when tbl - (when (plist-get params :hlines) - (setq tmp nil) - (while tbl - (if (eq (car tbl) 'hline) - (push (pop tbl) tmp) - (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) - (if (and (not (eq (car tmp) 'hline)) - (or (eq hlines t) - (and (numberp hlines) - (<= (- (match-end 1) (match-beginning 1)) - hlines)))) - (push 'hline tmp))) - (push (pop tbl) tmp))) - (setq tbl (nreverse tmp))) - (when vlines - (setq tbl (mapcar (lambda (x) - (if (eq 'hline x) x (cons "" x))) - tbl)) - (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) - (when content-lines - (while (string-match "^#" (car content-lines)) - (insert (pop content-lines) "\n"))) - (setq pos (point)) - (insert (org-listtable-to-string tbl)) + (let ((table + (let ((id (plist-get params :id)) + view-file view-pos) + (pcase id + (`global nil) + ((or `local `nil) (setq view-pos (point))) + ((and (let id-string (format "%s" id)) + (guard (string-match "^file:\\(.*\\)" id-string))) + (setq view-file (match-string-no-properties 1 id-string)) + (unless (file-exists-p view-file) + (user-error "No such file: %S" id-string))) + ((and (let idpos (org-find-entry-with-id id)) (guard idpos)) + (setq view-pos idpos)) + ((let `(,filename . ,position) (org-id-find id)) + (setq view-file filename) + (setq view-pos position)) + (_ (user-error "Cannot find entry with :ID: %s" id))) + (with-current-buffer (if view-file (get-file-buffer view-file) + (current-buffer)) + (org-with-wide-buffer + (when view-pos (goto-char view-pos)) + (org-columns--capture-view (plist-get params :maxlevel) + (plist-get params :skip-empty-rows) + (plist-get params :format) + view-pos)))))) + (when table + ;; Prune level information from the table. Also normalize + ;; headings: remove stars, add indentation entities, if + ;; required, and possibly precede some of them with a horizontal + ;; rule. + (let ((item-index + (let ((p (assoc "ITEM" org-columns-current-fmt-compiled))) + (and p (cl-position p + org-columns-current-fmt-compiled + :test #'equal)))) + (hlines (plist-get params :hlines)) + (indent (plist-get params :indent)) + new-table) + ;; Copy header and first rule. + (push (pop table) new-table) + (push (pop table) new-table) + (dolist (row table (setq table (nreverse new-table))) + (let ((level (car row))) + (when (and (not (eq (car new-table) 'hline)) + (or (eq hlines t) + (and (numberp hlines) (<= level hlines)))) + (push 'hline new-table)) + (when item-index + (let ((item (org-columns--clean-item (nth item-index (cdr row))))) + (setf (nth item-index (cdr row)) + (if (and indent (> level 1)) + (concat "\\_" (make-string (* 2 (1- level)) ?\s) item) + item)))) + (push (cdr row) new-table)))) (when (plist-get params :width) - (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) - org-columns-current-widths "|"))) - (while (setq line (pop content-lines)) - (when (string-match "^#" line) - (insert "\n" line) - (when (string-match "^[ \t]*#\\+tblfm" line) - (setq recalc t)))) - (if recalc - (progn (goto-char pos) (org-table-recalculate 'all)) - (goto-char pos) + (setq table + (append table + (list + (mapcar (lambda (spec) + (let ((w (nth 2 spec))) + (if w (format "<%d>" (max 3 w)) ""))) + org-columns-current-fmt-compiled))))) + (when (plist-get params :vlines) + (setq table + (let ((size (length org-columns-current-fmt-compiled))) + (append (mapcar (lambda (x) (if (eq 'hline x) x (cons "" x))) + table) + (list (cons "/" (make-list size "<>"))))))) + (let ((content-lines (org-split-string (plist-get params :content) "\n")) + recalc) + ;; Insert affiliated keywords before the table. + (when content-lines + (while (string-match-p "\\`[ \t]*#\\+" (car content-lines)) + (insert (pop content-lines) "\n"))) + (save-excursion + ;; Insert table at point. + (insert + (mapconcat (lambda (row) + (if (eq row 'hline) "|-|" + (format "|%s|" (mapconcat #'identity row "|")))) + table + "\n")) + ;; Insert TBLFM lines following table. + (let ((case-fold-search t)) + (dolist (line content-lines) + (when (string-match-p "\\`[ \t]*#\\+TBLFM:" line) + (insert "\n" line) + (unless recalc (setq recalc t)))))) + (when recalc (org-table-recalculate 'all t)) (org-table-align))))) -(defun org-listtable-to-string (tbl) - "Convert a listtable TBL to a string that contains the Org-mode table. -The table still need to be aligned. The resulting string has no leading -and tailing newline characters." - (mapconcat - (lambda (x) - (cond - ((listp x) - (concat "|" (mapconcat 'identity x "|") "|")) - ((eq x 'hline) "|-|") - (t (error "Garbage in listtable: %s" x)))) - tbl "\n")) - ;;;###autoload -(defun org-insert-columns-dblock () +(defun org-columns-insert-dblock () "Create a dynamic block capturing a column view table." (interactive) - (let ((defaults '(:name "columnview" :hlines 1)) - (id (org-icompleting-read + (let ((id (completing-read "Capture columns (local, global, entry with :ID: property) [local]: " (append '(("global") ("local")) - (mapcar 'list (org-property-values "ID")))))) - (if (equal id "") (setq id 'local)) - (if (equal id "global") (setq id 'global)) - (setq defaults (append defaults (list :id id))) - (org-create-dblock defaults) - (org-update-dblock))) + (mapcar #'list (org-property-values "ID")))))) + (org-create-dblock + (list :name "columnview" + :hlines 1 + :id (cond ((string= id "global") 'global) + ((member id '("" "local")) 'local) + (id))))) + (org-update-dblock)) -;;; Column view in the agenda - -(defvar org-agenda-view-columns-initially nil - "When set, switch to columns view immediately after creating the agenda.") -(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el -(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el -(defvar org-agenda-columns-add-appointments-to-effort-sum); as well + +;;; Column view in the agenda ;;;###autoload (defun org-agenda-columns () "Turn on or update column view in the agenda." (interactive) - (org-verify-version 'columns) (org-columns-remove-overlays) (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - cache maxwidths m p a d fmt) - (cond - ((and (boundp 'org-agenda-overriding-columns-format) - org-agenda-overriding-columns-format) - (setq fmt org-agenda-overriding-columns-format)) - ((setq m (org-get-at-bol 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format)))) - ((and (boundp 'org-columns-current-fmt) - (local-variable-p 'org-columns-current-fmt) - org-columns-current-fmt) - (setq fmt org-columns-current-fmt)) - ((setq m (next-single-property-change (point-min) 'org-hd-marker)) - (setq m (get-text-property m 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format))))) - (setq fmt (or fmt org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) + (let* ((org-columns--time (float-time (current-time))) + (fmt + (cond + ((bound-and-true-p org-agenda-overriding-columns-format)) + ((let ((m (org-get-at-bol 'org-hd-marker))) + (and m + (or (org-entry-get m "COLUMNS" t) + (with-current-buffer (marker-buffer m) + org-columns-default-format))))) + ((and (local-variable-p 'org-columns-current-fmt) + org-columns-current-fmt)) + ((let ((m (next-single-property-change (point-min) 'org-hd-marker))) + (and m + (let ((m (get-text-property m 'org-hd-marker))) + (or (org-entry-get m "COLUMNS" t) + (with-current-buffer (marker-buffer m) + org-columns-default-format)))))) + (t org-columns-default-format))) + (compiled-fmt (org-columns-compile-format fmt))) + (setq org-columns-current-fmt fmt) (when org-agenda-columns-compute-summary-properties (org-agenda-colview-compute org-columns-current-fmt-compiled)) (save-excursion - ;; Get and cache the properties + ;; Collect properties for each headline in current view. (goto-char (point-min)) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (setq p (org-entry-properties m)) - - (when (or (not (setq a (assoc org-effort-property p))) - (not (string-match "\\S-" (or (cdr a) "")))) - ;; OK, the property is not defined. Use appointment duration? - (when (and org-agenda-columns-add-appointments-to-effort-sum - (setq d (get-text-property (point) 'duration))) - (setq d (org-minutes-to-clocksum-string d)) - (put-text-property 0 (length d) 'face 'org-warning d) - (push (cons org-effort-property d) p))) - (push (cons (org-current-line) p) cache)) - (beginning-of-line 2)) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) - (flyspell-mode 0)) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache) - (when org-agenda-columns-show-summaries - (org-agenda-colview-summarize cache)))))) + (let (cache) + (while (not (eobp)) + (let ((m (org-get-at-bol 'org-hd-marker))) + (when m + (push (cons (line-beginning-position) + ;; `org-columns-current-fmt-compiled' is + ;; initialized but only set locally to the + ;; agenda buffer. Since current buffer is + ;; changing, we need to force the original + ;; compiled-fmt there. + (org-with-point-at m + (org-columns--collect-values compiled-fmt))) + cache))) + (forward-line)) + (when cache + (org-columns--set-widths cache) + (org-columns--display-here-title) + (when (setq-local org-columns-flyspell-was-active + (bound-and-true-p flyspell-mode)) + (flyspell-mode 0)) + (dolist (entry cache) + (goto-char (car entry)) + (org-columns--display-here (cdr entry))) + (when org-agenda-columns-show-summaries + (org-agenda-colview-summarize cache))))))) (defun org-agenda-colview-summarize (cache) "Summarize the summarizable columns in column view in the agenda. This will add overlays to the date lines, to show the summary for each day." - (let* ((fmt (mapcar (lambda (x) - (if (string-match "CLOCKSUM.*" (car x)) - (list (match-string 0 (car x)) - (nth 1 x) (nth 2 x) ":" 'add_times - nil '+ nil) - x)) - org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v title) - (catch 'exit - (when (delq nil (mapcar 'cadr fmt)) - ;; OK, at least one summation column, it makes sense to try this - (goto-char (point-max)) + (let ((fmt (mapcar + (lambda (spec) + (pcase spec + (`(,property ,title ,width . ,_) + (if (member property '("CLOCKSUM" "CLOCKSUM_T")) + (list property title width ":" nil) + spec)))) + org-columns-current-fmt-compiled))) + ;; Ensure there's at least one summation column. + (when (cl-some (lambda (spec) (nth 3 spec)) fmt) + (goto-char (point-max)) + (catch :complete (while t (when (or (get-text-property (point) 'org-date-line) (eq (get-text-property (point) 'face) 'org-agenda-structure)) - ;; OK, this is a date line that should be used - (setq line (org-current-line)) - (setq entries nil c cache cache nil) - (while (setq c1 (pop c)) - (if (> (car c1) line) - (push c1 entries) - (push c1 cache))) - ;; now ENTRIES are the ones we want to use, CACHE is the rest - ;; Compute the summaries for the properties we want, - ;; set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (setq props - (mapcar - (lambda (f) - (setq prop (car f) - title (nth 1 f) - stype (nth 4 f) - sumfunc (nth 6 f) - calc (or (nth 7 f) 'identity)) - (cond - ((equal prop "ITEM") - (cons prop (buffer-substring (point-at-bol) - (point-at-eol)))) - ((not stype) (cons prop "")) - (t ;; do the summary - (setq lsum nil) - (dolist (x entries) - (setq v (cdr (assoc prop x))) - (if v - (push - (funcall - (if (not (get-text-property 0 'org-computed v)) - calc - 'identity) - (org-columns-string-to-number - v stype)) - lsum))) - (setq lsum (remove nil lsum)) - (setq lsum - (cond ((> (length lsum) 1) - (org-columns-number-to-string - (apply sumfunc lsum) stype)) - ((eq (length lsum) 1) - (org-columns-number-to-string - (car lsum) stype)) - (t ""))) - (put-text-property 0 (length lsum) 'face 'bold lsum) - (unless (eq calc 'identity) - (put-text-property 0 (length lsum) 'org-computed t lsum)) - (cons prop lsum)))) - fmt)) - (org-columns-display-here props 'dateline) - (org-set-local 'org-agenda-columns-active t))) - (if (bobp) (throw 'exit t)) - (beginning-of-line 0)))))) + ;; OK, this is a date line that should be used. + (let (entries) + (let (rest) + (dolist (c cache) + (if (> (car c) (point)) + (push c entries) + (push c rest))) + (setq cache rest)) + ;; ENTRIES contains entries below the current one. + ;; CACHE is the rest. Compute the summaries for the + ;; properties we want, set nil properties for the rest. + (when (setq entries (mapcar #'cdr entries)) + (org-columns--display-here + (mapcar + (lambda (spec) + (pcase spec + (`("ITEM" . ,_) + ;; Replace ITEM with current date. Preserve + ;; properties for fontification. + (let ((date (buffer-substring + (line-beginning-position) + (line-end-position)))) + (list spec date date))) + (`(,_ ,_ ,_ nil ,_) (list spec "" "")) + (`(,_ ,_ ,_ ,operator ,printf) + (let* ((summarize (org-columns--summarize operator)) + (values + ;; Use real values for summary, not + ;; those prepared for display. + (delq nil + (mapcar + (lambda (e) (org-string-nw-p + (nth 1 (assoc spec e)))) + entries))) + (final (if values + (funcall summarize values printf) + ""))) + (unless (equal final "") + (put-text-property 0 (length final) + 'face 'bold final)) + (list spec final final))))) + fmt) + 'dateline) + (setq-local org-agenda-columns-active t)))) + (if (bobp) (throw :complete t) (forward-line -1))))))) (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." (let ((files org-agenda-contributing-files) (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker)) - f fm a b) - (while (setq f (pop files)) - (setq b (find-buffer-visiting f)) - (with-current-buffer (or (buffer-base-buffer b) b) - (save-excursion - (save-restriction - (widen) - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (while (setq fm (pop fmt)) - (cond ((equal (car fm) "CLOCKSUM") - (org-clock-sum)) - ((equal (car fm) "CLOCKSUM_T") - (org-clock-sum-today)) - ((and (nth 4 fm) - (setq a (assoc (car fm) - org-columns-current-fmt-compiled)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) - -(defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds." - (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) - "")) - -(defun org-estimate-mean-and-var (v) - "Return the mean and variance of an estimate." - (let* ((low (float (car v))) - (high (float (cadr v))) - (mean (/ (+ low high) 2.0)) - (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) - (list mean var))) - -(defun org-estimate-combine (&rest el) - "Combine a list of estimates, using mean and variance. -The mean and variance of the result will be the sum of the means -and variances (respectively) of the individual estimates." - (let ((mean 0) - (var 0)) - (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) - (let ((stdev (sqrt var))) - (list (- mean stdev) (+ mean stdev))))) - -(defun org-estimate-print (e &optional fmt) - "Prepare a string representation of an estimate. -This formats these numbers as two numbers with a \"-\" between them." - (if (null fmt) (set 'fmt "%.0f")) - (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) - -(defun org-string-to-estimate (s) - "Convert a string to an estimate. -The string should be two numbers joined with a \"-\"." - (if (string-match "\\(.*\\)-\\(.*\\)" s) - (list (string-to-number (match-string 1 s)) - (string-to-number(match-string 2 s))) - (list (string-to-number s) (string-to-number s)))) + (org-columns-top-level-marker (make-marker))) + (dolist (f files) + (let ((b (find-buffer-visiting f))) + (with-current-buffer (or (buffer-base-buffer b) b) + (org-with-wide-buffer + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (goto-char (point-min)) + (org-columns-get-format-and-top-level) + (dolist (spec fmt) + (let ((prop (car spec))) + (cond + ((equal prop "CLOCKSUM") (org-clock-sum)) + ((equal prop "CLOCKSUM_T") (org-clock-sum-today)) + ((and (nth 3 spec) + (let ((a (assoc prop org-columns-current-fmt-compiled))) + (equal (nth 3 a) (nth 3 spec)))) + (org-columns-compute prop))))))))))) + (provide 'org-colview) diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 42e2271c07..e1d40369f1 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -1,4 +1,4 @@ -;;; org-compat.el --- Compatibility code for Org-mode +;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,65 +24,287 @@ ;; ;;; Commentary: -;; This file contains code needed for compatibility with XEmacs and older +;; This file contains code needed for compatibility with older ;; versions of GNU Emacs. ;;; Code: -(eval-when-compile - (require 'cl)) - +(require 'cl-lib) (require 'org-macs) -;; The following constant is for backward compatibility. We do not use -;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) -;; at compilation time and can therefore optimize code better. -(defconst org-xemacs-p (featurep 'xemacs)) -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") +(declare-function org-at-table.el-p "org" (&optional table-type)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-type "org-element" (element)) +(declare-function org-link-set-parameters "org" (type &rest rest)) +(declare-function org-table-end (&optional table-type)) +(declare-function table--at-cell-p "table" (position &optional object at-column)) + +(defvar org-table-any-border-regexp) +(defvar org-table-dataline-regexp) +(defvar org-table-tab-recognizes-table.el) +(defvar org-table1-hline-regexp) + +;; As of Emacs 25.1, `outline-mode' functions are under the 'outline-' +;; prefix, `find-tag' is replaced with `xref-find-definition' and +;; `x-get-selection' with `gui-get-selection'. +(when (< emacs-major-version 25) + (defalias 'outline-hide-entry 'hide-entry) + (defalias 'outline-hide-sublevels 'hide-sublevels) + (defalias 'outline-hide-subtree 'hide-subtree) + (defalias 'outline-show-all 'show-all) + (defalias 'outline-show-branches 'show-branches) + (defalias 'outline-show-children 'show-children) + (defalias 'outline-show-entry 'show-entry) + (defalias 'outline-show-subtree 'show-subtree) + (defalias 'xref-find-definitions 'find-tag) + (defalias 'format-message 'format) + (defalias 'gui-get-selection 'x-get-selection)) + + +;;; Obsolete aliases (remove them after the next major release). + +;;;; XEmacs compatibility, now removed. +(define-obsolete-function-alias 'org-activate-mark 'activate-mark) +(define-obsolete-function-alias 'org-add-hook 'add-hook "Org 9.0") +(define-obsolete-function-alias 'org-bound-and-true-p 'bound-and-true-p "Org 9.0") +(define-obsolete-function-alias 'org-decompose-region 'decompose-region "Org 9.0") +(define-obsolete-function-alias 'org-defvaralias 'defvaralias "Org 9.0") +(define-obsolete-function-alias 'org-detach-overlay 'delete-overlay "Org 9.0") +(define-obsolete-function-alias 'org-file-equal-p 'file-equal-p "Org 9.0") +(define-obsolete-function-alias 'org-float-time 'float-time "Org 9.0") +(define-obsolete-function-alias 'org-indent-line-to 'indent-line-to "Org 9.0") +(define-obsolete-function-alias 'org-indent-to-column 'indent-to-column "Org 9.0") +(define-obsolete-function-alias 'org-looking-at-p 'looking-at-p "Org 9.0") +(define-obsolete-function-alias 'org-looking-back 'looking-back "Org 9.0") +(define-obsolete-function-alias 'org-match-string-no-properties 'match-string-no-properties "Org 9.0") +(define-obsolete-function-alias 'org-propertize 'propertize "Org 9.0") +(define-obsolete-function-alias 'org-select-frame-set-input-focus 'select-frame-set-input-focus "Org 9.0") + +(defmacro org-re (s) + "Replace posix classes in regular expression S." + (declare (debug (form)) + (obsolete "you can safely remove it." "Org 9.0")) + s) + +;;;; Functions from cl-lib that Org used to have its own implementation of. +(define-obsolete-function-alias 'org-count 'cl-count "Org 9.0") +(define-obsolete-function-alias 'org-every 'cl-every "Org 9.0") +(define-obsolete-function-alias 'org-find-if 'cl-find-if "Org 9.0") +(define-obsolete-function-alias 'org-reduce 'cl-reduce "Org 9.0") +(define-obsolete-function-alias 'org-remove-if 'cl-remove-if "Org 9.0") +(define-obsolete-function-alias 'org-remove-if-not 'cl-remove-if-not "Org 9.0") +(define-obsolete-function-alias 'org-some 'cl-some "Org 9.0") +(define-obsolete-function-alias 'org-floor* 'cl-floor "Org 9.0") + +(defun org-sublist (list start end) + "Return a section of LIST, from START to END. +Counting starts at 1." + (cl-subseq list (1- start) end)) +(make-obsolete 'org-sublist + "use cl-subseq (note the 0-based counting)." + "Org 9.0") + + +;;;; Functions available since Emacs 24.3 +(define-obsolete-function-alias 'org-buffer-narrowed-p 'buffer-narrowed-p "Org 9.0") +(define-obsolete-function-alias 'org-called-interactively-p 'called-interactively-p "Org 9.0") +(define-obsolete-function-alias 'org-char-to-string 'char-to-string "Org 9.0") +(define-obsolete-function-alias 'org-delete-directory 'delete-directory "Org 9.0") +(define-obsolete-function-alias 'org-format-seconds 'format-seconds "Org 9.0") +(define-obsolete-function-alias 'org-link-escape-browser 'url-encode-url "Org 9.0") +(define-obsolete-function-alias 'org-no-warnings 'with-no-warnings "Org 9.0") +(define-obsolete-function-alias 'org-number-sequence 'number-sequence "Org 9.0") +(define-obsolete-function-alias 'org-pop-to-buffer-same-window 'pop-to-buffer-same-window "Org 9.0") +(define-obsolete-function-alias 'org-string-match-p 'string-match-p "Org 9.0") + +;;;; Functions and variables from previous releases now obsolete. +(define-obsolete-function-alias 'org-element-remove-indentation + 'org-remove-indentation "Org 9.0") +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "Org 8.0") +(define-obsolete-variable-alias 'org-description-max-indent + 'org-list-description-max-indent "Org 8.0") +(define-obsolete-variable-alias 'org-latex-create-formula-image-program + 'org-preview-latex-default-process "Org 9.0") +(define-obsolete-variable-alias 'org-latex-preview-ltxpng-directory + 'org-preview-latex-image-directory "Org 9.0") +(define-obsolete-function-alias 'org-table-p 'org-at-table-p "Org 9.0") +(define-obsolete-function-alias 'org-on-heading-p 'org-at-heading-p "Org 9.0") +(define-obsolete-function-alias 'org-at-regexp-p 'org-in-regexp "Org 8.3") +(define-obsolete-function-alias 'org-speed-command-default-hook + 'org-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-babel-speed-command-hook + 'org-babel-speed-command-activate "Org 8.0") +(define-obsolete-function-alias 'org-image-file-name-regexp + 'image-file-name-regexp "Org 9.0") +(define-obsolete-function-alias 'org-get-legal-level + 'org-get-valid-level "Org 7.8") +(define-obsolete-function-alias 'org-completing-read-no-i + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-icompleting-read + 'completing-read "Org 9.0") +(define-obsolete-function-alias 'org-iread-file-name 'read-file-name "Org 9.0") +(define-obsolete-function-alias 'org-days-to-time + 'org-time-stamp-to-now "Org 8.2") +(define-obsolete-variable-alias 'org-agenda-ignore-drawer-properties + 'org-agenda-ignore-properties "Org 9.0") +(define-obsolete-function-alias 'org-preview-latex-fragment + 'org-toggle-latex-fragment "Org 8.3") +(define-obsolete-function-alias 'org-display-inline-modification-hook + 'org-display-inline-remove-overlay "Org 8.0") +(define-obsolete-function-alias 'org-export-get-genealogy + 'org-element-lineage "Org 9.0") +(define-obsolete-variable-alias 'org-latex-with-hyperref + 'org-latex-hyperref-template "Org 9.0") +(define-obsolete-variable-alias 'org-link-to-org-use-id + 'org-id-link-to-org-use-id "Org 8.0") +(define-obsolete-variable-alias 'hfy-optimisations 'hfy-optimizations "Org 9.0") +(define-obsolete-variable-alias 'org-clock-modeline-total + 'org-clock-mode-line-total "Org 8.0") +(define-obsolete-function-alias 'org-protocol-unhex-compound + 'org-link-unescape-compound "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-string + 'org-link-unescape "Org 7.8") +(define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence "Org 7.8") +(define-obsolete-variable-alias 'org-export-htmlized-org-css-url + 'org-org-htmlized-css-url "Org 8.2") +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "Org 8.0") +(define-obsolete-function-alias 'org-list-parse-list 'org-list-to-lisp "Org 9.0") +(define-obsolete-variable-alias 'org-agenda-menu-two-column + 'org-agenda-menu-two-columns "Org 8.0") +(define-obsolete-variable-alias 'org-finalize-agenda-hook + 'org-agenda-finalize-hook "Org 8.0") +(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "Org 7.8") +(define-obsolete-function-alias 'org-agenda-post-command-hook + 'org-agenda-update-agenda-type "Org 8.0") +(define-obsolete-function-alias 'org-agenda-todayp + 'org-agenda-today-p "Org 9.0") +(define-obsolete-function-alias 'org-babel-examplize-region + 'org-babel-examplify-region "Org 9.0") +(define-obsolete-function-alias 'org-babel-trim 'org-trim "Org 9.0") +(define-obsolete-variable-alias 'org-html-style-include-scripts + 'org-html-head-include-scripts "Org 8.0") +(define-obsolete-variable-alias 'org-html-style-include-default + 'org-html-head-include-default-style "Org 8.0") +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(define-obsolete-function-alias 'org-insert-columns-dblock + 'org-columns-insert-dblock "Org 9.0") +(define-obsolete-function-alias 'org-activate-bracket-links + 'org-activate-links "Org 9.0") +(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") +(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0") + +(defun org-in-fixed-width-region-p () + "Non-nil if point in a fixed-width region." + (save-match-data + (eq 'fixed-width (org-element-type (org-element-at-point))))) +(make-obsolete 'org-in-fixed-width-region-p + "use `org-element' library" + "Org 9.0") + +(defcustom org-read-date-minibuffer-setup-hook nil + "Hook to be used to set up keys for the date/time interface. +Add key definitions to `minibuffer-local-map', which will be a +temporary copy." + :group 'org-time + :type 'hook) +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "set `org-read-date-minibuffer-local-map' instead." "Org 8.0") (defun org-compatible-face (inherits specs) "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If INHERITS is set and the Emacs version does -not support it, copy the face specification from the inheritance face. -If INHERITS is not given and SPECS is, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (when (and inherits (facep inherits) (not specs)) - (setq specs (or specs - (get inherits 'saved-face) - (get inherits 'face-defface-spec)))) - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) - (>= emacs-major-version 22) - ;; do not inherit outline faces before Emacs 23 - (or (>= emacs-major-version 23) - (not (string-match "\\`outline-[0-9]+" - (symbol-name inherits))))) - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) +If INHERITS is an existing face and if the Emacs version supports +it, just inherit the face. If INHERITS is not given and SPECS +is, use SPECS to define the face." + (declare (indent 1)) + (if (facep inherits) + (list (list t :inherit inherits)) + specs)) +(make-obsolete 'org-compatible-face "you can remove it." "Org 9.0") + +(defun org-add-link-type (type &optional follow export) + "Add a new TYPE link. +FOLLOW and EXPORT are two functions. + +FOLLOW should take the link path as the single argument and do whatever +is necessary to follow the link, for example find a file or display +a mail message. + +EXPORT should format the link path for export to one of the export formats. +It should be a function accepting three arguments: + + path the path of the link, the text after the prefix (like \"http:\") + desc the description of the link, if any + format the export format, a symbol like `html' or `latex' or `ascii'. + +The function may use the FORMAT information to return different values +depending on the format. The return value will be put literally into +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + +Org mode has a built-in default for exporting links. If you are happy with +this default, there is no need to define an export function for the link +type. For a simple example of an export function, see `org-bbdb.el'. + +If TYPE already exists, update it with the arguments. +See `org-link-parameters' for documentation on the other parameters." + (org-link-set-parameters type :follow follow :export export) + (message "Created %s link." type)) + +(make-obsolete 'org-add-link-type "use `org-link-set-parameters' instead." "Org 9.0") + +(defun org-table-recognize-table.el () + "If there is a table.el table nearby, recognize it and move into it." + (when (and org-table-tab-recognizes-table.el (org-at-table.el-p)) + (beginning-of-line) + (unless (or (looking-at org-table-dataline-regexp) + (not (looking-at org-table1-hline-regexp))) + (forward-line) + (when (looking-at org-table-any-border-regexp) + (forward-line -2))) + (if (re-search-forward "|" (org-table-end t) t) + (progn + (require 'table) + (if (table--at-cell-p (point)) t + (message "recognizing table.el table...") + (table-recognize-table) + (message "recognizing table.el table...done"))) + (error "This should not happen")))) + +;; Not used by Org core since commit 6d1e3082, Feb 2010. +(make-obsolete 'org-table-recognize-table.el + "please notify the org mailing list if you use this function." + "Org 9.0") + +(define-obsolete-function-alias + 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string "Org 8.0") + +(defun org-remove-angle-brackets (s) + (org-unbracket-string "<" ">" s)) +(make-obsolete 'org-remove-angle-brackets 'org-unbracket-string "Org 9.0") + +(defun org-remove-double-quotes (s) + (org-unbracket-string "\"" "\"" s)) +(make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") + +(define-obsolete-function-alias 'org-babel-number-p + 'org-babel--string-to-number "Org 9.0") + + + +;;;; Obsolete link types + +(eval-after-load 'org + '(progn + (org-link-set-parameters "file+emacs") ;since Org 9.0 + (org-link-set-parameters "file+sys"))) ;since Org 9.0 + + + +;;; Miscellaneous functions (defun org-version-check (version feature level) (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) @@ -108,110 +330,19 @@ any other entries, and any resulting duplicates will be removed entirely." t)) t))) - -;;;; Emacs/XEmacs compatibility - -(eval-and-compile - (defun org-defvaralias (new-alias base-variable &optional docstring) - "Compatibility function for defvaralias. -Don't do the aliasing when `defvaralias' is not bound." - (declare (indent 1)) - (when (fboundp 'defvaralias) - (defvaralias new-alias base-variable docstring))) - - (when (and (not (boundp 'user-emacs-directory)) - (boundp 'user-init-directory)) - (org-defvaralias 'user-emacs-directory 'user-init-directory))) - -(when (featurep 'xemacs) - (defadvice custom-handle-keyword - (around org-custom-handle-keyword - activate preactivate) - "Remove custom keywords not recognized to avoid producing an error." - (cond - ((eq (ad-get-arg 1) :package-version)) - (t ad-do-it))) - (defadvice define-obsolete-variable-alias - (around org-define-obsolete-variable-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defadvice define-obsolete-function-alias - (around org-define-obsolete-function-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defvar customize-package-emacs-version-alist nil) - (defvar temporary-file-directory (temp-directory))) - -;; Keys -(defconst org-xemacs-key-equivalents - '(([mouse-1] . [button1]) - ([mouse-2] . [button2]) - ([mouse-3] . [button3]) - ([C-mouse-4] . [(control mouse-4)]) - ([C-mouse-5] . [(control mouse-5)])) - "Translation alist for a couple of keys.") - -;; Overlay compatibility functions -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (overlay-put ovl 'display text) - (if face (overlay-put ovl 'face face)) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-before-string (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-find-overlays (prop &optional pos delete) - "Find all overlays specifying PROP at POS or point. -If DELETE is non-nil, delete all those overlays." - (let ((overlays (overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (overlay-get ov prop) - (if delete (delete-overlay ov) (push ov found)))) - found)) - (defun org-get-x-clipboard (value) - "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." - (cond ((eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x)))) + "Get the value of the X or Windows clipboard." + (cond ((and (eq window-system 'x) + (fboundp 'gui-get-selection)) ;Silence byte-compiler. + (org-no-properties + (ignore-errors + (or (gui-get-selection value 'UTF8_STRING) + (gui-get-selection value 'COMPOUND_TEXT) + (gui-get-selection value 'STRING) + (gui-get-selection value 'TEXT))))) ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) (w32-get-clipboard-data)))) -(defsubst org-decompose-region (beg end) - "Decompose from BEG to END." - (if (featurep 'xemacs) - (let ((modified-p (buffer-modified-p)) - (buffer-read-only nil)) - (remove-text-properties beg end '(composition nil)) - (set-buffer-modified-p modified-p)) - (decompose-region beg end))) - -;; Miscellaneous functions - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - (defun org-add-props (string plist &rest props) "Add text properties to entire string, from beginning to end. PLIST may be a list of properties, PROPS are individual properties and values @@ -238,66 +369,29 @@ ignored in this case." (shrink-window-if-larger-than-buffer window))) (or window (selected-window))) -(defun org-number-sequence (from &optional to inc) - "Call `number-sequence' or emulate it." - (if (fboundp 'number-sequence) - (number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - ;; `set-transient-map' is only in Emacs >= 24.4 (defalias 'org-set-transient-map (if (fboundp 'set-transient-map) 'set-transient-map 'set-temporary-overlay-map)) -;; Region compatibility +;;; Region compatibility (defvar org-ignore-region nil "Non-nil means temporarily disable the active region.") (defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before + "Non-nil when the region active. +Unlike to `use-region-p', this function also checks +`org-ignore-region'." + (and (not org-ignore-region) (use-region-p))) (defun org-cursor-to-region-beginning () (when (and (org-region-active-p) (> (point) (region-beginning))) (exchange-point-and-mark))) -;; Emacs 22 misses `activate-mark' -(if (fboundp 'activate-mark) - (defalias 'org-activate-mark 'activate-mark) - (defun org-activate-mark () - (when (mark t) - (setq mark-active t) - (when (and (boundp 'transient-mark-mode) - (not transient-mark-mode)) - (set (make-local-variable 'transient-mark-mode) 'lambda)) - (when (boundp 'zmacs-regions) - (setq zmacs-regions t))))) - -;; Invisibility compatibility +;;; Invisibility compatibility (defun org-remove-from-invisibility-spec (arg) "Remove elements from `buffer-invisibility-spec'." @@ -312,63 +406,14 @@ Works on both Emacs and XEmacs." (if (consp buffer-invisibility-spec) (member arg buffer-invisibility-spec))) -(defmacro org-xemacs-without-invisibility (&rest body) - "Turn off extents with invisibility while executing BODY." - `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - ,@body - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec))))) -(def-edebug-spec org-xemacs-without-invisibility (body)) - -(defun org-indent-to-column (column &optional minimum buffer) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) - (indent-to-column column minimum))) - -(defun org-indent-line-to (column) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-line-to column)) - (indent-line-to column))) - -(defun org-move-to-column (column &optional force buffer) +(defun org-move-to-column (column &optional force _buffer) "Move to column COLUMN. -Pass COLUMN and FORCE to `move-to-column'. -Pass BUFFER to the XEmacs version of `move-to-column'." +Pass COLUMN and FORCE to `move-to-column'." (let ((buffer-invisibility-spec - (remove '(org-filtered) buffer-invisibility-spec))) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility - (move-to-column column force buffer)) - (move-to-column column force)))) - -(defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21." - (cond ((featurep 'xemacs) - (org-no-warnings (get-selection-no-error value))) - ((fboundp 'x-get-selection) - (condition-case nil - (or (x-get-selection value 'UTF8_STRING) - (x-get-selection value 'COMPOUND_TEXT) - (x-get-selection value 'STRING) - (x-get-selection value 'TEXT)) - (error nil))))) - -(defun org-propertize (string &rest properties) - (if (featurep 'xemacs) - (progn - (add-text-properties 0 (length string) properties string) - string) - (apply 'propertize string properties))) + (if (listp buffer-invisibility-spec) + (remove '(org-filtered) buffer-invisibility-spec) + buffer-invisibility-spec))) + (move-to-column column force))) (defmacro org-find-library-dir (library) `(file-name-directory (or (locate-library ,library) ""))) @@ -387,37 +432,20 @@ Pass BUFFER to the XEmacs version of `move-to-column'." string) (apply 'kill-new string args)) -(defun org-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x ns mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) - -(define-obsolete-function-alias 'org-float-time 'float-time "26.1") - -;; `user-error' is only available from 24.3 on -(unless (fboundp 'user-error) - (defalias 'user-error 'error)) - -;; ‘format-message’ is available only from 25 on -(unless (fboundp 'format-message) - (defalias 'format-message 'format)) +;; `font-lock-ensure' is only available from 24.4.50 on +(defalias 'org-font-lock-ensure + (if (fboundp 'font-lock-ensure) + #'font-lock-ensure + (lambda (&optional _beg _end) + (with-no-warnings (font-lock-fontify-buffer))))) + +;; `file-local-name' was added in Emacs 26.1. +(defalias 'org-babel-local-file-name + (if (fboundp 'file-local-name) + 'file-local-name + (lambda (file) + "Return the local name component of FILE." + (or (file-remote-p file 'localname) file)))) (defmacro org-no-popups (&rest body) "Suppress popup windows. @@ -429,93 +457,6 @@ effect, which variables to use depends on the Emacs version." `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) ,@body))) -(if (fboundp 'string-match-p) - (defalias 'org-string-match-p 'string-match-p) - (defun org-string-match-p (regexp string &optional start) - (save-match-data - (funcall 'string-match regexp string start)))) - -(if (fboundp 'looking-at-p) - (defalias 'org-looking-at-p 'looking-at-p) - (defun org-looking-at-p (&rest args) - (save-match-data - (apply 'looking-at args)))) - -;; XEmacs does not have `looking-back'. -(if (fboundp 'looking-back) - (defalias 'org-looking-back 'looking-back) - (defun org-looking-back (regexp &optional limit greedy) - "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying a minimum -starting position, to avoid checking matches that would start -before LIMIT. - -If GREEDY is non-nil, extend the match backwards as far as -possible, stopping when a single additional previous character -cannot be part of a match for REGEXP. When the match is -extended, its starting position is allowed to occur before -LIMIT." - (let ((start (point)) - (pos - (save-excursion - (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) - (point))))) - (if (and greedy pos) - (save-restriction - (narrow-to-region (point-min) start) - (while (and (> pos (point-min)) - (save-excursion - (goto-char pos) - (backward-char 1) - (looking-at (concat "\\(?:" regexp "\\)\\'")))) - (setq pos (1- pos))) - (save-excursion - (goto-char pos) - (looking-at (concat "\\(?:" regexp "\\)\\'"))))) - (not (null pos))))) - -(defalias 'org-font-lock-ensure - (if (fboundp 'font-lock-ensure) - #'font-lock-ensure - (lambda (&optional _beg _end) (font-lock-fontify-buffer)))) - -(defun org-floor* (x &optional y) - "Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - -;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. -(defun org-pop-to-buffer-same-window - (&optional buffer-or-name norecord label) - "Pop to buffer specified by BUFFER-OR-NAME in the selected window." - (if (fboundp 'pop-to-buffer-same-window) - (funcall - 'pop-to-buffer-same-window buffer-or-name norecord) - (funcall 'switch-to-buffer buffer-or-name norecord))) - -;; RECURSIVE has been introduced with Emacs 23.2. -;; This is copying and adapted from `tramp-compat-delete-directory' -(defun org-delete-directory (directory &optional recursive) - "Compatibility function for `delete-directory'." - (if (null recursive) - (delete-directory directory) - (condition-case nil - (funcall 'delete-directory directory recursive) - ;; This Emacs version does not support the RECURSIVE flag. We - ;; use the implementation from Emacs 23.2. - (wrong-number-of-arguments - (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (org-delete-directory file recursive) - (delete-file file))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) - (delete-directory directory))))) - ;;;###autoload (defmacro org-check-version () "Try very hard to provide sensible version strings." @@ -534,29 +475,33 @@ With two arguments, return floor and remainder of their quotient." (defun org-release () "N/A") (defun org-git-version () "N/A !!check installation!!")))))) -(defun org-file-equal-p (f1 f2) - "Return t if files F1 and F2 are the same. -Implements `file-equal-p' for older emacsen and XEmacs." - (if (fboundp 'file-equal-p) - (file-equal-p f1 f2) - (let (f1-attr f2-attr) - (and (setq f1-attr (file-attributes (file-truename f1))) - (setq f2-attr (file-attributes (file-truename f2))) - (equal f1-attr f2-attr))))) - -;; `buffer-narrowed-p' is available for Emacs >=24.3 -(defun org-buffer-narrowed-p () - "Compatibility function for `buffer-narrowed-p'." - (if (fboundp 'buffer-narrowed-p) - (buffer-narrowed-p) - (/= (- (point-max) (point-min)) (buffer-size)))) - (defmacro org-with-silent-modifications (&rest body) (if (fboundp 'with-silent-modifications) `(with-silent-modifications ,@body) `(org-unmodified ,@body))) (def-edebug-spec org-with-silent-modifications (body)) +;; Functions for Emacs < 24.4 compatibility +(defun org-define-error (name message) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such +an error is signaled without being caught by a `condition-case'. +Implements `define-error' for older emacsen." + (if (fboundp 'define-error) (define-error name message) + (put name 'error-conditions + (copy-sequence (cons name (get 'error 'error-conditions)))))) + +(unless (fboundp 'string-suffix-p) + ;; From Emacs subr.el. + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + (provide 'org-compat) ;;; org-compat.el ends here diff --git a/lisp/org/org-crypt.el b/lisp/org/org-crypt.el index 36144e2530..3c431e4fdd 100644 --- a/lisp/org/org-crypt.el +++ b/lisp/org/org-crypt.el @@ -1,5 +1,4 @@ -;;; org-crypt.el --- Public key encryption for org-mode entries - +;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry @@ -7,7 +6,7 @@ ;; Keywords: org-mode ;; Author: John Wiegley ;; Maintainer: Peter Jones -;; Description: Adds public key encryption to org-mode buffers +;; Description: Adds public key encryption to Org buffers ;; URL: http://www.newartisans.com/software/emacs.html ;; Compatibility: Emacs22 @@ -104,10 +103,10 @@ t : Disable auto-save-mode for the current buffer nil : Leave auto-save-mode enabled. This may cause data to be written to disk unencrypted! -'ask : Ask user whether or not to disable auto-save-mode +`ask' : Ask user whether or not to disable auto-save-mode for the current buffer. -'encrypt : Leave auto-save-mode enabled for the current buffer, +`encrypt': Leave auto-save-mode enabled for the current buffer, but automatically re-encrypt all decrypted entries *before* auto-saving. NOTE: This only works for entries which have a tag @@ -142,7 +141,7 @@ See `org-crypt-disable-auto-save'." (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) ((eq org-crypt-disable-auto-save 'encrypt) (message "org-decrypt: Enabling re-encryption on auto-save.") - (org-add-hook 'auto-save-hook + (add-hook 'auto-save-hook (lambda () (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") (org-encrypt-entries)) @@ -164,96 +163,96 @@ See `org-crypt-disable-auto-save'." (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) (get-text-property 0 'org-crypt-text str) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (setq-local epg-context (epg-make-context nil t t)) (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) (defun org-encrypt-entry () "Encrypt the content of the current headline." (interactive) (require 'epg) - (save-excursion - (org-back-to-heading t) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) - (let ((start-heading (point))) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (outline-invisible-p)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (goto-char start-heading) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (org-encrypt-string (buffer-substring beg end) crypt-key)) - (delete-region beg end) - (insert encrypted-text) - (when folded - (goto-char start-heading) - (hide-subtree)) - nil))))) + (org-with-wide-buffer + (org-back-to-heading t) + (setq-local epg-context (epg-make-context nil t t)) + (let ((start-heading (point))) + (org-end-of-meta-data) + (unless (looking-at-p "-----BEGIN PGP MESSAGE-----") + (let ((folded (org-invisible-p)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point))) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (let ((contents (delete-and-extract-region beg (point)))) + (condition-case err + (insert (org-encrypt-string contents crypt-key)) + ;; If encryption failed, make sure to insert back entry + ;; contents in the buffer. + (error (insert contents) (error (nth 1 err))))) + (when folded + (goto-char start-heading) + (outline-hide-subtree)) + nil))))) (defun org-decrypt-entry () "Decrypt the content of the current headline." (interactive) (require 'epg) (unless (org-before-first-heading-p) - (save-excursion - (org-back-to-heading t) - (let ((heading-point (point)) - (heading-was-invisible-p - (save-excursion - (outline-end-of-heading) - (outline-invisible-p)))) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (org-crypt-check-auto-save) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) - (let* ((end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (encrypted-text (buffer-substring-no-properties (point) end)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - encrypted-text) - 'utf-8))) - ;; Delete region starting just before point, because the - ;; outline property starts at the \n of the heading. - (delete-region (1- (point)) end) - ;; Store a checksum of the decrypted and the encrypted - ;; text value. This allow reusing the same encrypted text - ;; if the text does not change, and therefore avoid a - ;; re-encryption process. - (insert "\n" (propertize decrypted-text - 'org-crypt-checksum (sha1 decrypted-text) - 'org-crypt-key (org-crypt-key-for-heading) - 'org-crypt-text encrypted-text)) - (when heading-was-invisible-p - (goto-char heading-point) - (org-flag-subtree t)) - nil)))))) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((heading-point (point)) + (heading-was-invisible-p + (save-excursion + (outline-end-of-heading) + (org-invisible-p)))) + (org-end-of-meta-data) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (org-crypt-check-auto-save) + (setq-local epg-context (epg-make-context nil t t)) + (let* ((end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (encrypted-text (buffer-substring-no-properties (point) end)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + encrypted-text) + 'utf-8))) + ;; Delete region starting just before point, because the + ;; outline property starts at the \n of the heading. + (delete-region (1- (point)) end) + ;; Store a checksum of the decrypted and the encrypted + ;; text value. This allows reusing the same encrypted text + ;; if the text does not change, and therefore avoid a + ;; re-encryption process. + (insert "\n" (propertize decrypted-text + 'org-crypt-checksum (sha1 decrypted-text) + 'org-crypt-key (org-crypt-key-for-heading) + 'org-crypt-text encrypted-text)) + (when heading-was-invisible-p + (goto-char heading-point) + (org-flag-subtree t)) + nil)))))) (defun org-encrypt-entries () "Encrypt all top-level entries in the current buffer." (interactive) - (let (todo-only) + (let ((org--matcher-tags-todo-only nil)) (org-scan-tags 'org-encrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) + org--matcher-tags-todo-only))) (defun org-decrypt-entries () "Decrypt all entries in the current buffer." (interactive) - (let (todo-only) + (let ((org--matcher-tags-todo-only nil)) (org-scan-tags 'org-decrypt-entry (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) + org--matcher-tags-todo-only))) (defun org-at-encrypted-entry-p () "Is the current entry encrypted?" @@ -267,7 +266,7 @@ See `org-crypt-disable-auto-save'." "Add a hook to automatically encrypt entries before a file is saved to disk." (add-hook 'org-mode-hook - (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t)))) + (lambda () (add-hook 'before-save-hook 'org-encrypt-entries nil t)))) (add-hook 'org-reveal-start-hook 'org-decrypt-entry) diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 1ecf674482..98eb8068a8 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -1,4 +1,4 @@ -;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. +;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2007-2017 Free Software Foundation, Inc. @@ -26,20 +26,21 @@ ;; Synopsis ;; ======== ;; -;; Allows org-mode to make use of the Emacs `etags' system. Defines tag -;; destinations in org-mode files as any text between <>. This allows the tags-generation program `exuberant ctags' to -;; parse these files and create tag tables that record where these -;; destinations are found. Plain [[links]] in org mode files which do not have -;; <> within the same file will then be interpreted as -;; links to these 'tagged' destinations, allowing seamless navigation between -;; multiple org-mode files. Topics can be created in any org mode file and -;; will always be found by plain links from other files. Other file types -;; recognized by ctags (source code files, latex files, etc) will also be -;; available as destinations for plain links, and similarly, org-mode links -;; will be available as tags from source files. Finally, the function -;; `org-ctags-find-tag-interactive' lets you choose any known tag, using -;; autocompletion, and quickly jump to it. +;; Allows Org mode to make use of the Emacs `etags' system. Defines +;; tag destinations in Org files as any text between <>. This allows the tags-generation program `exuberant +;; ctags' to parse these files and create tag tables that record where +;; these destinations are found. Plain [[links]] in org mode files +;; which do not have <> within the same file +;; will then be interpreted as links to these 'tagged' destinations, +;; allowing seamless navigation between multiple Org files. Topics +;; can be created in any org mode file and will always be found by +;; plain links from other files. Other file types recognized by ctags +;; (source code files, latex files, etc) will also be available as +;; destinations for plain links, and similarly, Org links will be +;; available as tags from source files. Finally, the function +;; `org-ctags-find-tag-interactive' lets you choose any known tag, +;; using autocompletion, and quickly jump to it. ;; ;; Installation ;; ============ @@ -110,8 +111,9 @@ ;; Keeping the TAGS file up to date ;; ================================ ;; -;; Tags mode has no way of knowing that you have created new tags by typing in -;; your org-mode buffer. New tags make it into the TAGS file in 3 ways: +;; Tags mode has no way of knowing that you have created new tags by +;; typing in your Org buffer. New tags make it into the TAGS file in +;; 3 ways: ;; ;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. ;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in @@ -135,12 +137,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) - (require 'org) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) - (defgroup org-ctags nil "Options concerning use of ctags within org mode." :tag "Org-Ctags" @@ -151,7 +149,7 @@ (defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" "Regexp expression used by ctags external program. -The regexp matches tag destinations in org-mode files. +The regexp matches tag destinations in Org files. Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ See the ctags documentation for more information.") @@ -210,8 +208,8 @@ The following patterns are replaced in the string: (defadvice visit-tags-table (after org-ctags-load-tag-list activate compile) (when (and org-ctags-enabled-p tags-file-name) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table)))) + (setq-local org-ctags-tag-list + (org-ctags-all-tags-in-current-tags-table)))) (defun org-ctags-enable () @@ -273,11 +271,6 @@ Return the list." (replace-regexp-in-string (regexp-quote search) replace string t t)) -(defun y-or-n-minibuffer (prompt) - (let ((use-dialog-box nil)) - (y-or-n-p prompt))) - - ;;; Internal functions ======================================================= @@ -285,29 +278,28 @@ Return the list." "Visit or create a file called `NAME.org', and insert a new topic. The new topic will be titled NAME (or TITLE if supplied)." (interactive "sFile name: ") - (let ((filename (substitute-in-file-name (expand-file-name name)))) - (condition-case v - (progn - (org-open-file name t) - (message "Opened file OK") - (goto-char (point-max)) - (insert (org-ctags-string-search-and-replace - "%t" (capitalize (or title name)) - org-ctags-new-topic-template)) - (message "Inserted new file text OK") - (org-mode-restart)) - (error (error "Error %S in org-ctags-open-file" v))))) + (condition-case v + (progn + (org-open-file name t) + (message "Opened file OK") + (goto-char (point-max)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize (or title name)) + org-ctags-new-topic-template)) + (message "Inserted new file text OK") + (org-mode-restart)) + (error (error "Error %S in org-ctags-open-file" v)))) ;;;; Misc interoperability with etags system ================================= -(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag - activate compile) +(defadvice xref-find-definitions + (before org-ctags-set-org-mark-before-finding-tag activate compile) "Before trying to find a tag, save our current position on org mark ring." (save-excursion - (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) - (org-mark-ring-push)))) + (when (and (derived-mode-p 'org-mode) org-ctags-enabled-p) + (org-mark-ring-push)))) @@ -359,7 +351,7 @@ visit the file and location where the tag is found." (old-pnt (point-marker)) (old-mark (copy-marker (mark-marker)))) (condition-case nil - (progn (find-tag name) + (progn (xref-find-definitions name) t) (error ;; only restore old location if find-tag raises error @@ -386,7 +378,7 @@ the new file." (cond ((get-buffer (concat name ".org")) ;; Buffer is already open - (org-pop-to-buffer-same-window (get-buffer (concat name ".org")))) + (pop-to-buffer-same-window (get-buffer (concat name ".org")))) ((file-exists-p filename) ;; File exists but is not open --> open it (message "Opening existing org file `%S'..." @@ -421,7 +413,6 @@ the heading a destination for the tag `NAME'." (insert (org-ctags-string-search-and-replace "%t" (capitalize name) org-ctags-new-topic-template)) (backward-char 4) - (org-update-radio-target-regexp) (end-of-line) (forward-line 2) (when narrowp @@ -464,10 +455,10 @@ Wrapper for org-ctags-rebuild-tags-file-then-find-tag." nil)) -(defun org-ctags-fail-silently (name) +(defun org-ctags-fail-silently (_name) "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Put as the last function in the list if you want to prevent org's default -behavior of free text search." +Put as the last function in the list if you want to prevent Org's +default behavior of free text search." t) @@ -484,7 +475,7 @@ end up in one file, called TAGS, located in the directory. This function may take several seconds to finish if the directory or its subdirectories contain large numbers of taggable files." (interactive) - (assert (buffer-file-name)) + (cl-assert (buffer-file-name)) (let ((dir-name (or directory-name (file-name-directory (buffer-file-name)))) (exitcode nil)) @@ -499,8 +490,8 @@ its subdirectories contain large numbers of taggable files." (expand-file-name (concat dir-name "/*"))))) (cond ((eql 0 exitcode) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table))) + (setq-local org-ctags-tag-list + (org-ctags-all-tags-in-current-tags-table))) (t ;; This seems to behave differently on Linux, so just ignore ;; error codes for now @@ -528,7 +519,7 @@ a new topic." ((member tag org-ctags-tag-list) ;; Existing tag (push tag org-ctags-find-tag-history) - (find-tag tag)) + (xref-find-definitions tag)) (t ;; New tag (run-hook-with-args-until-success diff --git a/lisp/org/org-datetree.el b/lisp/org/org-datetree.el index 891e64f909..540753d67c 100644 --- a/lisp/org/org-datetree.el +++ b/lisp/org/org-datetree.el @@ -1,4 +1,4 @@ -;;; org-datetree.el --- Create date entries in a tree +;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -34,12 +34,14 @@ (defvar org-datetree-base-level 1 "The level at which years should be placed in the date tree. -This is normally one, but if the buffer has an entry with a DATE_TREE -property (any value), the date tree will become a subtree under that entry, -so the base level will be properly adjusted.") +This is normally one, but if the buffer has an entry with a +DATE_TREE (or WEEK_TREE for ISO week entries) property (any +value), the date tree will become a subtree under that entry, so +the base level will be properly adjusted.") (defcustom org-datetree-add-timestamp nil - "When non-nil, add a time stamp when create a datetree entry." + "When non-nil, add a time stamp matching date of entry. +Added time stamp is active unless value is `inactive'." :group 'org-capture :version "24.3" :type '(choice @@ -48,115 +50,129 @@ so the base level will be properly adjusted.") (const :tag "Add an active time stamp" active))) ;;;###autoload -(defun org-datetree-find-date-create (date &optional keep-restriction) - "Find or create an entry for DATE. +(defun org-datetree-find-date-create (d &optional keep-restriction) + "Find or create an entry for date D. If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is nil, the buffer will be widened to make sure an existing date tree can be found." - (let ((year (nth 2 date)) - (month (car date)) - (day (nth 1 date))) - (org-set-local 'org-datetree-base-level 1) - (or keep-restriction (widen)) + (setq-local org-datetree-base-level 1) + (or keep-restriction (widen)) + (save-restriction + (let ((prop (org-find-property "DATE_TREE"))) + (when prop + (goto-char prop) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) + (org-narrow-to-subtree))) (goto-char (point-min)) - (save-restriction - (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t) - (org-back-to-heading t) - (org-set-local 'org-datetree-base-level - (org-get-valid-level (funcall outline-level) 1)) - (org-narrow-to-subtree)) - (goto-char (point-min)) - (org-datetree-find-year-create year) - (org-datetree-find-month-create year month) - (org-datetree-find-day-create year month day) - (goto-char (prog1 (point) (widen)))))) - -(defun org-datetree-find-year-create (year) - "Find the YEAR datetree or create it." - (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") - match) - (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) year))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year)) - ((= (string-to-number (match-string 1)) year) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year))))) + (let ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d))) + (org-datetree--find-create + "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ +\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" + year) + (org-datetree--find-create + "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" + year month) + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day)))) -(defun org-datetree-find-month-create (year month) - "Find the datetree for YEAR and MONTH or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) - match) +;;;###autoload +(defun org-datetree-find-iso-week-create (d &optional keep-restriction) + "Find or create an ISO week entry for date D. +Compared to `org-datetree-find-date-create' this function creates +entries ordered by week instead of months. +If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it +is nil, the buffer will be widened to make sure an existing date +tree can be found." + (setq-local org-datetree-base-level 1) + (or keep-restriction (widen)) + (save-restriction + (let ((prop (org-find-property "WEEK_TREE"))) + (when prop + (goto-char prop) + (setq-local org-datetree-base-level + (org-get-valid-level (org-current-level) 1)) + (org-narrow-to-subtree))) (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) month))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month)) - ((= (string-to-number (match-string 1)) month) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year month))))) - -(defun org-datetree-find-day-create (year month day) - "Find the datetree for YEAR, MONTH and DAY or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) + (require 'cal-iso) + (let* ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d)) + (time (encode-time 0 0 0 day month year)) + (iso-date (calendar-iso-from-absolute + (calendar-absolute-from-gregorian d))) + (weekyear (nth 2 iso-date)) + (week (nth 0 iso-date))) + ;; ISO 8601 week format is %G-W%V(-%u) + (org-datetree--find-create + "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\ +\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)" + weekyear nil nil + (format-time-string "%G" time)) + (org-datetree--find-create + "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$" + weekyear week nil + (format-time-string "%G-W%V" time)) + ;; For the actual day we use the regular date instead of ISO week. + (org-datetree--find-create + "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" + year month day)))) + +(defun org-datetree--find-create (regex year &optional month day insert) + "Find the datetree matched by REGEX for YEAR, MONTH, or DAY. +REGEX is passed to `format' with YEAR, MONTH, and DAY as +arguments. Match group 1 is compared against the specified date +component. If INSERT is non-nil and there is no match then it is +inserted into the buffer." + (when (or month day) + (org-narrow-to-subtree)) + (let ((re (format regex year month day)) match) (goto-char (point-min)) (while (and (setq match (re-search-forward re nil t)) (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) day))) + (< (string-to-number (match-string 1)) (or day month year)))) (cond ((not match) (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month day)) - ((= (string-to-number (match-string 1)) day) - (goto-char (point-at-bol))) + (unless (bolp) (insert "\n")) + (org-datetree-insert-line year month day insert)) + ((= (string-to-number (match-string 1)) (or day month year)) + (beginning-of-line)) (t - (beginning-of-line 1) - (org-datetree-insert-line year month day))))) - -(defun org-datetree-insert-line (year &optional month day) - (let ((pos (point)) ts-type) - (skip-chars-backward " \t\n") - (delete-region (point) pos) - (insert "\n" (make-string org-datetree-base-level ?*) " \n") - (backward-char 1) - (if month (org-do-demote)) - (if day (org-do-demote)) + (beginning-of-line) + (org-datetree-insert-line year month day insert))))) + +(defun org-datetree-insert-line (year &optional month day text) + (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) + (insert "\n" (make-string org-datetree-base-level ?*) " \n") + (backward-char) + (when month (org-do-demote)) + (when day (org-do-demote)) + (if text + (insert text) (insert (format "%d" year)) (when month - (insert (format "-%02d" month)) - (if day - (insert (format "-%02d %s" - day (format-time-string - "%A" (encode-time 0 0 0 day month year)))) - (insert (format " %s" - (format-time-string - "%B" (encode-time 0 0 0 1 month year)))))) - (when (and day (setq ts-type org-datetree-add-timestamp)) + (insert + (if day + (format-time-string "-%m-%d %A" (encode-time 0 0 0 day month year)) + (format-time-string "-%m %B" (encode-time 0 0 0 1 month year)))))) + (when (and day org-datetree-add-timestamp) + (save-excursion (insert "\n") (org-indent-line) - (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) - (beginning-of-line 1))) - -(defun org-datetree-file-entry-under (txt date) - "Insert a node TXT into the date tree under DATE." - (org-datetree-find-date-create date) + (org-insert-time-stamp + (encode-time 0 0 0 day month year) + nil + (eq org-datetree-add-timestamp 'inactive)))) + (beginning-of-line)) + +(defun org-datetree-file-entry-under (txt d) + "Insert a node TXT into the date tree under date D." + (org-datetree-find-date-create d) (let ((level (org-get-valid-level (funcall outline-level) 1))) (org-end-of-subtree t t) (org-back-over-empty-lines) @@ -169,44 +185,42 @@ before running this command, even though the command tries to be smart." (interactive) (goto-char (point-min)) (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) - (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) - dct ts tmp date year month day pos hdl-pos) + (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'"))) (while (re-search-forward org-ts-regexp nil t) (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) + (let ((tmp (buffer-substring + (max (line-beginning-position) + (- (match-beginning 0) org-ds-keyword-length)) + (match-beginning 0)))) + (when (or (string-suffix-p "-" tmp) + (string-match dre tmp) + (string-match sre tmp)) (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing - (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) + (let* ((dct (decode-time (org-time-string-to-time (match-string 0)))) + (date (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) + (year (nth 2 date)) + (month (car date)) + (day (nth 1 date)) + (pos (point)) + (hdl-pos (progn (org-back-to-heading t) (point)))) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree. + (goto-char pos) + (throw 'next nil)) + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing. + (goto-char pos) + (throw 'next nil)) + ;; OK, we need to refile this entry. + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))))) (provide 'org-datetree) diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index c5d01158c9..dfad89332a 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -1,4 +1,4 @@ -;;; org-docview.el --- support for links to doc-view-mode buffers +;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -25,7 +25,7 @@ ;;; Commentary: ;; This file implements links to open files in doc-view-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; The links take the form @@ -49,13 +49,15 @@ (declare-function doc-view-goto-page "doc-view" (page)) (declare-function image-mode-window-get "image-mode" (prop &optional winprops)) -(org-add-link-type "docview" 'org-docview-open 'org-docview-export) -(add-hook 'org-store-link-functions 'org-docview-store-link) +(org-link-set-parameters "docview" + :follow #'org-docview-open + :export #'org-docview-export + :store #'org-docview-store-link) (defun org-docview-export (link description format) "Export a docview link from Org files." - (let* ((path (when (string-match "\\(.+\\)::.+" link) - (match-string 1 link))) + (let* ((path (if (string-match "\\(.+\\)::.+" link) (match-string 1 link) + link)) (desc (or description link))) (when (stringp path) (setq path (org-link-escape (expand-file-name path))) @@ -66,13 +68,14 @@ (t path))))) (defun org-docview-open (link) - (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link) - (let* ((path (match-string 1 link)) - (page (string-to-number (match-string 2 link)))) - (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1) - ;; to ensure org-link-frame-setup is respected - (doc-view-goto-page page) - ))) + (string-match "\\(.*?\\)\\(?:::\\([0-9]+\\)\\)?$" link) + (let ((path (match-string 1 link)) + (page (and (match-beginning 2) + (string-to-number (match-string 2 link))))) + ;; Let Org mode open the file (in-emacs = 1) to ensure + ;; org-link-frame-setup is respected. + (org-open-file path 1) + (when page (doc-view-goto-page page)))) (defun org-docview-store-link () "Store a link to a docview buffer." @@ -80,8 +83,7 @@ ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) (page (image-mode-window-get 'page)) - (link (concat "docview:" path "::" (number-to-string page))) - (description "")) + (link (concat "docview:" path "::" (number-to-string page)))) (org-store-link-props :type "docview" :link link diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index e9731c1783..41b4a3ac78 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -1,4 +1,4 @@ -;;; org-element.el --- Parser And Applications for Org syntax +;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -22,80 +22,21 @@ ;;; Commentary: ;; -;; Org syntax can be divided into three categories: "Greater -;; elements", "Elements" and "Objects". +;; See for details about +;; Org syntax. ;; -;; Elements are related to the structure of the document. Indeed, all -;; elements are a cover for the document: each position within belongs -;; to at least one element. -;; -;; An element always starts and ends at the beginning of a line. With -;; a few exceptions (`clock', `headline', `inlinetask', `item', -;; `planning', `node-property', `quote-section' `section' and -;; `table-row' types), it can also accept a fixed set of keywords as -;; attributes. Those are called "affiliated keywords" to distinguish -;; them from other keywords, which are full-fledged elements. Almost -;; all affiliated keywords are referenced in -;; `org-element-affiliated-keywords'; the others are export attributes -;; and start with "ATTR_" prefix. -;; -;; Element containing other elements (and only elements) are called -;; greater elements. Concerned types are: `center-block', `drawer', -;; `dynamic-block', `footnote-definition', `headline', `inlinetask', -;; `item', `plain-list', `property-drawer', `quote-block', `section' -;; and `special-block'. -;; -;; Other element types are: `babel-call', `clock', `comment', -;; `comment-block', `diary-sexp', `example-block', `export-block', -;; `fixed-width', `horizontal-rule', `keyword', `latex-environment', -;; `node-property', `paragraph', `planning', `quote-section', -;; `src-block', `table', `table-row' and `verse-block'. Among them, -;; `paragraph' and `verse-block' types can contain Org objects and -;; plain text. -;; -;; Objects are related to document's contents. Some of them are -;; recursive. Associated types are of the following: `bold', `code', -;; `entity', `export-snippet', `footnote-reference', -;; `inline-babel-call', `inline-src-block', `italic', -;; `latex-fragment', `line-break', `link', `macro', `radio-target', -;; `statistics-cookie', `strike-through', `subscript', `superscript', -;; `table-cell', `target', `timestamp', `underline' and `verbatim'. -;; -;; Some elements also have special properties whose value can hold -;; objects themselves (e.g. an item tag or a headline name). Such -;; values are called "secondary strings". Any object belongs to -;; either an element or a secondary string. -;; -;; Notwithstanding affiliated keywords, each greater element, element -;; and object has a fixed set of properties attached to it. Among -;; them, four are shared by all types: `:begin' and `:end', which -;; refer to the beginning and ending buffer positions of the -;; considered element or object, `:post-blank', which holds the number -;; of blank lines, or white spaces, at its end and `:parent' which -;; refers to the element or object containing it. Greater elements, -;; elements and objects containing objects will also have -;; `:contents-begin' and `:contents-end' properties to delimit -;; contents. Eventually, greater elements and elements accepting -;; affiliated keywords will have a `:post-affiliated' property, -;; referring to the buffer position after all such keywords. -;; -;; At the lowest level, a `:parent' property is also attached to any -;; string, as a text property. -;; -;; Lisp-wise, an element or an object can be represented as a list. +;; Lisp-wise, a syntax object can be represented as a list. ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: -;; TYPE is a symbol describing the Org element or object. +;; TYPE is a symbol describing the object. ;; PROPERTIES is the property list attached to it. See docstring of -;; appropriate parsing function to get an exhaustive -;; list. -;; CONTENTS is a list of elements, objects or raw strings contained -;; in the current element or object, when applicable. +;; appropriate parsing function to get an exhaustive list. +;; CONTENTS is a list of syntax objects or raw strings contained +;; in the current object, when applicable. ;; -;; An Org buffer is a nested list of such elements and objects, whose -;; type is `org-data' and properties is nil. +;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. ;; -;; The first part of this file defines Org syntax, while the second -;; one provide accessors and setters functions. +;; The first part of this file defines constants for the Org syntax, +;; while the second one provide accessors and setters functions. ;; ;; The next part implements a parser and an interpreter for each ;; element and object type in Org syntax. @@ -111,13 +52,15 @@ ;; ;; The library ends by furnishing `org-element-at-point' function, and ;; a way to give information about document structure around point -;; with `org-element-context'. +;; with `org-element-context'. A cache mechanism is also provided for +;; these functions. ;;; Code: -(eval-when-compile (require 'cl)) (require 'org) +(require 'avl-tree) +(require 'cl-lib) @@ -127,56 +70,116 @@ ;; along with the affiliated keywords recognized. Also set up ;; restrictions on recursive objects combinations. ;; -;; These variables really act as a control center for the parsing -;; process. - -(defconst org-element-paragraph-separate - (concat "^\\(?:" - ;; Headlines, inlinetasks. - org-outline-regexp "\\|" - ;; Footnote definitions. - "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" - ;; Diary sexps. - "%%(" "\\|" - "[ \t]*\\(?:" - ;; Empty lines. - "$" "\\|" - ;; Tables (any type). - "\\(?:|\\|\\+-[-+]\\)" "\\|" - ;; Blocks (any type), Babel calls and keywords. Note: this - ;; is only an indication and need some thorough check. - "#\\(?:[+ ]\\|$\\)" "\\|" - ;; Drawers (any type) and fixed-width areas. This is also - ;; only an indication. - ":" "\\|" - ;; Horizontal rules. - "-\\{5,\\}[ \t]*$" "\\|" - ;; LaTeX environments. - "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|" - ;; Planning and Clock lines. - (regexp-opt (list org-scheduled-string - org-deadline-string - org-closed-string - org-clock-string)) - "\\|" - ;; Lists. - (let ((term (case org-plain-list-ordered-item-terminator - (?\) ")") (?. "\\.") (otherwise "[.)]"))) - (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) - (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" - "\\(?:[ \t]\\|$\\)")) - "\\)\\)") +;; `org-element-update-syntax' builds proper syntax regexps according +;; to current setup. + +(defvar org-element-paragraph-separate nil "Regexp to separate paragraphs in an Org buffer. In the case of lines starting with \"#\" and \":\", this regexp is not sufficient to know if point is at a paragraph ending. See `org-element-paragraph-parser' for more information.") +(defvar org-element--object-regexp nil + "Regexp possibly matching the beginning of an object. +This regexp allows false positives. Dedicated parser (e.g., +`org-export-bold-parser') will take care of further filtering. +Radio links are not matched by this regexp, as they are treated +specially in `org-element--object-lex'.") + +(defun org-element--set-regexps () + "Build variable syntax regexps." + (setq org-element-paragraph-separate + (concat "^\\(?:" + ;; Headlines, inlinetasks. + org-outline-regexp "\\|" + ;; Footnote definitions. + "\\[fn:[-_[:word:]]+\\]" "\\|" + ;; Diary sexps. + "%%(" "\\|" + "[ \t]*\\(?:" + ;; Empty lines. + "$" "\\|" + ;; Tables (any type). + "|" "\\|" + "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|" + ;; Comments, keyword-like or block-like constructs. + ;; Blocks and keywords with dual values need to be + ;; double-checked. + "#\\(?: \\|$\\|\\+\\(?:" + "BEGIN_\\S-+" "\\|" + "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)" + "\\|" + ;; Drawers (any type) and fixed-width areas. Drawers + ;; need to be double-checked. + ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|" + ;; Horizontal rules. + "-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|" + ;; Clock lines. + (regexp-quote org-clock-string) "\\|" + ;; Lists. + (let ((term (pcase org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (_ "[.)]"))) + (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) + (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" + "\\(?:[ \t]\\|$\\)")) + "\\)\\)") + org-element--object-regexp + (mapconcat #'identity + (let ((link-types (regexp-opt (org-link-types)))) + (list + ;; Sub/superscript. + "\\(?:[_^][-{(*+.,[:alnum:]]\\)" + ;; Bold, code, italic, strike-through, underline + ;; and verbatim. + (concat "[*~=+_/]" + (format "[^%s]" + (nth 2 org-emphasis-regexp-components))) + ;; Plain links. + (concat "\\<" link-types ":") + ;; Objects starting with "[": regular link, + ;; footnote reference, statistics cookie, + ;; timestamp (inactive). + (concat "\\[\\(?:" + "fn:" "\\|" + "\\[" "\\|" + "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|" + "[0-9]*\\(?:%\\|/[0-9]*\\)\\]" + "\\)") + ;; Objects starting with "@": export snippets. + "@@" + ;; Objects starting with "{": macro. + "{{{" + ;; Objects starting with "<" : timestamp + ;; (active, diary), target, radio target and + ;; angular links. + (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)") + ;; Objects starting with "$": latex fragment. + "\\$" + ;; Objects starting with "\": line break, + ;; entity, latex fragment. + "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)" + ;; Objects starting with raw text: inline Babel + ;; source block, inline Babel call. + "\\(?:call\\|src\\)_")) + "\\|"))) + +(org-element--set-regexps) + +;;;###autoload +(defun org-element-update-syntax () + "Update parser internals." + (interactive) + (org-element--set-regexps) + (org-element-cache-reset 'all)) + (defconst org-element-all-elements '(babel-call center-block clock comment comment-block diary-sexp drawer dynamic-block example-block export-block fixed-width footnote-definition headline horizontal-rule inlinetask item keyword latex-environment node-property paragraph plain-list - planning property-drawer quote-block quote-section section + planning property-drawer quote-block section special-block src-block table table-row verse-block) "Complete list of element types.") @@ -186,23 +189,6 @@ is not sufficient to know if point is at a paragraph ending. See special-block table) "List of recursive element types aka Greater Elements.") -(defconst org-element-all-successors - '(link export-snippet footnote-reference inline-babel-call - inline-src-block latex-or-entity line-break macro plain-link - radio-target statistics-cookie sub/superscript table-cell target - text-markup timestamp) - "Complete list of successors.") - -(defconst org-element-object-successor-alist - '((subscript . sub/superscript) (superscript . sub/superscript) - (bold . text-markup) (code . text-markup) (italic . text-markup) - (strike-through . text-markup) (underline . text-markup) - (verbatim . text-markup) (entity . latex-or-entity) - (latex-fragment . latex-or-entity)) - "Alist of translations between object type and successor name. -Sharing the same successor comes handy when, for example, the -regexp matching one object can also match the other object.") - (defconst org-element-all-objects '(bold code entity export-snippet footnote-reference inline-babel-call inline-src-block italic line-break latex-fragment link macro @@ -211,26 +197,13 @@ regexp matching one object can also match the other object.") "Complete list of object types.") (defconst org-element-recursive-objects - '(bold italic link subscript radio-target strike-through superscript - table-cell underline) + '(bold footnote-reference italic link subscript radio-target strike-through + superscript table-cell underline) "List of recursive object types.") -(defvar org-element-block-name-alist - '(("CENTER" . org-element-center-block-parser) - ("COMMENT" . org-element-comment-block-parser) - ("EXAMPLE" . org-element-example-block-parser) - ("QUOTE" . org-element-quote-block-parser) - ("SRC" . org-element-src-block-parser) - ("VERSE" . org-element-verse-block-parser)) - "Alist between block names and the associated parsing function. -Names must be uppercase. Any block whose name has no association -is parsed with `org-element-special-block-parser'.") - -(defconst org-element-link-type-is-file - '("file" "file+emacs" "file+sys" "docview") - "List of link types equivalent to \"file\". -Only these types can accept search options and an explicit -application to open them.") +(defconst org-element-object-containers + (append org-element-recursive-objects '(paragraph table-row verse-block)) + "List of object or element types that can directly contain objects.") (defconst org-element-affiliated-keywords '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" @@ -268,6 +241,13 @@ strings and objects. This list is checked after translations have been applied. See `org-element-keyword-translation-alist'.") +(defconst org-element--parsed-properties-alist + (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k))))) + org-element-parsed-keywords) + "Alist of parsed keywords and associated properties. +This is generated from `org-element-parsed-keywords', which +see.") + (defconst org-element-dual-keywords '("CAPTION" "RESULTS") "List of affiliated keywords which can have a secondary value. @@ -280,13 +260,8 @@ associated to a hash value with the following: This list is checked after translations have been applied. See `org-element-keyword-translation-alist'.") -(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE") - "List of properties associated to the whole document. -Any keyword in this list will have its value parsed and stored as -a secondary string.") - (defconst org-element--affiliated-re - (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)" + (format "[ \t]*#\\+\\(?:%s\\):[ \t]*" (concat ;; Dual affiliated keywords. (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" @@ -295,9 +270,8 @@ a secondary string.") ;; Regular affiliated keywords. (format "\\(?1:%s\\)" (regexp-opt - (org-remove-if - #'(lambda (keyword) - (member keyword org-element-dual-keywords)) + (cl-remove-if + (lambda (k) (member k org-element-dual-keywords)) org-element-affiliated-keywords))) "\\|" ;; Export attributes. @@ -311,8 +285,7 @@ match group 2. Don't modify it, set `org-element-affiliated-keywords' instead.") (defconst org-element-object-restrictions - (let* ((standard-set - (remq 'plain-link (remq 'table-cell org-element-all-successors))) + (let* ((standard-set (remq 'table-cell org-element-all-objects)) (standard-set-no-line-break (remq 'line-break standard-set))) `((bold ,@standard-set) (footnote-reference ,@standard-set) @@ -320,30 +293,34 @@ Don't modify it, set `org-element-affiliated-keywords' instead.") (inlinetask ,@standard-set-no-line-break) (italic ,@standard-set) (item ,@standard-set-no-line-break) - (keyword ,@standard-set) - ;; Ignore all links excepted plain links in a link description. - ;; Also ignore radio-targets and line breaks. - (link export-snippet inline-babel-call inline-src-block latex-or-entity - macro plain-link statistics-cookie sub/superscript text-markup) + (keyword ,@(remq 'footnote-reference standard-set)) + ;; Ignore all links excepted plain links and angular links in + ;; a link description. Also ignore radio-targets and line + ;; breaks. + (link bold code entity export-snippet inline-babel-call inline-src-block + italic latex-fragment macro simple-link statistics-cookie + strike-through subscript superscript underline verbatim) (paragraph ,@standard-set) ;; Remove any variable object from radio target as it would ;; prevent it from being properly recognized. - (radio-target latex-or-entity sub/superscript text-markup) + (radio-target bold code entity italic latex-fragment strike-through + subscript superscript underline superscript) (strike-through ,@standard-set) (subscript ,@standard-set) (superscript ,@standard-set) ;; Ignore inline babel call and inline src block as formulas are ;; possible. Also ignore line breaks and statistics cookies. - (table-cell link export-snippet footnote-reference latex-or-entity macro - radio-target sub/superscript target text-markup timestamp) + (table-cell bold code entity export-snippet footnote-reference italic + latex-fragment link macro radio-target strike-through + subscript superscript target timestamp underline verbatim) (table-row table-cell) (underline ,@standard-set) (verse-block ,@standard-set))) "Alist of objects restrictions. -CAR is an element or object type containing objects and CDR is -a list of successors that will be called within an element or -object of such type. +key is an element or object type containing objects and value is +a list of types that can be contained within an element or object +of such type. For example, in a `radio-target' object, one can only find entities, latex-fragments, subscript, superscript and text @@ -354,12 +331,56 @@ This alist also applies to secondary string. For example, an still has an entry since one of its properties (`:title') does.") (defconst org-element-secondary-value-alist - '((headline . :title) - (inlinetask . :title) - (item . :tag) - (footnote-reference . :inline-definition)) - "Alist between element types and location of secondary value.") - + '((headline :title) + (inlinetask :title) + (item :tag)) + "Alist between element types and locations of secondary values.") + +(defconst org-element--pair-round-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only round brackets. +Other brackets are treated as spaces.") + +(defconst org-element--pair-square-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only square brackets. +Other brackets are treated as spaces.") + +(defconst org-element--pair-curly-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only curly brackets. +Other brackets are treated as spaces.") + +(defun org-element--parse-paired-brackets (char) + "Parse paired brackets at point. +CHAR is the opening bracket to consider, as a character. Return +contents between brackets, as a string, or nil. Also move point +past the brackets." + (when (eq char (char-after)) + (let ((syntax-table (pcase char + (?\{ org-element--pair-curly-table) + (?\[ org-element--pair-square-table) + (?\( org-element--pair-round-table) + (_ nil))) + (pos (point))) + (when syntax-table + (with-syntax-table syntax-table + (let ((end (ignore-errors (scan-lists pos 1 0)))) + (when end + (goto-char end) + (buffer-substring-no-properties (1+ pos) (1- end))))))))) ;;; Accessors and Setters @@ -368,10 +389,18 @@ still has an entry since one of its properties (`:title') does.") ;; `org-element-contents' and `org-element-restriction'. ;; ;; Setter functions allow modification of elements by side effect. -;; There is `org-element-put-property', `org-element-set-contents', -;; `org-element-set-element' and `org-element-adopt-element'. Note -;; that `org-element-set-element' and `org-element-adopt-elements' are -;; higher level functions since also update `:parent' property. +;; There is `org-element-put-property', `org-element-set-contents'. +;; These low-level functions are useful to build a parse tree. +;; +;; `org-element-adopt-elements', `org-element-set-element', +;; `org-element-extract-element' and `org-element-insert-before' are +;; high-level functions useful to modify a parse tree. +;; +;; `org-element-secondary-p' is a predicate used to know if a given +;; object belongs to a secondary string. `org-element-class' tells if +;; some parsed data is an element or an object, handling pseudo +;; elements and objects. `org-element-copy' returns an element or +;; object, stripping its parent property in the process. (defsubst org-element-type (element) "Return type of ELEMENT. @@ -411,29 +440,49 @@ Return modified element." element)) (defsubst org-element-set-contents (element &rest contents) - "Set ELEMENT contents to CONTENTS. -Return modified element." - (cond ((not element) (list contents)) + "Set ELEMENT's contents to CONTENTS. +Return ELEMENT." + (cond ((null element) contents) ((not (symbolp (car element))) contents) - ((cdr element) (setcdr (cdr element) contents)) + ((cdr element) (setcdr (cdr element) contents) element) (t (nconc element contents)))) -(defsubst org-element-set-element (old new) - "Replace element or object OLD with element or object NEW. -The function takes care of setting `:parent' property for NEW." - ;; Since OLD is going to be changed into NEW by side-effect, first - ;; make sure that every element or object within NEW has OLD as - ;; parent. - (mapc (lambda (blob) (org-element-put-property blob :parent old)) - (org-element-contents new)) - ;; Transfer contents. - (apply 'org-element-set-contents old (org-element-contents new)) - ;; Ensure NEW has same parent as OLD, then overwrite OLD properties - ;; with NEW's. - (org-element-put-property new :parent (org-element-property :parent old)) - (setcar (cdr old) (nth 1 new)) - ;; Transfer type. - (setcar old (car new))) +(defun org-element-secondary-p (object) + "Non-nil when OBJECT directly belongs to a secondary string. +Return value is the property name, as a keyword, or nil." + (let* ((parent (org-element-property :parent object)) + (properties (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)))) + (catch 'exit + (dolist (p properties) + (and (memq object (org-element-property p parent)) + (throw 'exit p)))))) + +(defun org-element-class (datum &optional parent) + "Return class for ELEMENT, as a symbol. +Class is either `element' or `object'. Optional argument PARENT +is the element or object containing DATUM. It defaults to the +value of DATUM `:parent' property." + (let ((type (org-element-type datum)) + (parent (or parent (org-element-property :parent datum)))) + (cond + ;; Trivial cases. + ((memq type org-element-all-objects) 'object) + ((memq type org-element-all-elements) 'element) + ;; Special cases. + ((eq type 'org-data) 'element) + ((eq type 'plain-text) 'object) + ((not type) 'object) + ;; Pseudo object or elements. Make a guess about its class. + ;; Basically a pseudo object is contained within another object, + ;; a secondary string or a container element. + ((not parent) 'element) + (t + (let ((parent-type (org-element-type parent))) + (cond ((not parent-type) 'object) + ((memq parent-type org-element-object-containers) 'object) + ((org-element-secondary-p datum) 'object) + (t 'element))))))) (defsubst org-element-adopt-elements (parent &rest children) "Append elements to the contents of another element. @@ -443,18 +492,108 @@ objects, or a strings. The function takes care of setting `:parent' property for CHILD. Return parent element." - ;; Link every child to PARENT. If PARENT is nil, it is a secondary - ;; string: parent is the list itself. - (mapc (lambda (child) - (org-element-put-property child :parent (or parent children))) - children) - ;; Add CHILDREN at the end of PARENT contents. - (when parent - (apply 'org-element-set-contents - parent - (nconc (org-element-contents parent) children))) - ;; Return modified PARENT element. - (or parent children)) + (if (not children) parent + ;; Link every child to PARENT. If PARENT is nil, it is a secondary + ;; string: parent is the list itself. + (dolist (child children) + (org-element-put-property child :parent (or parent children))) + ;; Add CHILDREN at the end of PARENT contents. + (when parent + (apply #'org-element-set-contents + parent + (nconc (org-element-contents parent) children))) + ;; Return modified PARENT element. + (or parent children))) + +(defun org-element-extract-element (element) + "Extract ELEMENT from parse tree. +Remove element from the parse tree by side-effect, and return it +with its `:parent' property stripped out." + (let ((parent (org-element-property :parent element)) + (secondary (org-element-secondary-p element))) + (if secondary + (org-element-put-property + parent secondary + (delq element (org-element-property secondary parent))) + (apply #'org-element-set-contents + parent + (delq element (org-element-contents parent)))) + ;; Return ELEMENT with its :parent removed. + (org-element-put-property element :parent nil))) + +(defun org-element-insert-before (element location) + "Insert ELEMENT before LOCATION in parse tree. +LOCATION is an element, object or string within the parse tree. +Parse tree is modified by side effect." + (let* ((parent (org-element-property :parent location)) + (property (org-element-secondary-p location)) + (siblings (if property (org-element-property property parent) + (org-element-contents parent))) + ;; Special case: LOCATION is the first element of an + ;; independent secondary string (e.g. :title property). Add + ;; ELEMENT in-place. + (specialp (and (not property) + (eq siblings parent) + (eq (car parent) location)))) + ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. + (cond (specialp) + ((or (null siblings) (eq (car siblings) location)) + (push element siblings)) + ((null location) (nconc siblings (list element))) + (t + (let ((index (cl-position location siblings))) + (unless index (error "No location found to insert element")) + (push element (cdr (nthcdr (1- index) siblings)))))) + ;; Store SIBLINGS at appropriate place in parse tree. + (cond + (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) + (property (org-element-put-property parent property siblings)) + (t (apply #'org-element-set-contents parent siblings))) + ;; Set appropriate :parent property. + (org-element-put-property element :parent parent))) + +(defun org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; Ensure OLD and NEW have the same parent. + (org-element-put-property new :parent (org-element-property :parent old)) + (if (or (memq (org-element-type old) '(plain-text nil)) + (memq (org-element-type new) '(plain-text nil))) + ;; We cannot replace OLD with NEW since one of them is not an + ;; object or element. We take the long path. + (progn (org-element-insert-before new old) + (org-element-extract-element old)) + ;; Since OLD is going to be changed into NEW by side-effect, first + ;; make sure that every element or object within NEW has OLD as + ;; parent. + (dolist (blob (org-element-contents new)) + (org-element-put-property blob :parent old)) + ;; Transfer contents. + (apply #'org-element-set-contents old (org-element-contents new)) + ;; Overwrite OLD's properties with NEW's. + (setcar (cdr old) (nth 1 new)) + ;; Transfer type. + (setcar old (car new)))) + +(defun org-element-create (type &optional props &rest children) + "Create a new element of type TYPE. +Optional argument PROPS, when non-nil, is a plist defining the +properties of the element. CHILDREN can be elements, objects or +strings." + (apply #'org-element-adopt-elements (list type props) children)) + +(defun org-element-copy (datum) + "Return a copy of DATUM. +DATUM is an element, object, string or nil. `:parent' property +is cleared and contents are removed in the process." + (when datum + (let ((type (org-element-type datum))) + (pcase type + (`org-data (list 'org-data nil)) + (`plain-text (substring-no-properties datum)) + (`nil (copy-sequence datum)) + (_ + (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) @@ -467,7 +606,7 @@ Return parent element." ;; Most of them accepts no argument. Though, exceptions exist. Hence ;; every element containing a secondary string (see ;; `org-element-secondary-value-alist') will accept an optional -;; argument to toggle parsing of that secondary string. Moreover, +;; argument to toggle parsing of these secondary strings. Moreover, ;; `item' parser requires current list's structure as its first ;; element. ;; @@ -503,8 +642,8 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `center-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -520,7 +659,6 @@ Assume point is at the beginning of the block." (and (< (point) block-end-line) (point)))) (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) @@ -531,15 +669,14 @@ Assume point is at the beginning of the block." (nconc (list :begin begin :end end - :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated)))))))) -(defun org-element-center-block-interpreter (center-block contents) - "Interpret CENTER-BLOCK element as Org syntax. +(defun org-element-center-block-interpreter (_ contents) + "Interpret a center-block element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) @@ -555,7 +692,7 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `drawer' and CDR is a plist containing -`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', +`:drawer-name', `:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at beginning of drawer." @@ -566,7 +703,7 @@ Assume point is at beginning of drawer." (save-excursion (let* ((drawer-end-line (match-beginning 0)) (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (begin (car affiliated)) (post-affiliated (point)) ;; Empty drawers have no contents. @@ -574,7 +711,6 @@ Assume point is at beginning of drawer." (and (< (point) drawer-end-line) (point)))) (contents-end (and contents-begin drawer-end-line)) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char drawer-end-line) (forward-line) (point))) @@ -585,7 +721,6 @@ Assume point is at beginning of drawer." (list :begin begin :end end :drawer-name name - :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :post-blank (count-lines pos-before-blank end) @@ -611,9 +746,9 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `dynamic-block' and CDR is a plist -containing `:block-name', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end', `:arguments', `:post-blank' -and `:post-affiliated' keywords. +containing `:block-name', `:begin', `:end', `:contents-begin', +`:contents-end', `:arguments', `:post-blank' and +`:post-affiliated' keywords. Assume point is at beginning of dynamic block." (let ((case-fold-search t)) @@ -624,8 +759,8 @@ Assume point is at beginning of dynamic block." (let ((block-end-line (match-beginning 0))) (save-excursion (let* ((name (progn (looking-at org-dblock-start-re) - (org-match-string-no-properties 1))) - (arguments (org-match-string-no-properties 3)) + (match-string-no-properties 1))) + (arguments (match-string-no-properties 3)) (begin (car affiliated)) (post-affiliated (point)) ;; Empty blocks have no contents. @@ -633,7 +768,6 @@ Assume point is at beginning of dynamic block." (and (< (point) block-end-line) (point)))) (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) @@ -645,7 +779,6 @@ Assume point is at beginning of dynamic block." :end end :block-name name :arguments arguments - :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :post-blank (count-lines pos-before-blank end) @@ -658,12 +791,18 @@ CONTENTS is the contents of the element." (format "#+BEGIN: %s%s\n%s#+END:" (org-element-property :block-name dynamic-block) (let ((args (org-element-property :arguments dynamic-block))) - (and args (concat " " args))) + (if args (concat " " args) "")) contents)) ;;;; Footnote Definition +(defconst org-element--footnote-separator + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") + "Regexp used as a footnote definition separator.") + (defun org-element-footnote-definition-parser (limit affiliated) "Parse a footnote definition. @@ -679,59 +818,104 @@ a plist containing `:label', `:begin' `:end', `:contents-begin', Assume point is at the beginning of the footnote definition." (save-excursion (let* ((label (progn (looking-at org-footnote-definition-re) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (begin (car affiliated)) (post-affiliated (point)) - (ending (save-excursion - (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^\\([ \t]*\n\\)\\{2,\\}") limit 'move)) - (match-beginning 0) - (point)))) - (contents-begin (progn - (search-forward "]") - (skip-chars-forward " \r\t\n" ending) - (cond ((= (point) ending) nil) - ((= (line-beginning-position) begin) (point)) - (t (line-beginning-position))))) - (contents-end (and contents-begin ending)) - (end (progn (goto-char ending) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) + (end + (save-excursion + (end-of-line) + (cond + ((not + (re-search-forward org-element--footnote-separator limit t)) + limit) + ((eq ?\[ (char-after (match-beginning 0))) + ;; At a new footnote definition, make sure we end + ;; before any affiliated keyword above. + (forward-line -1) + (while (and (> (point) post-affiliated) + (looking-at-p org-element--affiliated-re)) + (forward-line -1)) + (line-beginning-position 2)) + ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) + (t (skip-chars-forward " \r\t\n" limit) + (if (= limit (point)) limit (line-beginning-position)))))) + (contents-begin + (progn (search-forward "]") + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ((= (line-beginning-position) post-affiliated) (point)) + (t (line-beginning-position))))) + (contents-end + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) (list 'footnote-definition (nconc (list :label label :begin begin :end end :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines ending end) + :contents-end (and contents-begin contents-end) + :post-blank (count-lines contents-end end) :post-affiliated post-affiliated) (cdr affiliated)))))) (defun org-element-footnote-definition-interpreter (footnote-definition contents) "Interpret FOOTNOTE-DEFINITION element as Org syntax. CONTENTS is the contents of the footnote-definition." - (concat (format "[%s]" (org-element-property :label footnote-definition)) + (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) " " contents)) ;;;; Headline +(defun org-element--get-node-properties () + "Return node properties associated to headline at point. +Upcase property names. It avoids confusion between properties +obtained through property drawer and default properties from the +parser (e.g. `:end' and :END:). Return value is a plist." + (save-excursion + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at org-property-drawer-re) + (forward-line) + (let ((end (match-end 0)) properties) + (while (< (line-end-position) end) + (looking-at org-property-re) + (push (match-string-no-properties 3) properties) + (push (intern (concat ":" (upcase (match-string 2)))) properties) + (forward-line)) + properties)))) + +(defun org-element--get-time-properties () + "Return time properties associated to headline at point. +Return value is a plist." + (save-excursion + (when (progn (forward-line) (looking-at org-planning-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) + (defun org-element-headline-parser (limit &optional raw-secondary-p) "Parse a headline. Return a list whose CAR is `headline' and CDR is a plist -containing `:raw-value', `:title', `:alt-title', `:begin', -`:end', `:pre-blank', `:hiddenp', `:contents-begin', -`:contents-end', `:level', `:priority', `:tags', -`:todo-keyword',`:todo-type', `:scheduled', `:deadline', -`:closed', `:quotedp', `:archivedp', `:commentedp', -`:footnote-section-p' and `:post-blank' keywords. +containing `:raw-value', `:title', `:begin', `:end', +`:pre-blank', `:contents-begin' and `:contents-end', `:level', +`:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled', +`:deadline', `:closed', `:archivedp', `:commentedp' +`:footnote-section-p', `:post-blank' and `:post-affiliated' +keywords. The plist also contains any property set in the property drawer, with its name in upper cases and colons added at the @@ -744,80 +928,46 @@ parsed as a secondary string, but as a plain string instead. Assume point is at beginning of the headline." (save-excursion - (let* ((components (org-heading-components)) - (level (nth 1 components)) - (todo (nth 2 components)) + (let* ((begin (point)) + (level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t"))) + (todo (and org-todo-regexp + (let (case-fold-search) (looking-at org-todo-regexp)) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 0)))) (todo-type (and todo (if (member todo org-done-keywords) 'done 'todo))) - (tags (let ((raw-tags (nth 5 components))) - (and raw-tags (org-split-string raw-tags ":")))) - (raw-value (or (nth 4 components) "")) - (quotedp - (let ((case-fold-search nil)) - (string-match (format "^%s\\( \\|$\\)" org-quote-string) - raw-value))) + (priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2)))) (commentedp - (let ((case-fold-search nil)) - (string-match (format "^%s\\( \\|$\\)" org-comment-string) - raw-value))) + (and (let (case-fold-search) (looking-at org-comment-string)) + (goto-char (match-end 0)))) + (title-start (point)) + (tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":"))) + (title-end (point)) + (raw-value (org-trim + (buffer-substring-no-properties title-start title-end))) (archivedp (member org-archive-tag tags)) (footnote-section-p (and org-footnote-section (string= org-footnote-section raw-value))) - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (standard-props - (let (plist) - (mapc - (lambda (p) - (setq plist - (plist-put plist - (intern (concat ":" (upcase (car p)))) - (cdr p)))) - (org-entry-properties nil 'standard)) - plist)) - (time-props - ;; Read time properties on the line below the headline. - (save-excursion - (when (progn (forward-line) - (looking-at org-planning-or-clock-line-re)) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist)))) - (begin (point)) + (standard-props (org-element--get-node-properties)) + (time-props (org-element--get-time-properties)) (end (min (save-excursion (org-end-of-subtree t t)) limit)) - (pos-after-head (progn (forward-line) (point))) (contents-begin (save-excursion + (forward-line) (skip-chars-forward " \r\t\n" end) (and (/= (point) end) (line-beginning-position)))) - (hidden (org-invisible-p2)) (contents-end (and contents-begin (progn (goto-char end) (skip-chars-backward " \r\t\n") - (forward-line) - (point))))) - ;; Clean RAW-VALUE from any quote or comment string. - (when (or quotedp commentedp) - (let ((case-fold-search nil)) - (setq raw-value - (replace-regexp-in-string - (concat - (regexp-opt (list org-quote-string org-comment-string)) - "\\(?: \\|$\\)") - "" - raw-value)))) - ;; Clean TAGS from archive tag, if any. - (when archivedp (setq tags (delete org-archive-tag tags))) + (line-beginning-position 2))))) (let ((headline (list 'headline (nconc @@ -826,36 +976,37 @@ Assume point is at beginning of the headline." :end end :pre-blank (if (not contents-begin) 0 - (count-lines pos-after-head contents-begin)) - :hiddenp hidden + (1- (count-lines begin contents-begin))) :contents-begin contents-begin :contents-end contents-end :level level - :priority (nth 3 components) + :priority priority :tags tags :todo-keyword todo :todo-type todo-type - :post-blank (count-lines - (or contents-end pos-after-head) - end) + :post-blank + (if contents-end + (count-lines contents-end end) + (1- (count-lines begin end))) :footnote-section-p footnote-section-p :archivedp archivedp :commentedp commentedp - :quotedp quotedp) + :post-affiliated begin) time-props standard-props)))) - (let ((alt-title (org-element-property :ALT_TITLE headline))) - (when alt-title - (org-element-put-property - headline :alt-title - (if raw-secondary-p alt-title - (org-element-parse-secondary-string - alt-title (org-element-restriction 'headline) headline))))) (org-element-put-property headline :title (if raw-secondary-p raw-value - (org-element-parse-secondary-string - raw-value (org-element-restriction 'headline) headline))))))) + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'headline) + headline))))))) (defun org-element-headline-interpreter (headline contents) "Interpret HEADLINE element as Org syntax. @@ -865,22 +1016,17 @@ CONTENTS is the contents of the element." (priority (org-element-property :priority headline)) (title (org-element-interpret-data (org-element-property :title headline))) - (tags (let ((tag-list (if (org-element-property :archivedp headline) - (cons org-archive-tag - (org-element-property :tags headline)) - (org-element-property :tags headline)))) + (tags (let ((tag-list (org-element-property :tags headline))) (and tag-list (format ":%s:" (mapconcat #'identity tag-list ":"))))) (commentedp (org-element-property :commentedp headline)) - (quotedp (org-element-property :quotedp headline)) (pre-blank (or (org-element-property :pre-blank headline) 0)) (heading (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) ?*) (and todo (concat " " todo)) - (and quotedp (concat " " org-quote-string)) (and commentedp (concat " " org-comment-string)) - (and priority (format " [#%s]" (char-to-string priority))) + (and priority (format " [#%c]" priority)) " " (if (and org-footnote-section (org-element-property :footnote-section-p headline)) @@ -912,10 +1058,11 @@ CONTENTS is the contents of the element." "Parse an inline task. Return a list whose CAR is `inlinetask' and CDR is a plist -containing `:title', `:begin', `:end', `:hiddenp', +containing `:title', `:begin', `:end', `:pre-blank', `:contents-begin' and `:contents-end', `:level', `:priority', `:raw-value', `:tags', `:todo-keyword', `:todo-type', -`:scheduled', `:deadline', `:closed' and `:post-blank' keywords. +`:scheduled', `:deadline', `:closed', `:post-blank' and +`:post-affiliated' keywords. The plist also contains any property set in the property drawer, with its name in upper cases and colons added at the @@ -928,59 +1075,45 @@ string instead. Assume point is at beginning of the inline task." (save-excursion (let* ((begin (point)) - (components (org-heading-components)) - (todo (nth 2 components)) + (level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t"))) + (todo (and org-todo-regexp + (let (case-fold-search) (looking-at org-todo-regexp)) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 0)))) (todo-type (and todo (if (member todo org-done-keywords) 'done 'todo))) - (tags (let ((raw-tags (nth 5 components))) - (and raw-tags (org-split-string raw-tags ":")))) - (raw-value (or (nth 4 components) "")) - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (standard-props - (let (plist) - (mapc - (lambda (p) - (setq plist - (plist-put plist - (intern (concat ":" (upcase (car p)))) - (cdr p)))) - (org-entry-properties nil 'standard)) - plist)) - (time-props - ;; Read time properties on the line below the inlinetask - ;; opening string. - (save-excursion - (when (progn (forward-line) - (looking-at org-planning-or-clock-line-re)) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist)))) + (priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2)))) + (title-start (point)) + (tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":"))) + (title-end (point)) + (raw-value (org-trim + (buffer-substring-no-properties title-start title-end))) (task-end (save-excursion (end-of-line) (and (re-search-forward org-outline-regexp-bol limit t) - (org-looking-at-p "END[ \t]*$") + (looking-at-p "[ \t]*END[ \t]*$") (line-beginning-position)))) - (contents-begin (progn (forward-line) - (and task-end (< (point) task-end) (point)))) - (hidden (and contents-begin (org-invisible-p2))) + (standard-props (and task-end (org-element--get-node-properties))) + (time-props (and task-end (org-element--get-time-properties))) + (contents-begin (and task-end + (< (point) task-end) + (progn + (forward-line) + (skip-chars-forward " \t\n") + (line-beginning-position)))) (contents-end (and contents-begin task-end)) - (before-blank (if (not task-end) (point) - (goto-char task-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) + (end (progn (when task-end (goto-char task-end)) + (forward-line) + (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position)))) (inlinetask (list 'inlinetask @@ -988,22 +1121,31 @@ Assume point is at beginning of the inline task." (list :raw-value raw-value :begin begin :end end - :hiddenp hidden + :pre-blank + (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) :contents-begin contents-begin :contents-end contents-end - :level (nth 1 components) - :priority (nth 3 components) + :level level + :priority priority :tags tags :todo-keyword todo :todo-type todo-type - :post-blank (count-lines before-blank end)) + :post-blank (1- (count-lines (or task-end begin) end)) + :post-affiliated begin) time-props standard-props)))) (org-element-put-property inlinetask :title (if raw-secondary-p raw-value - (org-element-parse-secondary-string - raw-value + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil (org-element-restriction 'inlinetask) inlinetask)))))) @@ -1020,8 +1162,7 @@ CONTENTS is the contents of inlinetask." (format ":%s:" (mapconcat 'identity tag-list ":"))))) (task (concat (make-string level ?*) (and todo (concat " " todo)) - (and priority - (format " [#%s]" (char-to-string priority))) + (and priority (format " [#%c]" priority)) (and title (concat " " title))))) (concat task ;; Align tags. @@ -1048,15 +1189,15 @@ CONTENTS is the contents of inlinetask." ;;;; Item -(defun org-element-item-parser (limit struct &optional raw-secondary-p) +(defun org-element-item-parser (_ struct &optional raw-secondary-p) "Parse an item. STRUCT is the structure of the plain list. Return a list whose CAR is `item' and CDR is a plist containing `:bullet', `:begin', `:end', `:contents-begin', `:contents-end', -`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and -`:post-blank' keywords. +`:checkbox', `:counter', `:tag', `:structure', `:post-blank' and +`:post-affiliated' keywords. When optional argument RAW-SECONDARY-P is non-nil, item's tag, if any, will not be parsed as a secondary string, but as a plain @@ -1067,12 +1208,12 @@ Assume point is at the beginning of the item." (beginning-of-line) (looking-at org-list-full-item-re) (let* ((begin (point)) - (bullet (org-match-string-no-properties 1)) - (checkbox (let ((box (org-match-string-no-properties 3))) + (bullet (match-string-no-properties 1)) + (checkbox (let ((box (match-string 3))) (cond ((equal "[ ]" box) 'off) ((equal "[X]" box) 'on) ((equal "[-]" box) 'trans)))) - (counter (let ((c (org-match-string-no-properties 2))) + (counter (let ((c (match-string 2))) (save-match-data (cond ((not c) nil) @@ -1081,9 +1222,8 @@ Assume point is at the beginning of the item." 64)) ((string-match "[0-9]+" c) (string-to-number (match-string 0 c))))))) - (end (save-excursion (goto-char (org-list-get-item-end begin struct)) - (unless (bolp) (forward-line)) - (point))) + (end (progn (goto-char (nth 6 (assq (point) struct))) + (if (bolp) (point) (line-beginning-position 2)))) (contents-begin (progn (goto-char ;; Ignore tags in un-ordered lists: they are just @@ -1092,40 +1232,37 @@ Assume point is at the beginning of the item." (save-match-data (string-match "[.)]" bullet))) (match-beginning 4) (match-end 0))) - (skip-chars-forward " \r\t\n" limit) - ;; If first line isn't empty, contents really start - ;; at the text after item's meta-data. - (if (= (point-at-bol) begin) (point) (point-at-bol)))) - (hidden (progn (forward-line) - (and (not (= (point) end)) (org-invisible-p2)))) - (contents-end (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ;; If first line isn't empty, contents really + ;; start at the text after item's meta-data. + ((= (line-beginning-position) begin) (point)) + (t (line-beginning-position))))) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) (item (list 'item (list :bullet bullet :begin begin :end end - ;; CONTENTS-BEGIN and CONTENTS-END may be - ;; mixed up in the case of an empty item - ;; separated from the next by a blank line. - ;; Thus ensure the former is always the - ;; smallest. - :contents-begin (min contents-begin contents-end) - :contents-end (max contents-begin contents-end) + :contents-begin contents-begin + :contents-end contents-end :checkbox checkbox :counter counter - :hiddenp hidden :structure struct - :post-blank (count-lines contents-end end))))) + :post-blank (count-lines (or contents-end begin) end) + :post-affiliated begin)))) (org-element-put-property item :tag - (let ((raw-tag (org-list-get-tag begin struct))) - (and raw-tag - (if raw-secondary-p raw-tag - (org-element-parse-secondary-string - raw-tag (org-element-restriction 'item) item)))))))) + (let ((raw (org-list-get-tag begin struct))) + (when raw + (if raw-secondary-p raw + (org-element--parse-objects + (match-beginning 4) (match-end 4) nil + (org-element-restriction 'item) + item)))))))) (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. @@ -1148,10 +1285,11 @@ CONTENTS is the contents of the element." (concat bullet (and counter (format "[@%d] " counter)) - (case checkbox - (on "[X] ") - (off "[ ] ") - (trans "[-] ")) + (pcase checkbox + (`on "[X] ") + (`off "[ ] ") + (`trans "[-] ") + (_ nil)) (and tag (format "%s :: " tag)) (when contents (let ((contents (replace-regexp-in-string @@ -1168,9 +1306,6 @@ CONTENTS is the contents of the element." (let ((case-fold-search t) (top-ind limit) (item-re (org-item-re)) - (drawers-re (concat ":\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) items struct) (save-excursion @@ -1222,11 +1357,12 @@ CONTENTS is the contents of the element." (forward-line) (let ((origin (point))) (when (re-search-forward inlinetask-re limit t) - (if (org-looking-at-p "END[ \t]*$") (forward-line) + (if (looking-at-p "END[ \t]*$") (forward-line) (goto-char origin))))) ;; At some text line. Check if it ends any previous item. (t - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (let ((ind (save-excursion (skip-chars-forward " \t") + (current-column)))) (when (<= ind top-ind) (skip-chars-backward " \r\t\n") (forward-line)) @@ -1235,15 +1371,14 @@ CONTENTS is the contents of the element." (setcar (nthcdr 6 item) (line-beginning-position)) (push item struct) (unless items - (throw 'exit (sort struct 'car-less-than-car)))))) + (throw 'exit (sort struct #'car-less-than-car)))))) ;; Skip blocks (any type) and drawers contents. (cond - ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") + ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)") (re-search-forward - (format "^[ \t]*#\\+END%s[ \t]*$" - (org-match-string-no-properties 1)) + (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) limit t))) - ((and (looking-at drawers-re) + ((and (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) (forward-line)))))))) @@ -1264,15 +1399,20 @@ containing `:type', `:begin', `:end', `:contents-begin' and Assume point is at the beginning of the list." (save-excursion (let* ((struct (or structure (org-element--list-struct limit))) - (prevs (org-list-prevs-alist struct)) - (type (org-list-get-list-type (point) struct prevs)) + (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) + ((nth 5 (assq (point) struct)) 'descriptive) + (t 'unordered))) (contents-begin (point)) (begin (car affiliated)) - (contents-end - (progn (goto-char (org-list-get-list-end (point) struct prevs)) - (unless (bolp) (forward-line)) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) + (contents-end (let* ((item (assq contents-begin struct)) + (ind (nth 1 item)) + (pos (nth 6 item))) + (while (and (setq item (assq pos struct)) + (= (nth 1 item) ind)) + (setq pos (nth 6 item))) + pos)) + (end (progn (goto-char contents-end) + (skip-chars-forward " \r\t\n" limit) (if (= (point) limit) limit (line-beginning-position))))) ;; Return value. (list 'plain-list @@ -1287,8 +1427,8 @@ Assume point is at the beginning of the list." :post-affiliated contents-begin) (cdr affiliated)))))) -(defun org-element-plain-list-interpreter (plain-list contents) - "Interpret PLAIN-LIST element as Org syntax. +(defun org-element-plain-list-interpreter (_ contents) + "Interpret plain-list element as Org syntax. CONTENTS is the contents of the element." (with-temp-buffer (insert contents) @@ -1299,52 +1439,36 @@ CONTENTS is the contents of the element." ;;;; Property Drawer -(defun org-element-property-drawer-parser (limit affiliated) +(defun org-element-property-drawer-parser (limit) "Parse a property drawer. -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. +LIMIT bounds the search. -Return a list whose CAR is `property-drawer' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. +Return a list whose car is `property-drawer' and cdr is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the property drawer." - (let ((case-fold-search t)) - (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) - ;; Incomplete drawer: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((drawer-end-line (match-beginning 0)) - (begin (car affiliated)) - (post-affiliated (point)) - (contents-begin - (progn - (forward-line) - (and (re-search-forward org-property-re drawer-end-line t) - (line-beginning-position)))) - (contents-end (and contents-begin drawer-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'property-drawer - (nconc - (list :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) - -(defun org-element-property-drawer-interpreter (property-drawer contents) - "Interpret PROPERTY-DRAWER element as Org syntax. + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (contents-begin (line-beginning-position 2))) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) + (let ((contents-end (and (> (match-beginning 0) contents-begin) + (match-beginning 0))) + (before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'property-drawer + (list :begin begin + :end end + :contents-begin (and contents-end contents-begin) + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated begin)))))) + +(defun org-element-property-drawer-interpreter (_ contents) + "Interpret property-drawer element as Org syntax. CONTENTS is the properties within the drawer." (format ":PROPERTIES:\n%s:END:" contents)) @@ -1360,8 +1484,8 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `quote-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -1378,7 +1502,6 @@ Assume point is at the beginning of the block." (and (< (point) block-end-line) (point)))) (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) @@ -1388,29 +1511,26 @@ Assume point is at the beginning of the block." (nconc (list :begin begin :end end - :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-quote-block-interpreter (quote-block contents) - "Interpret QUOTE-BLOCK element as Org syntax. +(defun org-element-quote-block-interpreter (_ contents) + "Interpret quote-block element as Org syntax. CONTENTS is the contents of the element." (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) ;;;; Section -(defun org-element-section-parser (limit) +(defun org-element-section-parser (_) "Parse a section. -LIMIT bounds the search. - Return a list whose CAR is `section' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `contents-end' -and `:post-blank' keywords." +containing `:begin', `:end', `:contents-begin', `contents-end', +`:post-blank' and `:post-affiliated' keywords." (save-excursion ;; Beginning of section is the beginning of the first non-blank ;; line after previous headline. @@ -1418,17 +1538,17 @@ and `:post-blank' keywords." (end (progn (org-with-limited-levels (outline-next-heading)) (point))) (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) + (line-beginning-position 2)))) (list 'section (list :begin begin :end end :contents-begin begin :contents-end pos-before-blank - :post-blank (count-lines pos-before-blank end)))))) + :post-blank (count-lines pos-before-blank end) + :post-affiliated begin))))) -(defun org-element-section-interpreter (section contents) - "Interpret SECTION element as Org syntax. +(defun org-element-section-interpreter (_ contents) + "Interpret section element as Org syntax. CONTENTS is the contents of the element." contents) @@ -1444,14 +1564,13 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `special-block' and CDR is a plist -containing `:type', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end', `:post-blank' and -`:post-affiliated' keywords. +containing `:type', `:begin', `:end', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. Assume point is at the beginning of the block." (let* ((case-fold-search t) (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (upcase (match-string-no-properties 1))))) + (match-string-no-properties 1)))) (if (not (save-excursion (re-search-forward (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) @@ -1467,7 +1586,6 @@ Assume point is at the beginning of the block." (and (< (point) block-end-line) (point)))) (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) @@ -1478,7 +1596,6 @@ Assume point is at the beginning of the block." (list :type type :begin begin :end end - :hiddenp hidden :contents-begin contents-begin :contents-end contents-end :post-blank (count-lines pos-before-blank end) @@ -1502,9 +1619,6 @@ CONTENTS is the contents of the element." ;; through the following steps: implement a parser and an interpreter, ;; tweak `org-element--current-element' so that it recognizes the new ;; type and add that new type to `org-element-all-elements'. -;; -;; As a special case, when the newly defined type is a block type, -;; `org-element-block-name-alist' has to be modified accordingly. ;;;; Babel Call @@ -1512,43 +1626,61 @@ CONTENTS is the contents of the element." (defun org-element-babel-call-parser (limit affiliated) "Parse a babel call. -LIMIT bounds the search. AFFILIATED is a list of which CAR is +LIMIT bounds the search. AFFILIATED is a list of which car is the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with +keyword and cdr is a plist of affiliated keywords along with their value. -Return a list whose CAR is `babel-call' and CDR is a plist -containing `:begin', `:end', `:info', `:post-blank' and +Return a list whose car is `babel-call' and cdr is a plist +containing `:call', `:inside-header', `:arguments', +`:end-header', `:begin', `:end', `:value', `:post-blank' and `:post-affiliated' as keywords." (save-excursion - (let ((case-fold-search t) - (info (progn (looking-at org-babel-block-lob-one-liner-regexp) - (org-babel-lob-get-info))) - (begin (car affiliated)) - (post-affiliated (point)) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (before-blank (line-beginning-position 2)) + (value (progn (search-forward ":" before-blank t) + (skip-chars-forward " \t") + (org-trim + (buffer-substring-no-properties + (point) (line-end-position))))) + (call + (or (org-string-nw-p + (buffer-substring-no-properties + (point) (progn (skip-chars-forward "^[]()" before-blank) + (point)))))) + (inside-header (org-element--parse-paired-brackets ?\[)) + (arguments (org-string-nw-p + (org-element--parse-paired-brackets ?\())) + (end-header + (org-string-nw-p + (org-trim + (buffer-substring-no-properties (point) (line-end-position))))) + (end (progn (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) (list 'babel-call (nconc - (list :begin begin + (list :call call + :inside-header inside-header + :arguments arguments + :end-header end-header + :begin begin :end end - :info info - :post-blank (count-lines pos-before-blank end) + :value value + :post-blank (count-lines before-blank end) :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-babel-call-interpreter (babel-call contents) - "Interpret BABEL-CALL element as Org syntax. -CONTENTS is nil." - (let* ((babel-info (org-element-property :info babel-call)) - (main (car babel-info)) - (post-options (nth 1 babel-info))) - (concat "#+CALL: " - (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main - ;; Remove redundant square brackets. - (replace-match (match-string 1 main) nil nil main)) - (and post-options (format "[%s]" post-options))))) +(defun org-element-babel-call-interpreter (babel-call _) + "Interpret BABEL-CALL element as Org syntax." + (concat "#+CALL: " + (org-element-property :call babel-call) + (let ((h (org-element-property :inside-header babel-call))) + (and h (format "[%s]" h))) + (concat "(" (org-element-property :arguments babel-call) ")") + (let ((h (org-element-property :end-header babel-call))) + (and h (concat " " h))))) ;;;; Clock @@ -1559,8 +1691,8 @@ CONTENTS is nil." LIMIT bounds the search. Return a list whose CAR is `clock' and CDR is a plist containing -`:status', `:value', `:time', `:begin', `:end' and `:post-blank' -as keywords." +`:status', `:value', `:time', `:begin', `:end', `:post-blank' and +`:post-affiliated' as keywords." (save-excursion (let* ((case-fold-search nil) (begin (point)) @@ -1570,7 +1702,7 @@ as keywords." (duration (and (search-forward " => " (line-end-position) t) (progn (skip-chars-forward " \t") (looking-at "\\(\\S-+\\)[ \t]*$")) - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (status (if duration 'closed 'running)) (post-blank (let ((before-blank (progn (forward-line) (point)))) (skip-chars-forward " \r\t\n" limit) @@ -1584,11 +1716,11 @@ as keywords." :duration duration :begin begin :end end - :post-blank post-blank))))) + :post-blank post-blank + :post-affiliated begin))))) -(defun org-element-clock-interpreter (clock contents) - "Interpret CLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-clock-interpreter (clock _) + "Interpret CLOCK element as Org syntax." (concat org-clock-string " " (org-element-timestamp-interpreter (org-element-property :value clock) nil) @@ -1647,7 +1779,7 @@ Assume point is at comment beginning." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-comment-interpreter (comment contents) +(defun org-element-comment-interpreter (comment _) "Interpret COMMENT element as Org syntax. CONTENTS is nil." (replace-regexp-in-string "^" "# " (org-element-property :value comment))) @@ -1664,8 +1796,8 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `comment-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:value', `:post-blank' -and `:post-affiliated' keywords. +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. Assume point is at comment block beginning." (let ((case-fold-search t)) @@ -1678,7 +1810,6 @@ Assume point is at comment block beginning." (let* ((begin (car affiliated)) (post-affiliated (point)) (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -1691,16 +1822,16 @@ Assume point is at comment block beginning." (list :begin begin :end end :value value - :hiddenp hidden :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-comment-block-interpreter (comment-block contents) - "Interpret COMMENT-BLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-comment-block-interpreter (comment-block _) + "Interpret COMMENT-BLOCK element as Org syntax." (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" - (org-remove-indentation (org-element-property :value comment-block)))) + (org-element-normalize-string + (org-remove-indentation + (org-element-property :value comment-block))))) ;;;; Diary Sexp @@ -1720,7 +1851,7 @@ containing `:begin', `:end', `:value', `:post-blank' and (let ((begin (car affiliated)) (post-affiliated (point)) (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") - (org-match-string-no-properties 1))) + (match-string-no-properties 1))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) @@ -1733,43 +1864,13 @@ containing `:begin', `:end', `:value', `:post-blank' and :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-diary-sexp-interpreter (diary-sexp contents) - "Interpret DIARY-SEXP as Org syntax. -CONTENTS is nil." +(defun org-element-diary-sexp-interpreter (diary-sexp _) + "Interpret DIARY-SEXP as Org syntax." (org-element-property :value diary-sexp)) ;;;; Example Block -(defun org-element--remove-indentation (s &optional n) - "Remove maximum common indentation in string S and return it. -When optional argument N is a positive integer, remove exactly -that much characters from indentation, if possible, or return -S as-is otherwise. Unlike to `org-remove-indentation', this -function doesn't call `untabify' on S." - (catch 'exit - (with-temp-buffer - (insert s) - (goto-char (point-min)) - ;; Find maximum common indentation, if not specified. - (setq n (or n - (let ((min-ind (point-max))) - (save-excursion - (while (re-search-forward "^[ \t]*\\S-" nil t) - (let ((ind (1- (current-column)))) - (if (zerop ind) (throw 'exit s) - (setq min-ind (min min-ind ind)))))) - min-ind))) - (if (zerop n) s - ;; Remove exactly N indentation, but give up if not possible. - (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw 'exit s)) - (t (org-indent-line-to (- ind n)))) - (forward-line))) - (buffer-string))))) - (defun org-element-example-block-parser (limit affiliated) "Parse an example block. @@ -1780,9 +1881,8 @@ their value. Return a list whose CAR is `example-block' and CDR is a plist containing `:begin', `:end', `:number-lines', `:preserve-indent', -`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', -`:switches', `:value', `:post-blank' and `:post-affiliated' -keywords." +`:retain-labels', `:use-labels', `:label-fmt', `:switches', +`:value', `:post-blank' and `:post-affiliated' keywords." (let ((case-fold-search t)) (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) @@ -1793,15 +1893,22 @@ keywords." (let* ((switches (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") - (org-match-string-no-properties 1))) - ;; Switches analysis + (match-string-no-properties 1))) + ;; Switches analysis. (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) (preserve-indent - (or org-src-preserve-indentation - (and switches (string-match "-i\\>" switches)))) + (and switches (string-match "-i\\>" switches))) ;; Should labels be retained in (or stripped from) example ;; blocks? (retain-labels @@ -1821,14 +1928,10 @@ keywords." ;; Standard block parsing. (begin (car affiliated)) (post-affiliated (point)) - (block-ind (progn (skip-chars-forward " \t") (current-column))) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (value (org-element--remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - contents-begin contents-end)) - (and preserve-indent block-ind))) + (contents-begin (line-beginning-position 2)) + (value (org-unescape-code-in-string + (buffer-substring-no-properties + contents-begin contents-end))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -1845,18 +1948,21 @@ keywords." :retain-labels retain-labels :use-labels use-labels :label-fmt label-fmt - :hiddenp hidden :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-example-block-interpreter (example-block contents) - "Interpret EXAMPLE-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((switches (org-element-property :switches example-block))) +(defun org-element-example-block-interpreter (example-block _) + "Interpret EXAMPLE-BLOCK element as Org syntax." + (let ((switches (org-element-property :switches example-block)) + (value (org-element-property :value example-block))) (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" - (org-escape-code-in-string - (org-element-property :value example-block)) + (org-element-normalize-string + (org-escape-code-in-string + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent example-block)) + value + (org-remove-indentation value)))) "#+END_EXAMPLE"))) @@ -1871,49 +1977,48 @@ keyword and CDR is a plist of affiliated keywords along with their value. Return a list whose CAR is `export-block' and CDR is a plist -containing `:begin', `:end', `:type', `:hiddenp', `:value', -`:post-blank' and `:post-affiliated' keywords. +containing `:begin', `:end', `:type', `:value', `:post-blank' and +`:post-affiliated' keywords. Assume point is at export-block beginning." - (let* ((case-fold-search t) - (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (upcase (org-match-string-no-properties 1))))) + (let* ((case-fold-search t)) (if (not (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) + (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) ;; Incomplete block: parse it as a paragraph. (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties contents-begin - contents-end))) - (list 'export-block - (nconc - (list :begin begin - :end end - :type type - :value value - :hiddenp hidden - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) + (save-excursion + (let* ((contents-end (match-beginning 0)) + (backend + (progn + (looking-at + "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") + (match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (org-unescape-code-in-string + (buffer-substring-no-properties contents-begin + contents-end)))) + (list 'export-block + (nconc + (list :type (and backend (upcase backend)) + :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) -(defun org-element-export-block-interpreter (export-block contents) - "Interpret EXPORT-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((type (org-element-property :type export-block))) - (concat (format "#+BEGIN_%s\n" type) - (org-element-property :value export-block) - (format "#+END_%s" type)))) +(defun org-element-export-block-interpreter (export-block _) + "Interpret EXPORT-BLOCK element as Org syntax." + (format "#+BEGIN_EXPORT %s\n%s#+END_EXPORT" + (org-element-property :type export-block) + (org-element-property :value export-block))) ;;;; Fixed-width @@ -1958,9 +2063,8 @@ Assume point is at the beginning of the fixed-width area." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-fixed-width-interpreter (fixed-width contents) - "Interpret FIXED-WIDTH element as Org syntax. -CONTENTS is nil." +(defun org-element-fixed-width-interpreter (fixed-width _) + "Interpret FIXED-WIDTH element as Org syntax." (let ((value (org-element-property :value fixed-width))) (and value (replace-regexp-in-string @@ -1995,9 +2099,8 @@ keywords." :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) - "Interpret HORIZONTAL-RULE element as Org syntax. -CONTENTS is nil." +(defun org-element-horizontal-rule-interpreter (&rest _) + "Interpret HORIZONTAL-RULE element as Org syntax." "-----") @@ -2015,10 +2118,13 @@ Return a list whose CAR is `keyword' and CDR is a plist containing `:key', `:value', `:begin', `:end', `:post-blank' and `:post-affiliated' keywords." (save-excursion - (let ((begin (car affiliated)) + ;; An orphaned affiliated keyword is considered as a regular + ;; keyword. In this case AFFILIATED is nil, so we take care of + ;; this corner case. + (let ((begin (or (car affiliated) (point))) (post-affiliated (point)) (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):") - (upcase (org-match-string-no-properties 1)))) + (upcase (match-string-no-properties 1)))) (value (org-trim (buffer-substring-no-properties (match-end 0) (point-at-eol)))) (pos-before-blank (progn (forward-line) (point))) @@ -2034,9 +2140,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and :post-affiliated post-affiliated) (cdr affiliated)))))) -(defun org-element-keyword-interpreter (keyword contents) - "Interpret KEYWORD element as Org syntax. -CONTENTS is nil." +(defun org-element-keyword-interpreter (keyword _) + "Interpret KEYWORD element as Org syntax." (format "#+%s: %s" (org-element-property :key keyword) (org-element-property :value keyword))) @@ -2044,6 +2149,18 @@ CONTENTS is nil." ;;;; Latex Environment +(defconst org-element--latex-begin-environment + "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" + "Regexp matching the beginning of a LaTeX environment. +The environment is captured by the first group. + +See also `org-element--latex-end-environment'.") + +(defconst org-element--latex-end-environment + "\\\\end{%s}[ \t]*$" + "Format string matching the ending of a LaTeX environment. +See also `org-element--latex-begin-environment'.") + (defun org-element-latex-environment-parser (limit affiliated) "Parse a LaTeX environment. @@ -2060,8 +2177,8 @@ Assume point is at the beginning of the latex environment." (save-excursion (let ((case-fold-search t) (code-begin (point))) - (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") - (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$" + (looking-at org-element--latex-begin-environment) + (if (not (re-search-forward (format org-element--latex-end-environment (regexp-quote (match-string 1))) limit t)) ;; Incomplete latex environment: parse it as a paragraph. @@ -2080,9 +2197,8 @@ Assume point is at the beginning of the latex environment." :post-affiliated code-begin) (cdr affiliated)))))))) -(defun org-element-latex-environment-interpreter (latex-environment contents) - "Interpret LATEX-ENVIRONMENT element as Org syntax. -CONTENTS is nil." +(defun org-element-latex-environment-interpreter (latex-environment _) + "Interpret LATEX-ENVIRONMENT element as Org syntax." (org-element-property :value latex-environment)) @@ -2094,12 +2210,13 @@ CONTENTS is nil." LIMIT bounds the search. Return a list whose CAR is `node-property' and CDR is a plist -containing `:key', `:value', `:begin', `:end' and `:post-blank' -keywords." +containing `:key', `:value', `:begin', `:end', `:post-blank' and +`:post-affiliated' keywords." (looking-at org-property-re) - (let ((begin (point)) - (key (org-match-string-no-properties 2)) - (value (org-match-string-no-properties 3)) + (let ((case-fold-search t) + (begin (point)) + (key (match-string-no-properties 2)) + (value (match-string-no-properties 3)) (end (save-excursion (end-of-line) (if (re-search-forward org-property-re limit t) @@ -2110,11 +2227,11 @@ keywords." :value value :begin begin :end end - :post-blank 0)))) + :post-blank 0 + :post-affiliated begin)))) -(defun org-element-node-property-interpreter (node-property contents) - "Interpret NODE-PROPERTY element as Org syntax. -CONTENTS is nil." +(defun org-element-node-property-interpreter (node-property _) + "Interpret NODE-PROPERTY element as Org syntax." (format org-property-format (format ":%s:" (org-element-property :key node-property)) (or (org-element-property :value node-property) ""))) @@ -2141,66 +2258,42 @@ Assume point is at the beginning of the paragraph." (before-blank (let ((case-fold-search t)) (end-of-line) - (if (not (re-search-forward - org-element-paragraph-separate limit 'm)) - limit - ;; A matching `org-element-paragraph-separate' is not - ;; necessarily the end of the paragraph. In - ;; particular, lines starting with # or : as a first - ;; non-space character are ambiguous. We have to - ;; check if they are valid Org syntax (e.g., not an - ;; incomplete keyword). - (beginning-of-line) - (while (not - (or - ;; There's no ambiguity for other symbols or - ;; empty lines: stop here. - (looking-at "[ \t]*\\(?:[^:#]\\|$\\)") - ;; Stop at valid fixed-width areas. - (looking-at "[ \t]*:\\(?: \\|$\\)") - ;; Stop at drawers. - (and (looking-at org-drawer-regexp) - (save-excursion - (re-search-forward - "^[ \t]*:END:[ \t]*$" limit t))) - ;; Stop at valid comments. - (looking-at "[ \t]*#\\(?: \\|$\\)") - ;; Stop at valid dynamic blocks. - (and (looking-at org-dblock-start-re) - (save-excursion - (re-search-forward - "^[ \t]*#\\+END:?[ \t]*$" limit t))) - ;; Stop at valid blocks. - (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" - (regexp-quote - (org-match-string-no-properties 1))) - limit t))) - ;; Stop at valid latex environments. - (and (looking-at - "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") - (save-excursion - (re-search-forward - (format "^[ \t]*\\\\end{%s}[ \t]*$" - (regexp-quote - (org-match-string-no-properties 1))) - limit t))) - ;; Stop at valid keywords. - (looking-at "[ \t]*#\\+\\S-+:") - ;; Skip everything else. - (not - (progn - (end-of-line) - (re-search-forward org-element-paragraph-separate - limit 'm))))) - (beginning-of-line))) + ;; A matching `org-element-paragraph-separate' is not + ;; necessarily the end of the paragraph. In particular, + ;; drawers, blocks or LaTeX environments opening lines + ;; must be closed. Moreover keywords with a secondary + ;; value must belong to "dual keywords". + (while (not + (cond + ((not (and (re-search-forward + org-element-paragraph-separate limit 'move) + (progn (beginning-of-line) t)))) + ((looking-at org-drawer-regexp) + (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" + (regexp-quote (match-string 1))) + limit t))) + ((looking-at org-element--latex-begin-environment) + (save-excursion + (re-search-forward + (format org-element--latex-end-environment + (regexp-quote (match-string 1))) + limit t))) + ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") + (member-ignore-case (match-string 1) + org-element-dual-keywords)) + ;; Everything else is unambiguous. + (t))) + (end-of-line)) (if (= (point) limit) limit (goto-char (line-beginning-position))))) - (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) - (forward-line) - (point))) + (contents-end (save-excursion + (skip-chars-backward " \r\t\n" contents-begin) + (line-beginning-position 2))) (end (progn (skip-chars-forward " \r\t\n" limit) (if (eobp) (point) (line-beginning-position))))) (list 'paragraph @@ -2213,8 +2306,8 @@ Assume point is at the beginning of the paragraph." :post-affiliated contents-begin) (cdr affiliated)))))) -(defun org-element-paragraph-interpreter (paragraph contents) - "Interpret PARAGRAPH element as Org syntax. +(defun org-element-paragraph-interpreter (_ contents) + "Interpret paragraph element as Org syntax. CONTENTS is the contents of the element." contents) @@ -2227,8 +2320,8 @@ CONTENTS is the contents of the element." LIMIT bounds the search. Return a list whose CAR is `planning' and CDR is a plist -containing `:closed', `:deadline', `:scheduled', `:begin', `:end' -and `:post-blank' keywords." +containing `:closed', `:deadline', `:scheduled', `:begin', +`:end', `:post-blank' and `:post-affiliated' keywords." (save-excursion (let* ((case-fold-search nil) (begin (point)) @@ -2254,13 +2347,13 @@ and `:post-blank' keywords." :scheduled scheduled :begin begin :end end - :post-blank post-blank))))) + :post-blank post-blank + :post-affiliated begin))))) -(defun org-element-planning-interpreter (planning contents) - "Interpret PLANNING element as Org syntax. -CONTENTS is nil." +(defun org-element-planning-interpreter (planning _) + "Interpret PLANNING element as Org syntax." (mapconcat - 'identity + #'identity (delq nil (list (let ((deadline (org-element-property :deadline planning))) (when deadline @@ -2277,37 +2370,6 @@ CONTENTS is nil." " ")) -;;;; Quote Section - -(defun org-element-quote-section-parser (limit) - "Parse a quote section. - -LIMIT bounds the search. - -Return a list whose CAR is `quote-section' and CDR is a plist -containing `:begin', `:end', `:value' and `:post-blank' keywords. - -Assume point is at beginning of the section." - (save-excursion - (let* ((begin (point)) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (value (buffer-substring-no-properties begin pos-before-blank))) - (list 'quote-section - (list :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end)))))) - -(defun org-element-quote-section-interpreter (quote-section contents) - "Interpret QUOTE-SECTION element as Org syntax. -CONTENTS is nil." - (org-element-property :value quote-section)) - - ;;;; Src Block (defun org-element-src-block-parser (limit affiliated) @@ -2320,9 +2382,9 @@ their value. Return a list whose CAR is `src-block' and CDR is a plist containing `:language', `:switches', `:parameters', `:begin', -`:end', `:hiddenp', `:number-lines', `:retain-labels', -`:use-labels', `:label-fmt', `:preserve-indent', `:value', -`:post-blank' and `:post-affiliated' keywords. +`:end', `:number-lines', `:retain-labels', `:use-labels', +`:label-fmt', `:preserve-indent', `:value', `:post-blank' and +`:post-affiliated' keywords. Assume point is at the beginning of the block." (let ((case-fold-search t)) @@ -2338,23 +2400,30 @@ Assume point is at the beginning of the block." (language (progn (looking-at - (concat "^[ \t]*#\\+BEGIN_SRC" - "\\(?: +\\(\\S-+\\)\\)?" - "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" - "\\(.*\\)[ \t]*$")) - (org-match-string-no-properties 1))) + "^[ \t]*#\\+BEGIN_SRC\ +\\(?: +\\(\\S-+\\)\\)?\ +\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ +\\(.*\\)[ \t]*$") + (match-string-no-properties 1))) ;; Get switches. - (switches (org-match-string-no-properties 2)) + (switches (match-string-no-properties 2)) ;; Get parameters. - (parameters (org-match-string-no-properties 3)) - ;; Switches analysis + (parameters (match-string-no-properties 3)) + ;; Switches analysis. (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) - (preserve-indent (or org-src-preserve-indentation - (and switches - (string-match "-i\\>" switches)))) + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) + (preserve-indent (and switches + (string-match "-i\\>" switches))) (label-fmt (and switches (string-match "-l +\"\\([^\"\n]+\\)\"" switches) @@ -2371,16 +2440,10 @@ Assume point is at the beginning of the block." (or (not switches) (and retain-labels (not (string-match "-k\\>" switches))))) - ;; Indentation. - (block-ind (progn (skip-chars-forward " \t") (current-column))) - ;; Get visibility status. - (hidden (progn (forward-line) (org-invisible-p2))) ;; Retrieve code. - (value (org-element--remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - (point) contents-end)) - (and preserve-indent block-ind))) + (value (org-unescape-code-in-string + (buffer-substring-no-properties + (line-beginning-position 2) contents-end))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -2401,32 +2464,33 @@ Assume point is at the beginning of the block." :retain-labels retain-labels :use-labels use-labels :label-fmt label-fmt - :hiddenp hidden :value value :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-src-block-interpreter (src-block contents) - "Interpret SRC-BLOCK element as Org syntax. -CONTENTS is nil." +(defun org-element-src-block-interpreter (src-block _) + "Interpret SRC-BLOCK element as Org syntax." (let ((lang (org-element-property :language src-block)) (switches (org-element-property :switches src-block)) (params (org-element-property :parameters src-block)) - (value (let ((val (org-element-property :value src-block))) - (cond - ((org-element-property :preserve-indent src-block) val) - ((zerop org-edit-src-content-indentation) val) - (t - (let ((ind (make-string - org-edit-src-content-indentation 32))) - (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) + (value + (let ((val (org-element-property :value src-block))) + (cond + ((or org-src-preserve-indentation + (org-element-property :preserve-indent src-block)) + val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string org-edit-src-content-indentation ?\s))) + (replace-regexp-in-string + "^" ind (org-remove-indentation val)))))))) (concat (format "#+BEGIN_SRC%s\n" (concat (and lang (concat " " lang)) (and switches (concat " " switches)) (and params (concat " " params)))) - (org-escape-code-in-string value) + (org-element-normalize-string (org-escape-code-in-string value)) "#+END_SRC"))) @@ -2449,15 +2513,17 @@ Assume point is at the beginning of the table." (save-excursion (let* ((case-fold-search t) (table-begin (point)) - (type (if (org-at-table.el-p) 'table.el 'org)) + (type (if (looking-at "[ \t]*|") 'org 'table.el)) + (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" + (if (eq type 'org) "" "+"))) (begin (car affiliated)) (table-end - (if (re-search-forward org-table-any-border-regexp limit 'm) + (if (re-search-forward end-re limit 'move) (goto-char (match-beginning 0)) (point))) (tblfm (let (acc) (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") - (push (org-match-string-no-properties 1) acc) + (push (match-string-no-properties 1) acc) (forward-line)) acc)) (pos-before-blank (point)) @@ -2496,41 +2562,38 @@ CONTENTS is a string, if table's type is `org', or nil." ;;;; Table Row -(defun org-element-table-row-parser (limit) +(defun org-element-table-row-parser (_) "Parse table row at point. -LIMIT bounds the search. - Return a list whose CAR is `table-row' and CDR is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', -`:type' and `:post-blank' keywords." +`:type', `:post-blank' and `:post-affiliated' keywords." (save-excursion (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) (begin (point)) ;; A table rule has no contents. In that case, ensure ;; CONTENTS-BEGIN matches CONTENTS-END. - (contents-begin (and (eq type 'standard) - (search-forward "|") - (point))) + (contents-begin (and (eq type 'standard) (search-forward "|"))) (contents-end (and (eq type 'standard) (progn (end-of-line) (skip-chars-backward " \t") (point)))) - (end (progn (forward-line) (point)))) + (end (line-beginning-position 2))) (list 'table-row (list :type type :begin begin :end end :contents-begin contents-begin :contents-end contents-end - :post-blank 0))))) + :post-blank 0 + :post-affiliated begin))))) (defun org-element-table-row-interpreter (table-row contents) "Interpret TABLE-ROW element as Org syntax. CONTENTS is the contents of the table row." (if (eq (org-element-property :type table-row) 'rule) "|-" - (concat "| " contents))) + (concat "|" contents))) ;;;; Verse Block @@ -2545,7 +2608,7 @@ their value. Return a list whose CAR is `verse-block' and CDR is a plist containing `:begin', `:end', `:contents-begin', `:contents-end', -`:hiddenp', `:post-blank' and `:post-affiliated' keywords. +`:post-blank' and `:post-affiliated' keywords. Assume point is at beginning of the block." (let ((case-fold-search t)) @@ -2557,8 +2620,7 @@ Assume point is at beginning of the block." (save-excursion (let* ((begin (car affiliated)) (post-affiliated (point)) - (hidden (progn (forward-line) (org-invisible-p2))) - (contents-begin (point)) + (contents-begin (progn (forward-line) (point))) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -2570,13 +2632,12 @@ Assume point is at beginning of the block." :end end :contents-begin contents-begin :contents-end contents-end - :hiddenp hidden :post-blank (count-lines pos-before-blank end) :post-affiliated post-affiliated) (cdr affiliated))))))))) -(defun org-element-verse-block-interpreter (verse-block contents) - "Interpret VERSE-BLOCK element as Org syntax. +(defun org-element-verse-block-interpreter (_ contents) + "Interpret verse-block element as Org syntax. CONTENTS is verse block contents." (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) @@ -2584,373 +2645,289 @@ CONTENTS is verse block contents." ;;; Objects ;; -;; Unlike to elements, interstices can be found between objects. -;; That's why, along with the parser, successor functions are provided -;; for each object. Some objects share the same successor (e.g., -;; `code' and `verbatim' objects). -;; -;; A successor must accept a single argument bounding the search. It -;; will return either a cons cell whose CAR is the object's type, as -;; a symbol, and CDR the position of its next occurrence, or nil. -;; -;; Successors follow the naming convention: -;; org-element-NAME-successor, where NAME is the name of the -;; successor, as defined in `org-element-all-successors'. +;; Unlike to elements, raw text can be found between objects. Hence, +;; `org-element--object-lex' is provided to find the next object in +;; buffer. ;; ;; Some object types (e.g., `italic') are recursive. Restrictions on ;; object types they can contain will be specified in ;; `org-element-object-restrictions'. ;; -;; Adding a new type of object is simple. Implement a successor, -;; a parser, and an interpreter for it, all following the naming -;; convention. Register type in `org-element-all-objects' and -;; successor in `org-element-all-successors'. Maybe tweak -;; restrictions about it, and that's it. - +;; Creating a new type of object requires to alter +;; `org-element--object-regexp' and `org-element--object-lex', add the +;; new type in `org-element-all-objects', and possibly add +;; restrictions in `org-element-object-restrictions'. ;;;; Bold (defun org-element-bold-parser () - "Parse bold object at point. + "Parse bold object at point, if any. -Return a list whose CAR is `bold' and CDR is a plist with -`:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. +When at a bold object, return a list whose car is `bold' and cdr +is a plist with `:begin', `:end', `:contents-begin' and +`:contents-end' and `:post-blank' keywords. Otherwise, return +nil. Assume point is at the first star marker." (save-excursion (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'bold - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-bold-interpreter (bold contents) - "Interpret BOLD object as Org syntax. + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'bold + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-bold-interpreter (_ contents) + "Interpret bold object as Org syntax. CONTENTS is the contents of the object." (format "*%s*" contents)) -(defun org-element-text-markup-successor () - "Search for the next text-markup object. - -Return value is a cons cell whose CAR is a symbol among `bold', -`italic', `underline', `strike-through', `code' and `verbatim' -and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (when (re-search-forward org-emph-re nil t) - (let ((marker (match-string 3))) - (cons (cond - ((equal marker "*") 'bold) - ((equal marker "/") 'italic) - ((equal marker "_") 'underline) - ((equal marker "+") 'strike-through) - ((equal marker "~") 'code) - ((equal marker "=") 'verbatim) - (t (error "Unknown marker at %d" (match-beginning 3)))) - (match-beginning 2)))))) - ;;;; Code (defun org-element-code-parser () - "Parse code object at point. + "Parse code object at point, if any. -Return a list whose CAR is `code' and CDR is a plist with -`:value', `:begin', `:end' and `:post-blank' keywords. +When at a code object, return a list whose car is `code' and cdr +is a plist with `:value', `:begin', `:end' and `:post-blank' +keywords. Otherwise, return nil. Assume point is at the first tilde marker." (save-excursion (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'code - (list :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-code-interpreter (code contents) - "Interpret CODE object as Org syntax. -CONTENTS is nil." + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'code + (list :value value + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-code-interpreter (code _) + "Interpret CODE object as Org syntax." (format "~%s~" (org-element-property :value code))) ;;;; Entity (defun org-element-entity-parser () - "Parse entity at point. + "Parse entity at point, if any. -Return a list whose CAR is `entity' and CDR a plist with -`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1', -`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as -keywords. +When at an entity, return a list whose car is `entity' and cdr +a plist with `:begin', `:end', `:latex', `:latex-math-p', +`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. Assume point is at the beginning of the entity." - (save-excursion - (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") - (let* ((value (org-entity-get (match-string 1))) - (begin (match-beginning 0)) - (bracketsp (string= (match-string 2) "{}")) - (post-blank (progn (goto-char (match-end 1)) - (when bracketsp (forward-char 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'entity - (list :name (car value) - :latex (nth 1 value) - :latex-math-p (nth 2 value) - :html (nth 3 value) - :ascii (nth 4 value) - :latin1 (nth 5 value) - :utf-8 (nth 6 value) - :begin begin - :end end - :use-brackets-p bracketsp - :post-blank post-blank))))) - -(defun org-element-entity-interpreter (entity contents) - "Interpret ENTITY object as Org syntax. -CONTENTS is nil." + (catch 'no-object + (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") + (save-excursion + (let* ((value (or (org-entity-get (match-string 1)) + (throw 'no-object nil))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'entity + (list :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :begin begin + :end end + :use-brackets-p bracketsp + :post-blank post-blank))))))) + +(defun org-element-entity-interpreter (entity _) + "Interpret ENTITY object as Org syntax." (concat "\\" (org-element-property :name entity) (when (org-element-property :use-brackets-p entity) "{}"))) -(defun org-element-latex-or-entity-successor () - "Search for the next latex-fragment or entity object. - -Return value is a cons cell whose CAR is `entity' or -`latex-fragment' and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (let ((matchers (cdr org-latex-regexps)) - ;; ENTITY-RE matches both LaTeX commands and Org entities. - (entity-re - "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")) - (when (re-search-forward - (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t) - (goto-char (match-beginning 0)) - (if (looking-at entity-re) - ;; Determine if it's a real entity or a LaTeX command. - (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) - (match-beginning 0)) - ;; No entity nor command: point is at a LaTeX fragment. - ;; Determine its type to get the correct beginning position. - (cons 'latex-fragment - (catch 'return - (dolist (e matchers) - (when (looking-at (nth 1 e)) - (throw 'return (match-beginning (nth 2 e))))) - (point)))))))) - ;;;; Export Snippet (defun org-element-export-snippet-parser () "Parse export snippet at point. -Return a list whose CAR is `export-snippet' and CDR a plist with -`:begin', `:end', `:back-end', `:value' and `:post-blank' as -keywords. +When at an export snippet, return a list whose car is +`export-snippet' and cdr a plist with `:begin', `:end', +`:back-end', `:value' and `:post-blank' as keywords. Otherwise, +return nil. Assume point is at the beginning of the snippet." (save-excursion - (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t) - (let* ((begin (match-beginning 0)) - (back-end (org-match-string-no-properties 1)) - (value (buffer-substring-no-properties - (point) - (progn (re-search-forward "@@" nil t) (match-beginning 0)))) - (post-blank (skip-chars-forward " \t")) - (end (point))) - (list 'export-snippet - (list :back-end back-end - :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-export-snippet-interpreter (export-snippet contents) - "Interpret EXPORT-SNIPPET object as Org syntax. -CONTENTS is nil." + (let (contents-end) + (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):") + (setq contents-end + (save-match-data (goto-char (match-end 0)) + (re-search-forward "@@" nil t) + (match-beginning 0)))) + (let* ((begin (match-beginning 0)) + (back-end (match-string-no-properties 1)) + (value (buffer-substring-no-properties + (match-end 0) contents-end)) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'export-snippet + (list :back-end back-end + :value value + :begin begin + :end end + :post-blank post-blank))))))) + +(defun org-element-export-snippet-interpreter (export-snippet _) + "Interpret EXPORT-SNIPPET object as Org syntax." (format "@@%s:%s@@" (org-element-property :back-end export-snippet) (org-element-property :value export-snippet))) -(defun org-element-export-snippet-successor () - "Search for the next export-snippet object. - -Return value is a cons cell whose CAR is `export-snippet' and CDR -its beginning position." - (save-excursion - (let (beg) - (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t) - (setq beg (match-beginning 0)) - (search-forward "@@" nil t)) - (cons 'export-snippet beg))))) - ;;;; Footnote Reference (defun org-element-footnote-reference-parser () - "Parse footnote reference at point. - -Return a list whose CAR is `footnote-reference' and CDR a plist -with `:label', `:type', `:inline-definition', `:begin', `:end' -and `:post-blank' as keywords." - (save-excursion - (looking-at org-footnote-re) - (let* ((begin (point)) - (label (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) - (type (if (or (not label) (match-string 1)) 'inline 'standard)) - (inner-begin (match-end 0)) - (inner-end - (let ((count 1)) - (forward-char) - (while (and (> count 0) (re-search-forward "[][]" nil t)) - (if (equal (match-string 0) "[") (incf count) (decf count))) - (1- (point)))) - (post-blank (progn (goto-char (1+ inner-end)) - (skip-chars-forward " \t"))) - (end (point)) - (footnote-reference + "Parse footnote reference at point, if any. + +When at a footnote reference, return a list whose car is +`footnote-reference' and cdr a plist with `:label', `:type', +`:begin', `:end', `:content-begin', `:contents-end' and +`:post-blank' as keywords. Otherwise, return nil." + (when (looking-at org-footnote-re) + (let ((closing (with-syntax-table org-element--pair-square-table + (ignore-errors (scan-lists (point) 1 0))))) + (when closing + (save-excursion + (let* ((begin (point)) + (label (match-string-no-properties 1)) + (inner-begin (match-end 0)) + (inner-end (1- closing)) + (type (if (match-end 2) 'inline 'standard)) + (post-blank (progn (goto-char closing) + (skip-chars-forward " \t"))) + (end (point))) (list 'footnote-reference (list :label label :type type :begin begin :end end - :post-blank post-blank)))) - (org-element-put-property - footnote-reference :inline-definition - (and (eq type 'inline) - (org-element-parse-secondary-string - (buffer-substring inner-begin inner-end) - (org-element-restriction 'footnote-reference) - footnote-reference)))))) + :contents-begin (and (eq type 'inline) inner-begin) + :contents-end (and (eq type 'inline) inner-end) + :post-blank post-blank)))))))) (defun org-element-footnote-reference-interpreter (footnote-reference contents) "Interpret FOOTNOTE-REFERENCE object as Org syntax. -CONTENTS is nil." - (let ((label (or (org-element-property :label footnote-reference) "fn:")) - (def - (let ((inline-def - (org-element-property :inline-definition footnote-reference))) - (if (not inline-def) "" - (concat ":" (org-element-interpret-data inline-def)))))) - (format "[%s]" (concat label def)))) - -(defun org-element-footnote-reference-successor () - "Search for the next footnote-reference object. - -Return value is a cons cell whose CAR is `footnote-reference' and -CDR is beginning position." - (save-excursion - (catch 'exit - (while (re-search-forward org-footnote-re nil t) - (save-excursion - (let ((beg (match-beginning 0)) - (count 1)) - (backward-char) - (while (re-search-forward "[][]" nil t) - (if (equal (match-string 0) "[") (incf count) (decf count)) - (when (zerop count) - (throw 'exit (cons 'footnote-reference beg)))))))))) +CONTENTS is its definition, when inline, or nil." + (format "[fn:%s%s]" + (or (org-element-property :label footnote-reference) "") + (if contents (concat ":" contents) ""))) ;;;; Inline Babel Call (defun org-element-inline-babel-call-parser () - "Parse inline babel call at point. + "Parse inline babel call at point, if any. -Return a list whose CAR is `inline-babel-call' and CDR a plist -with `:begin', `:end', `:info' and `:post-blank' as keywords. +When at an inline babel call, return a list whose car is +`inline-babel-call' and cdr a plist with `:call', +`:inside-header', `:arguments', `:end-header', `:begin', `:end', +`:value' and `:post-blank' as keywords. Otherwise, return nil. Assume point is at the beginning of the babel call." (save-excursion - (unless (bolp) (backward-char)) - (looking-at org-babel-inline-lob-one-liner-regexp) - (let ((info (save-match-data (org-babel-lob-get-info))) - (begin (match-end 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'inline-babel-call - (list :begin begin - :end end - :info info - :post-blank post-blank))))) - -(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) - "Interpret INLINE-BABEL-CALL object as Org syntax. -CONTENTS is nil." - (let* ((babel-info (org-element-property :info inline-babel-call)) - (main-source (car babel-info)) - (post-options (nth 1 babel-info))) - (concat "call_" - (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) - ;; Remove redundant square brackets. - (replace-match - (match-string 1 main-source) nil nil main-source) - main-source) - (and post-options (format "[%s]" post-options))))) - -(defun org-element-inline-babel-call-successor () - "Search for the next inline-babel-call object. - -Return value is a cons cell whose CAR is `inline-babel-call' and -CDR is beginning position." - (save-excursion - (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t) - (cons 'inline-babel-call (match-end 1))))) + (catch :no-object + (when (let ((case-fold-search nil)) + (looking-at "\\ + (setq format 'plain) + (setq raw-link (match-string-no-properties 0)) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq path (match-string-no-properties 2))) + ;; Type 4: Angular link, e.g., . Unlike to + ;; bracket links, follow RFC 3986 and remove any extra + ;; whitespace in URI. ((looking-at org-angle-link-re) - (setq raw-link (buffer-substring-no-properties - (match-beginning 1) (match-end 2)) - type (org-match-string-no-properties 1) - link-end (match-end 0) - path (org-match-string-no-properties 2)))) + (setq format 'angle) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq raw-link + (buffer-substring-no-properties + (match-beginning 1) (match-end 2))) + (setq path (replace-regexp-in-string + "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) + (t (throw 'no-object nil))) ;; In any case, deduce end point after trailing white space from ;; LINK-END variable. - (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) - end (point)) - ;; Special "file" type link processing. - (when (member type org-element-link-type-is-file) - ;; Extract opening application and search option. - (cond ((string-match "^file\\+\\(.*\\)$" type) - (setq application (match-string 1 type))) - ((not (string-match "^file" type)) - (setq application type))) + (save-excursion + (setq post-blank + (progn (goto-char link-end) (skip-chars-forward " \t"))) + (setq end (point))) + ;; Special "file" type link processing. Extract opening + ;; application and search option, if any. Also normalize URI. + (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) + (setq application (match-string 1 type) type "file") (when (string-match "::\\(.*\\)\\'" path) - (setq search-option (match-string 1 path) - path (replace-match "" nil nil path))) - ;; Normalize URI. - (when (and (not (org-string-match-p "\\`//" path)) - (file-name-absolute-p path)) - (setq path (concat "//" (expand-file-name path)))) - ;; Make sure TYPE always reports "file". - (setq type "file")) + (setq search-option (match-string 1 path)) + (setq path (replace-match "" nil nil path))) + (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) + ;; Translate link, if `org-link-translation-function' is set. + (let ((trans (and (functionp org-link-translation-function) + (funcall org-link-translation-function type path)))) + (when trans + (setq type (car trans)) + (setq path (cdr trans)))) (list 'link (list :type type :path path + :format format :raw-link (or raw-link path) :application application :search-option search-option @@ -3180,197 +3170,167 @@ Assume point is at the beginning of the link." "Interpret LINK object as Org syntax. CONTENTS is the contents of the object, or nil." (let ((type (org-element-property :type link)) - (raw-link (org-element-property :raw-link link))) - (if (string= type "radio") raw-link - (format "[[%s]%s]" - raw-link - (if contents (format "[%s]" contents) ""))))) - -(defun org-element-link-successor () - "Search for the next link object. - -Return value is a cons cell whose CAR is `link' and CDR is -beginning position." - (save-excursion - (let ((link-regexp - (if (not org-target-link-regexp) org-any-link-re - (concat org-any-link-re "\\|" org-target-link-regexp)))) - (when (re-search-forward link-regexp nil t) - (cons 'link (match-beginning 0)))))) - -(defun org-element-plain-link-successor () - "Search for the next plain link object. - -Return value is a cons cell whose CAR is `link' and CDR is -beginning position." - (and (save-excursion (re-search-forward org-plain-link-re nil t)) - (cons 'link (match-beginning 0)))) + (path (org-element-property :path link))) + (if (string= type "radio") path + (let ((fmt (pcase (org-element-property :format link) + ;; Links with contents and internal links have to + ;; use bracket syntax. Ignore `:format' in these + ;; cases. This is also the default syntax when the + ;; property is not defined, e.g., when the object + ;; was crafted by the user. + ((guard contents) + (format "[[%%s][%s]]" + ;; Since this is going to be used as + ;; a format string, escape percent signs + ;; in description. + (replace-regexp-in-string "%" "%%" contents))) + ((or `bracket + `nil + (guard (member type '("coderef" "custom-id" "fuzzy")))) + "[[%s]]") + ;; Otherwise, just obey to `:format'. + (`angle "<%s>") + (`plain "%s") + (f (error "Wrong `:format' value: %s" f))))) + (format fmt + (pcase type + ("coderef" (format "(%s)" path)) + ("custom-id" (concat "#" path)) + ("file" + (let ((app (org-element-property :application link)) + (opt (org-element-property :search-option link))) + (concat type (and app (concat "+" app)) ":" + path + (and opt (concat "::" opt))))) + ("fuzzy" path) + (_ (concat type ":" path)))))))) ;;;; Macro (defun org-element-macro-parser () - "Parse macro at point. + "Parse macro at point, if any. -Return a list whose CAR is `macro' and CDR a plist with `:key', -`:args', `:begin', `:end', `:value' and `:post-blank' as -keywords. +When at a macro, return a list whose car is `macro' and cdr +a plist with `:key', `:args', `:begin', `:end', `:value' and +`:post-blank' as keywords. Otherwise, return nil. Assume point is at the macro." (save-excursion - (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") - (let ((begin (point)) - (key (downcase (org-match-string-no-properties 1))) - (value (org-match-string-no-properties 0)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (args (let ((args (org-match-string-no-properties 3))) - (when args - ;; Do not use `org-split-string' since empty - ;; strings are meaningful here. - (split-string - (replace-regexp-in-string - "\\(\\\\*\\)\\(,\\)" - (lambda (str) - (let ((len (length (match-string 1 str)))) - (concat (make-string (/ len 2) ?\\) - (if (zerop (mod len 2)) "\000" ",")))) - args nil t) - "\000"))))) - (list 'macro - (list :key key - :value value - :args args - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-macro-interpreter (macro contents) - "Interpret MACRO object as Org syntax. -CONTENTS is nil." + (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") + (let ((begin (point)) + (key (downcase (match-string-no-properties 1))) + (value (match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (let ((args (match-string-no-properties 3))) + (and args (org-macro-extract-arguments args))))) + (list 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-macro-interpreter (macro _) + "Interpret MACRO object as Org syntax." (org-element-property :value macro)) -(defun org-element-macro-successor () - "Search for the next macro object. - -Return value is cons cell whose CAR is `macro' and CDR is -beginning position." - (save-excursion - (when (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" - nil t) - (cons 'macro (match-beginning 0))))) - ;;;; Radio-target (defun org-element-radio-target-parser () - "Parse radio target at point. + "Parse radio target at point, if any. -Return a list whose CAR is `radio-target' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', `:value' -and `:post-blank' as keywords. +When at a radio target, return a list whose car is `radio-target' +and cdr a plist with `:begin', `:end', `:contents-begin', +`:contents-end', `:value' and `:post-blank' as keywords. +Otherwise, return nil. Assume point is at the radio target." (save-excursion - (looking-at org-radio-target-regexp) - (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'radio-target - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank - :value value))))) - -(defun org-element-radio-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. + (when (looking-at org-radio-target-regexp) + (let ((begin (point)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (value (match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'radio-target + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank + :value value)))))) + +(defun org-element-radio-target-interpreter (_ contents) + "Interpret target object as Org syntax. CONTENTS is the contents of the object." (concat "<<<" contents ">>>")) -(defun org-element-radio-target-successor () - "Search for the next radio-target object. - -Return value is a cons cell whose CAR is `radio-target' and CDR -is beginning position." - (save-excursion - (when (re-search-forward org-radio-target-regexp nil t) - (cons 'radio-target (match-beginning 0))))) - ;;;; Statistics Cookie (defun org-element-statistics-cookie-parser () - "Parse statistics cookie at point. + "Parse statistics cookie at point, if any. -Return a list whose CAR is `statistics-cookie', and CDR a plist -with `:begin', `:end', `:value' and `:post-blank' keywords. +When at a statistics cookie, return a list whose car is +`statistics-cookie', and cdr a plist with `:begin', `:end', +`:value' and `:post-blank' keywords. Otherwise, return nil. Assume point is at the beginning of the statistics-cookie." (save-excursion - (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") - (let* ((begin (point)) - (value (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'statistics-cookie - (list :begin begin - :end end - :value value - :post-blank post-blank))))) - -(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) - "Interpret STATISTICS-COOKIE object as Org syntax. -CONTENTS is nil." + (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") + (let* ((begin (point)) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) + +(defun org-element-statistics-cookie-interpreter (statistics-cookie _) + "Interpret STATISTICS-COOKIE object as Org syntax." (org-element-property :value statistics-cookie)) -(defun org-element-statistics-cookie-successor () - "Search for the next statistics cookie object. - -Return value is a cons cell whose CAR is `statistics-cookie' and -CDR is beginning position." - (save-excursion - (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t) - (cons 'statistics-cookie (match-beginning 0))))) - ;;;; Strike-Through (defun org-element-strike-through-parser () - "Parse strike-through object at point. + "Parse strike-through object at point, if any. -Return a list whose CAR is `strike-through' and CDR is a plist -with `:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. +When at a strike-through object, return a list whose car is +`strike-through' and cdr is a plist with `:begin', `:end', +`:contents-begin' and `:contents-end' and `:post-blank' keywords. +Otherwise, return nil. Assume point is at the first plus sign marker." (save-excursion (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'strike-through - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-strike-through-interpreter (strike-through contents) - "Interpret STRIKE-THROUGH object as Org syntax. + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'strike-through + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-strike-through-interpreter (_ contents) + "Interpret strike-through object as Org syntax. CONTENTS is the contents of the object." (format "+%s+" contents)) @@ -3378,32 +3338,32 @@ CONTENTS is the contents of the object." ;;;; Subscript (defun org-element-subscript-parser () - "Parse subscript at point. + "Parse subscript at point, if any. -Return a list whose CAR is `subscript' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', -`:use-brackets-p' and `:post-blank' as keywords. +When at a subscript object, return a list whose car is +`subscript' and cdr a plist with `:begin', `:end', +`:contents-begin', `:contents-end', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. Assume point is at the underscore." (save-excursion (unless (bolp) (backward-char)) - (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) - t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'subscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) + (when (looking-at org-match-substring-regexp) + (let ((bracketsp (match-beginning 4)) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 4) + (match-beginning 3))) + (contents-end (or (match-end 4) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'subscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) (defun org-element-subscript-interpreter (subscript contents) "Interpret SUBSCRIPT object as Org syntax. @@ -3412,46 +3372,36 @@ CONTENTS is the contents of the object." (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") contents)) -(defun org-element-sub/superscript-successor () - "Search for the next sub/superscript object. - -Return value is a cons cell whose CAR is either `subscript' or -`superscript' and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (when (re-search-forward org-match-substring-regexp nil t) - (cons (if (string= (match-string 2) "_") 'subscript 'superscript) - (match-beginning 2))))) - ;;;; Superscript (defun org-element-superscript-parser () - "Parse superscript at point. + "Parse superscript at point, if any. -Return a list whose CAR is `superscript' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', -`:use-brackets-p' and `:post-blank' as keywords. +When at a superscript object, return a list whose car is +`superscript' and cdr a plist with `:begin', `:end', +`:contents-begin', `:contents-end', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. Assume point is at the caret." (save-excursion (unless (bolp) (backward-char)) - (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'superscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) + (when (looking-at org-match-substring-regexp) + (let ((bracketsp (match-beginning 4)) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 4) + (match-beginning 3))) + (contents-end (or (match-end 4) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'superscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) (defun org-element-superscript-interpreter (superscript contents) "Interpret SUPERSCRIPT object as Org syntax. @@ -3465,8 +3415,7 @@ CONTENTS is the contents of the object." (defun org-element-table-cell-parser () "Parse table cell at point. - -Return a list whose CAR is `table-cell' and CDR is a plist +Return a list whose car is `table-cell' and cdr is a plist containing `:begin', `:end', `:contents-begin', `:contents-end' and `:post-blank' keywords." (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") @@ -3481,299 +3430,275 @@ and `:post-blank' keywords." :contents-end contents-end :post-blank 0)))) -(defun org-element-table-cell-interpreter (table-cell contents) - "Interpret TABLE-CELL element as Org syntax. +(defun org-element-table-cell-interpreter (_ contents) + "Interpret table-cell element as Org syntax. CONTENTS is the contents of the cell, or nil." (concat " " contents " |")) -(defun org-element-table-cell-successor () - "Search for the next table-cell object. - -Return value is a cons cell whose CAR is `table-cell' and CDR is -beginning position." - (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point)))) - ;;;; Target (defun org-element-target-parser () - "Parse target at point. + "Parse target at point, if any. -Return a list whose CAR is `target' and CDR a plist with -`:begin', `:end', `:value' and `:post-blank' as keywords. +When at a target, return a list whose car is `target' and cdr +a plist with `:begin', `:end', `:value' and `:post-blank' as +keywords. Otherwise, return nil. Assume point is at the target." (save-excursion - (looking-at org-target-regexp) - (let ((begin (point)) - (value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'target - (list :begin begin - :end end - :value value - :post-blank post-blank))))) - -(defun org-element-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. -CONTENTS is nil." + (when (looking-at org-target-regexp) + (let ((begin (point)) + (value (match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'target + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) + +(defun org-element-target-interpreter (target _) + "Interpret TARGET object as Org syntax." (format "<<%s>>" (org-element-property :value target))) -(defun org-element-target-successor () - "Search for the next target object. - -Return value is a cons cell whose CAR is `target' and CDR is -beginning position." - (save-excursion - (when (re-search-forward org-target-regexp nil t) - (cons 'target (match-beginning 0))))) - ;;;; Timestamp +(defconst org-element--timestamp-regexp + (concat org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + "Regexp matching any timestamp type object.") + (defun org-element-timestamp-parser () - "Parse time stamp at point. + "Parse time stamp at point, if any. -Return a list whose CAR is `timestamp', and CDR a plist with -`:type', `:raw-value', `:year-start', `:month-start', -`:day-start', `:hour-start', `:minute-start', `:year-end', -`:month-end', `:day-end', `:hour-end', `:minute-end', -`:repeater-type', `:repeater-value', `:repeater-unit', -`:warning-type', `:warning-value', `:warning-unit', `:begin', -`:end' and `:post-blank' keywords. +When at a time stamp, return a list whose car is `timestamp', and +cdr a plist with `:type', `:raw-value', `:year-start', +`:month-start', `:day-start', `:hour-start', `:minute-start', +`:year-end', `:month-end', `:day-end', `:hour-end', +`:minute-end', `:repeater-type', `:repeater-value', +`:repeater-unit', `:warning-type', `:warning-value', +`:warning-unit', `:begin', `:end' and `:post-blank' keywords. +Otherwise, return nil. Assume point is at the beginning of the timestamp." - (save-excursion - (let* ((begin (point)) - (activep (eq (char-after) ?<)) - (raw-value - (progn - (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") - (match-string-no-properties 0))) - (date-start (match-string-no-properties 1)) - (date-end (match-string 3)) - (diaryp (match-beginning 2)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (time-range - (and (not diaryp) - (string-match - "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" - date-start) - (cons (string-to-number (match-string 2 date-start)) - (string-to-number (match-string 3 date-start))))) - (type (cond (diaryp 'diary) - ((and activep (or date-end time-range)) 'active-range) - (activep 'active) - ((or date-end time-range) 'inactive-range) - (t 'inactive))) - (repeater-props - (and (not diaryp) - (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" - raw-value) - (list - :repeater-type - (let ((type (match-string 1 raw-value))) - (cond ((equal "++" type) 'catch-up) - ((equal ".+" type) 'restart) - (t 'cumulate))) - :repeater-value (string-to-number (match-string 2 raw-value)) - :repeater-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) - (warning-props - (and (not diaryp) - (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) - (list - :warning-type (if (match-string 1 raw-value) 'first 'all) - :warning-value (string-to-number (match-string 2 raw-value)) - :warning-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) - year-start month-start day-start hour-start minute-start year-end - month-end day-end hour-end minute-end) - ;; Parse date-start. - (unless diaryp - (let ((date (org-parse-time-string date-start t))) - (setq year-start (nth 5 date) - month-start (nth 4 date) - day-start (nth 3 date) - hour-start (nth 2 date) - minute-start (nth 1 date)))) - ;; Compute date-end. It can be provided directly in time-stamp, - ;; or extracted from time range. Otherwise, it defaults to the - ;; same values as date-start. - (unless diaryp - (let ((date (and date-end (org-parse-time-string date-end t)))) - (setq year-end (or (nth 5 date) year-start) - month-end (or (nth 4 date) month-start) - day-end (or (nth 3 date) day-start) - hour-end (or (nth 2 date) (car time-range) hour-start) - minute-end (or (nth 1 date) (cdr time-range) minute-start)))) - (list 'timestamp - (nconc (list :type type - :raw-value raw-value - :year-start year-start - :month-start month-start - :day-start day-start - :hour-start hour-start - :minute-start minute-start - :year-end year-end - :month-end month-end - :day-end day-end - :hour-end hour-end - :minute-end minute-end - :begin begin - :end end - :post-blank post-blank) - repeater-props - warning-props))))) - -(defun org-element-timestamp-interpreter (timestamp contents) - "Interpret TIMESTAMP object as Org syntax. -CONTENTS is nil." - ;; Use `:raw-value' if specified. - (or (org-element-property :raw-value timestamp) - ;; Otherwise, build timestamp string. - (let* ((repeat-string - (concat - (case (org-element-property :repeater-type timestamp) - (cumulate "+") (catch-up "++") (restart ".+")) - (let ((val (org-element-property :repeater-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :repeater-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (warning-string - (concat - (case (org-element-property :warning-type timestamp) - (first "--") - (all "-")) - (let ((val (org-element-property :warning-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :warning-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (build-ts-string - ;; Build an Org timestamp string from TIME. ACTIVEP is - ;; non-nil when time stamp is active. If WITH-TIME-P is - ;; non-nil, add a time part. HOUR-END and MINUTE-END - ;; specify a time range in the timestamp. REPEAT-STRING - ;; is the repeater string, if any. - (lambda (time activep &optional with-time-p hour-end minute-end) - (let ((ts (format-time-string - (funcall (if with-time-p 'cdr 'car) - org-time-stamp-formats) - time))) - (when (and hour-end minute-end) - (string-match "[012]?[0-9]:[0-5][0-9]" ts) - (setq ts - (replace-match - (format "\\&-%02d:%02d" hour-end minute-end) - nil nil ts))) - (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) - (dolist (s (list repeat-string warning-string)) - (when (org-string-nw-p s) - (setq ts (concat (substring ts 0 -1) - " " - s - (substring ts -1))))) - ;; Return value. - ts))) - (type (org-element-property :type timestamp))) - (case type - ((active inactive) - (let* ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp)) - (time-range-p (and hour-start hour-end minute-start minute-end - (or (/= hour-start hour-end) - (/= minute-start minute-end))))) - (funcall - build-ts-string - (encode-time 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active) - (and hour-start minute-start) - (and time-range-p hour-end) - (and time-range-p minute-end)))) - ((active-range inactive-range) - (let ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp))) - (concat - (funcall - build-ts-string (encode-time - 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active-range) - (and hour-start minute-start)) - "--" - (funcall build-ts-string - (encode-time 0 - (or minute-end 0) - (or hour-end 0) - (org-element-property :day-end timestamp) - (org-element-property :month-end timestamp) - (org-element-property :year-end timestamp)) - (eq type 'active-range) - (and hour-end minute-end))))))))) - -(defun org-element-timestamp-successor () - "Search for the next timestamp object. - -Return value is a cons cell whose CAR is `timestamp' and CDR is -beginning position." - (save-excursion - (when (re-search-forward - (concat org-ts-regexp-both - "\\|" - "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" - "\\|" - "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") - nil t) - (cons 'timestamp (match-beginning 0))))) + (when (looking-at-p org-element--timestamp-regexp) + (save-excursion + (let* ((begin (point)) + (activep (eq (char-after) ?<)) + (raw-value + (progn + (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") + (match-string-no-properties 0))) + (date-start (match-string-no-properties 1)) + (date-end (match-string 3)) + (diaryp (match-beginning 2)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (time-range + (and (not diaryp) + (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start))))) + (type (cond (diaryp 'diary) + ((and activep (or date-end time-range)) 'active-range) + (activep 'active) + ((or date-end time-range) 'inactive-range) + (t 'inactive))) + (repeater-props + (and (not diaryp) + (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" + raw-value) + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) + (warning-props + (and (not diaryp) + (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) + (list + :warning-type (if (match-string 1 raw-value) 'first 'all) + :warning-value (string-to-number (match-string 2 raw-value)) + :warning-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) + year-start month-start day-start hour-start minute-start year-end + month-end day-end hour-end minute-end) + ;; Parse date-start. + (unless diaryp + (let ((date (org-parse-time-string date-start t))) + (setq year-start (nth 5 date) + month-start (nth 4 date) + day-start (nth 3 date) + hour-start (nth 2 date) + minute-start (nth 1 date)))) + ;; Compute date-end. It can be provided directly in time-stamp, + ;; or extracted from time range. Otherwise, it defaults to the + ;; same values as date-start. + (unless diaryp + (let ((date (and date-end (org-parse-time-string date-end t)))) + (setq year-end (or (nth 5 date) year-start) + month-end (or (nth 4 date) month-start) + day-end (or (nth 3 date) day-start) + hour-end (or (nth 2 date) (car time-range) hour-start) + minute-end (or (nth 1 date) (cdr time-range) minute-start)))) + (list 'timestamp + (nconc (list :type type + :raw-value raw-value + :year-start year-start + :month-start month-start + :day-start day-start + :hour-start hour-start + :minute-start minute-start + :year-end year-end + :month-end month-end + :day-end day-end + :hour-end hour-end + :minute-end minute-end + :begin begin + :end end + :post-blank post-blank) + repeater-props + warning-props)))))) + +(defun org-element-timestamp-interpreter (timestamp _) + "Interpret TIMESTAMP object as Org syntax." + (let* ((repeat-string + (concat + (pcase (org-element-property :repeater-type timestamp) + (`cumulate "+") (`catch-up "++") (`restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :repeater-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + (warning-string + (concat + (pcase (org-element-property :warning-type timestamp) + (`first "--") (`all "-")) + (let ((val (org-element-property :warning-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :warning-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + (build-ts-string + ;; Build an Org timestamp string from TIME. ACTIVEP is + ;; non-nil when time stamp is active. If WITH-TIME-P is + ;; non-nil, add a time part. HOUR-END and MINUTE-END + ;; specify a time range in the timestamp. REPEAT-STRING is + ;; the repeater string, if any. + (lambda (time activep &optional with-time-p hour-end minute-end) + (let ((ts (format-time-string + (funcall (if with-time-p #'cdr #'car) + org-time-stamp-formats) + time))) + (when (and hour-end minute-end) + (string-match "[012]?[0-9]:[0-5][0-9]" ts) + (setq ts + (replace-match + (format "\\&-%02d:%02d" hour-end minute-end) + nil nil ts))) + (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) + (dolist (s (list repeat-string warning-string)) + (when (org-string-nw-p s) + (setq ts (concat (substring ts 0 -1) + " " + s + (substring ts -1))))) + ;; Return value. + ts))) + (type (org-element-property :type timestamp))) + (pcase type + ((or `active `inactive) + (let* ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (time-range-p (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))))) + (funcall + build-ts-string + (encode-time 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active) + (and hour-start minute-start) + (and time-range-p hour-end) + (and time-range-p minute-end)))) + ((or `active-range `inactive-range) + (let ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp))) + (concat + (funcall + build-ts-string (encode-time + 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active-range) + (and hour-start minute-start)) + "--" + (funcall build-ts-string + (encode-time 0 + (or minute-end 0) + (or hour-end 0) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp)) + (eq type 'active-range) + (and hour-end minute-end))))) + (_ (org-element-property :raw-value timestamp))))) ;;;; Underline (defun org-element-underline-parser () - "Parse underline object at point. + "Parse underline object at point, if any. -Return a list whose CAR is `underline' and CDR is a plist with -`:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. +When at an underline object, return a list whose car is +`underline' and cdr is a plist with `:begin', `:end', +`:contents-begin' and `:contents-end' and `:post-blank' keywords. +Otherwise, return nil. Assume point is at the first underscore marker." (save-excursion (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'underline - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-underline-interpreter (underline contents) - "Interpret UNDERLINE object as Org syntax. + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'underline + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-underline-interpreter (_ contents) + "Interpret underline object as Org syntax. CONTENTS is the contents of the object." (format "_%s_" contents)) @@ -3781,29 +3706,29 @@ CONTENTS is the contents of the object." ;;;; Verbatim (defun org-element-verbatim-parser () - "Parse verbatim object at point. + "Parse verbatim object at point, if any. -Return a list whose CAR is `verbatim' and CDR is a plist with -`:value', `:begin', `:end' and `:post-blank' keywords. +When at a verbatim object, return a list whose car is `verbatim' +and cdr is a plist with `:value', `:begin', `:end' and +`:post-blank' keywords. Otherwise, return nil. Assume point is at the first equal sign marker." (save-excursion (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'verbatim - (list :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-verbatim-interpreter (verbatim contents) - "Interpret VERBATIM object as Org syntax. -CONTENTS is nil." + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'verbatim + (list :value value + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-verbatim-interpreter (verbatim _) + "Interpret VERBATIM object as Org syntax." (format "=%s=" (org-element-property :value verbatim))) @@ -3818,10 +3743,9 @@ CONTENTS is nil." ;; are activated for fixed element chaining (e.g., `plain-list' > ;; `item') or fixed conditional element chaining (e.g., `headline' > ;; `section'). Special modes are: `first-section', `item', -;; `node-property', `quote-section', `section' and `table-row'. +;; `node-property', `section' and `table-row'. -(defun org-element--current-element - (limit &optional granularity special structure) +(defun org-element--current-element (limit &optional granularity mode structure) "Parse the element starting at point. Return value is a list like (TYPE PROPS) where TYPE is the type @@ -3838,12 +3762,12 @@ recursion. Allowed values are `headline', `greater-element', nil), secondary values will not be parsed, since they only contain objects. -Optional argument SPECIAL, when non-nil, can be either -`first-section', `item', `node-property', `quote-section', -`section', and `table-row'. +Optional argument MODE, when non-nil, can be either +`first-section', `section', `planning', `item', `node-property' +and `table-row'. -If STRUCTURE isn't provided but SPECIAL is set to `item', it will -be computed. +If STRUCTURE isn't provided but MODE is set to `item', it will be +computed. This function assumes point is always at the beginning of the element it has to parse." @@ -3855,30 +3779,37 @@ element it has to parse." (raw-secondary-p (and granularity (not (eq granularity 'object))))) (cond ;; Item. - ((eq special 'item) + ((eq mode 'item) (org-element-item-parser limit structure raw-secondary-p)) ;; Table Row. - ((eq special 'table-row) (org-element-table-row-parser limit)) + ((eq mode 'table-row) (org-element-table-row-parser limit)) ;; Node Property. - ((eq special 'node-property) (org-element-node-property-parser limit)) + ((eq mode 'node-property) (org-element-node-property-parser limit)) ;; Headline. ((org-with-limited-levels (org-at-heading-p)) (org-element-headline-parser limit raw-secondary-p)) ;; Sections (must be checked after headline). - ((eq special 'section) (org-element-section-parser limit)) - ((eq special 'quote-section) (org-element-quote-section-parser limit)) - ((eq special 'first-section) + ((eq mode 'section) (org-element-section-parser limit)) + ((eq mode 'first-section) (org-element-section-parser (or (save-excursion (org-with-limited-levels (outline-next-heading))) limit))) + ;; Planning. + ((and (eq mode 'planning) + (eq ?* (char-after (line-beginning-position 0))) + (looking-at org-planning-line-re)) + (org-element-planning-parser limit)) + ;; Property drawer. + ((and (memq mode '(planning property-drawer)) + (eq ?* (char-after (line-beginning-position + (if (eq mode 'planning) 0 -1)))) + (looking-at org-property-drawer-re)) + (org-element-property-drawer-parser limit)) ;; When not at bol, point is at the beginning of an item or ;; a footnote definition: next item is always a paragraph. ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) - ;; Planning and Clock. - ((looking-at org-planning-or-clock-line-re) - (if (equal (match-string 1) org-clock-string) - (org-element-clock-parser limit) - (org-element-planning-parser limit))) + ;; Clock. + ((looking-at org-clock-line-re) (org-element-clock-parser limit)) ;; Inlinetask. ((org-at-heading-p) (org-element-inlinetask-parser limit raw-secondary-p)) @@ -3891,13 +3822,11 @@ element it has to parse." (goto-char (car affiliated)) (org-element-keyword-parser limit nil)) ;; LaTeX Environment. - ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$") + ((looking-at org-element--latex-begin-environment) (org-element-latex-environment-parser limit affiliated)) ;; Drawer and Property Drawer. ((looking-at org-drawer-regexp) - (if (equal (match-string 1) "PROPERTIES") - (org-element-property-drawer-parser limit affiliated) - (org-element-drawer-parser limit affiliated))) + (org-element-drawer-parser limit affiliated)) ;; Fixed Width ((looking-at "[ \t]*:\\( \\|$\\)") (org-element-fixed-width-parser limit affiliated)) @@ -3905,27 +3834,35 @@ element it has to parse." ;; Keywords. ((looking-at "[ \t]*#") (goto-char (match-end 0)) - (cond ((looking-at "\\(?: \\|$\\)") - (beginning-of-line) - (org-element-comment-parser limit affiliated)) - ((looking-at "\\+BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (let ((parser (assoc (upcase (match-string 1)) - org-element-block-name-alist))) - (if parser (funcall (cdr parser) limit affiliated) - (org-element-special-block-parser limit affiliated)))) - ((looking-at "\\+CALL:") - (beginning-of-line) - (org-element-babel-call-parser limit affiliated)) - ((looking-at "\\+BEGIN:? ") - (beginning-of-line) - (org-element-dynamic-block-parser limit affiliated)) - ((looking-at "\\+\\S-+:") - (beginning-of-line) - (org-element-keyword-parser limit affiliated)) - (t - (beginning-of-line) - (org-element-paragraph-parser limit affiliated)))) + (cond + ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit affiliated)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (funcall (pcase (upcase (match-string 1)) + ("CENTER" #'org-element-center-block-parser) + ("COMMENT" #'org-element-comment-block-parser) + ("EXAMPLE" #'org-element-example-block-parser) + ("EXPORT" #'org-element-export-block-parser) + ("QUOTE" #'org-element-quote-block-parser) + ("SRC" #'org-element-src-block-parser) + ("VERSE" #'org-element-verse-block-parser) + (_ #'org-element-special-block-parser)) + limit + affiliated)) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit affiliated)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit affiliated)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit affiliated)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit affiliated)))) ;; Footnote Definition. ((looking-at org-footnote-definition-re) (org-element-footnote-definition-parser limit affiliated)) @@ -3936,7 +3873,8 @@ element it has to parse." ((looking-at "%%(") (org-element-diary-sexp-parser limit affiliated)) ;; Table. - ((org-at-table-p t) (org-element-table-parser limit affiliated)) + ((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)") + (org-element-table-parser limit affiliated)) ;; List. ((looking-at (org-item-re)) (org-element-plain-list-parser @@ -3980,7 +3918,7 @@ position of point and CDR is nil." (save-match-data (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol))))) + (match-end 0) (line-end-position))))) ;; PARSEDP is non-nil when keyword should have its ;; value parsed. (parsedp (member kwd org-element-parsed-keywords)) @@ -3989,14 +3927,20 @@ position of point and CDR is nil." (dualp (member kwd org-element-dual-keywords)) (dual-value (and dualp - (let ((sec (org-match-string-no-properties 2))) + (let ((sec (match-string-no-properties 2))) (if (or (not sec) (not parsedp)) sec - (org-element-parse-secondary-string sec restrict))))) + (save-match-data + (org-element--parse-objects + (match-beginning 2) (match-end 2) nil restrict)))))) ;; Attribute a property name to KWD. (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) ;; Now set final shape for VALUE. (when parsedp - (setq value (org-element-parse-secondary-string value restrict))) + (setq value + (org-element--parse-objects + (match-end 0) + (progn (end-of-line) (skip-chars-backward " \t") (point)) + nil restrict))) (when dualp (setq value (and (or value dual-value) (cons value dual-value)))) (when (or (member kwd org-element-multiple-keywords) @@ -4037,7 +3981,7 @@ Optional argument GRANULARITY determines the depth of the recursion. It can be set to the following symbols: `headline' Only parse headlines. -`greater-element' Don't recurse into greater elements excepted +`greater-element' Don't recurse into greater elements except headlines and sections. Thus, elements parsed are the top-level ones. `element' Parse everything but objects and plain text. @@ -4046,7 +3990,7 @@ recursion. It can be set to the following symbols: When VISIBLE-ONLY is non-nil, don't parse contents of hidden elements. -An element or an objects is represented as a list with the +An element or object is represented as a list with the pattern (TYPE PROPERTIES CONTENTS), where : TYPE is a symbol describing the element or object. See @@ -4089,23 +4033,25 @@ looked after. Optional argument PARENT, when non-nil, is the element or object containing the secondary string. It is used to set correctly -`:parent' property within the string." - (let ((local-variables (buffer-local-variables))) - (with-temp-buffer - (dolist (v local-variables) - (ignore-errors - (if (symbolp v) (makunbound v) - (org-set-local (car v) (cdr v))))) - (insert string) - (restore-buffer-modified-p nil) - (let ((secondary (org-element--parse-objects - (point-min) (point-max) nil restriction))) - (when parent - (dolist (o secondary) (org-element-put-property o :parent parent))) - secondary)))) +`:parent' property within the string. + +If STRING is the empty string or nil, return nil." + (cond + ((not string) nil) + ((equal string "") nil) + (t (let ((local-variables (buffer-local-variables))) + (with-temp-buffer + (dolist (v local-variables) + (ignore-errors + (if (symbolp v) (makunbound v) + (set (make-local-variable (car v)) (cdr v))))) + (insert string) + (restore-buffer-modified-p nil) + (org-element--parse-objects + (point-min) (point-max) nil restriction parent)))))) (defun org-element-map - (data types fun &optional info first-match no-recursion with-affiliated) + (data types fun &optional info first-match no-recursion with-affiliated) "Map a function on selected elements or objects. DATA is a parse tree, an element, an object, a string, or a list @@ -4141,7 +4087,7 @@ Assuming TREE is a variable containing an Org buffer parse tree, the following example will return a flat list of all `src-block' and `example-block' elements in it: - (org-element-map tree \\='(example-block src-block) \\='identity) + (org-element-map tree \\='(example-block src-block) #\\='identity) The following snippet will find the first headline with a level of 1 and a \"phone\" tag, and will return its beginning position: @@ -4156,7 +4102,7 @@ of 1 and a \"phone\" tag, and will return its beginning position: The next example will return a flat list of all `plain-list' type elements in TREE that are not a sub-list themselves: - (org-element-map tree \\='plain-list \\='identity nil nil \\='plain-list) + (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list) Eventually, this example will return a flat list of all `bold' type objects containing a `latex-snippet' type object, even @@ -4164,116 +4110,101 @@ looking into captions: (org-element-map tree \\='bold (lambda (b) - (and (org-element-map b \\='latex-snippet \\='identity nil t) b)) + (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) nil nil nil t)" ;; Ensure TYPES and NO-RECURSION are a list, even of one element. - (unless (listp types) (setq types (list types))) - (unless (listp no-recursion) (setq no-recursion (list no-recursion))) - ;; Recursion depth is determined by --CATEGORY. - (let* ((--category - (catch 'found - (let ((category 'greater-elements)) - (mapc (lambda (type) - (cond ((or (memq type org-element-all-objects) - (eq type 'plain-text)) - ;; If one object is found, the function - ;; has to recurse into every object. - (throw 'found 'objects)) - ((not (memq type org-element-greater-elements)) - ;; If one regular element is found, the - ;; function has to recurse, at least, - ;; into every element it encounters. - (and (not (eq category 'elements)) - (setq category 'elements))))) - types) - category))) - ;; Compute properties for affiliated keywords if necessary. - (--affiliated-alist - (and with-affiliated - (mapcar (lambda (kwd) - (cons kwd (intern (concat ":" (downcase kwd))))) - org-element-affiliated-keywords))) - --acc - --walk-tree - (--walk-tree - (function - (lambda (--data) - ;; Recursively walk DATA. INFO, if non-nil, is a plist - ;; holding contextual information. - (let ((--type (org-element-type --data))) - (cond - ((not --data)) - ;; Ignored element in an export context. - ((and info (memq --data (plist-get info :ignore-list)))) - ;; List of elements or objects. - ((not --type) (mapc --walk-tree --data)) - ;; Unconditionally enter parse trees. - ((eq --type 'org-data) - (mapc --walk-tree (org-element-contents --data))) - (t - ;; Check if TYPE is matching among TYPES. If so, - ;; apply FUN to --DATA and accumulate return value - ;; into --ACC (or exit if FIRST-MATCH is non-nil). - (when (memq --type types) - (let ((result (funcall fun --data))) - (cond ((not result)) - (first-match (throw '--map-first-match result)) - (t (push result --acc))))) - ;; If --DATA has a secondary string that can contain - ;; objects with their type among TYPES, look into it. - (when (and (eq --category 'objects) (not (stringp --data))) - (let ((sec-prop - (assq --type org-element-secondary-value-alist))) - (when sec-prop - (funcall --walk-tree - (org-element-property (cdr sec-prop) --data))))) - ;; If --DATA has any affiliated keywords and - ;; WITH-AFFILIATED is non-nil, look for objects in - ;; them. - (when (and with-affiliated - (eq --category 'objects) - (memq --type org-element-all-elements)) - (mapc (lambda (kwd-pair) - (let ((kwd (car kwd-pair)) - (value (org-element-property - (cdr kwd-pair) --data))) - ;; Pay attention to the type of value. - ;; Preserve order for multiple keywords. - (cond - ((not value)) - ((and (member kwd org-element-multiple-keywords) - (member kwd org-element-dual-keywords)) - (mapc (lambda (line) - (funcall --walk-tree (cdr line)) - (funcall --walk-tree (car line))) - (reverse value))) - ((member kwd org-element-multiple-keywords) - (mapc (lambda (line) (funcall --walk-tree line)) - (reverse value))) - ((member kwd org-element-dual-keywords) - (funcall --walk-tree (cdr value)) - (funcall --walk-tree (car value))) - (t (funcall --walk-tree value))))) - --affiliated-alist)) - ;; Determine if a recursion into --DATA is possible. - (cond - ;; --TYPE is explicitly removed from recursion. - ((memq --type no-recursion)) - ;; --DATA has no contents. - ((not (org-element-contents --data))) - ;; Looking for greater elements but --DATA is simply - ;; an element or an object. - ((and (eq --category 'greater-elements) - (not (memq --type org-element-greater-elements)))) - ;; Looking for elements but --DATA is an object. - ((and (eq --category 'elements) - (memq --type org-element-all-objects))) - ;; In any other case, map contents. - (t (mapc --walk-tree (org-element-contents --data))))))))))) - (catch '--map-first-match - (funcall --walk-tree data) - ;; Return value in a proper order. - (nreverse --acc)))) + (let* ((types (if (listp types) types (list types))) + (no-recursion (if (listp no-recursion) no-recursion + (list no-recursion))) + ;; Recursion depth is determined by --CATEGORY. + (--category + (catch :--found + (let ((category 'greater-elements) + (all-objects (cons 'plain-text org-element-all-objects))) + (dolist (type types category) + (cond ((memq type all-objects) + ;; If one object is found, the function has + ;; to recurse into every object. + (throw :--found 'objects)) + ((not (memq type org-element-greater-elements)) + ;; If one regular element is found, the + ;; function has to recurse, at least, into + ;; every element it encounters. + (and (not (eq category 'elements)) + (setq category 'elements)))))))) + --acc) + (letrec ((--walk-tree + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; List of elements or objects. + ((not --type) (mapc --walk-tree --data)) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw :--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look inside. + (when (and (eq --category 'objects) (not (stringp --data))) + (dolist (p (cdr (assq --type + org-element-secondary-value-alist))) + (funcall --walk-tree (org-element-property p --data)))) + ;; If --DATA has any parsed affiliated keywords and + ;; WITH-AFFILIATED is non-nil, look for objects in + ;; them. + (when (and with-affiliated + (eq --category 'objects) + (eq (org-element-class --data) 'element)) + (dolist (kwd-pair org-element--parsed-properties-alist) + (let ((kwd (car kwd-pair)) + (value (org-element-property (cdr kwd-pair) --data))) + ;; Pay attention to the type of parsed + ;; keyword. In particular, preserve order for + ;; multiple keywords. + (cond + ((not value)) + ((member kwd org-element-dual-keywords) + (if (member kwd org-element-multiple-keywords) + (dolist (line (reverse value)) + (funcall --walk-tree (cdr line)) + (funcall --walk-tree (car line))) + (funcall --walk-tree (cdr value)) + (funcall --walk-tree (car value)))) + ((member kwd org-element-multiple-keywords) + (mapc --walk-tree (reverse value))) + (t (funcall --walk-tree value)))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is + ;; simply an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (eq (org-element-class --data) 'object))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data)))))))))) + (catch :--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc))))) (put 'org-element-map 'lisp-indent-function 2) ;; The following functions are internal parts of the parser. @@ -4282,24 +4213,38 @@ looking into captions: ;; level. ;; ;; The second one, `org-element--parse-objects' applies on all objects -;; of a paragraph or a secondary string. It uses -;; `org-element--get-next-object-candidates' to optimize the search of -;; the next object in the buffer. -;; -;; More precisely, that function looks for every allowed object type -;; first. Then, it discards failed searches, keeps further matches, -;; and searches again types matched behind point, for subsequent -;; calls. Thus, searching for a given type fails only once, and every -;; object is searched only once at top level (but sometimes more for -;; nested types). +;; of a paragraph or a secondary string. It calls +;; `org-element--object-lex' to find the next object in the current +;; container. + +(defsubst org-element--next-mode (type parentp) + "Return next special mode according to TYPE, or nil. +TYPE is a symbol representing the type of an element or object +containing next element if PARENTP is non-nil, or before it +otherwise. Modes can be either `first-section', `item', +`node-property', `planning', `property-drawer', `section', +`table-row' or nil." + (if parentp + (pcase type + (`headline 'section) + (`inlinetask 'planning) + (`plain-list 'item) + (`property-drawer 'node-property) + (`section 'planning) + (`table 'table-row)) + (pcase type + (`item 'item) + (`node-property 'node-property) + (`planning 'property-drawer) + (`table-row 'table-row)))) (defun org-element--parse-elements - (beg end special structure granularity visible-only acc) + (beg end mode structure granularity visible-only acc) "Parse elements between BEG and END positions. -SPECIAL prioritize some elements over the others. It can be set -to `first-section', `quote-section', `section' `item' or -`table-row'. +MODE prioritizes some elements over the others. It can be set to +`first-section', `section', `planning', `item', `node-property' +or `table-row'. When value is `item', STRUCTURE will be used as the current list structure. @@ -4320,140 +4265,205 @@ Elements are accumulated into ACC." ;; When parsing only headlines, skip any text before first one. (when (and (eq granularity 'headline) (not (org-at-heading-p))) (org-with-limited-levels (outline-next-heading))) - ;; Main loop start. - (while (< (point) end) - ;; Find current element's type and parse it accordingly to - ;; its category. - (let* ((element (org-element--current-element - end granularity special structure)) - (type (org-element-type element)) - (cbeg (org-element-property :contents-begin element))) - (goto-char (org-element-property :end element)) - ;; Visible only: skip invisible parts between siblings. - (when (and visible-only (org-invisible-p2)) - (goto-char (min (1+ (org-find-visible)) end))) - ;; Fill ELEMENT contents by side-effect. - (cond - ;; If element has no contents, don't modify it. - ((not cbeg)) - ;; Greater element: parse it between `contents-begin' and - ;; `contents-end'. Make sure GRANULARITY allows the - ;; recursion, or ELEMENT is a headline, in which case going - ;; inside is mandatory, in order to get sub-level headings. - ((and (memq type org-element-greater-elements) - (or (memq granularity '(element object nil)) - (and (eq granularity 'greater-element) - (eq type 'section)) - (eq type 'headline))) - (org-element--parse-elements - cbeg (org-element-property :contents-end element) - ;; Possibly switch to a special mode. - (case type - (headline - (if (org-element-property :quotedp element) 'quote-section - 'section)) - (plain-list 'item) - (property-drawer 'node-property) - (table 'table-row)) - (and (memq type '(item plain-list)) - (org-element-property :structure element)) - granularity visible-only element)) - ;; ELEMENT has contents. Parse objects inside, if - ;; GRANULARITY allows it. - ((memq granularity '(object nil)) - (org-element--parse-objects - cbeg (org-element-property :contents-end element) element - (org-element-restriction type)))) - (org-element-adopt-elements acc element))) - ;; Return result. - acc)) - -(defun org-element--parse-objects (beg end acc restriction) + (let (elements) + (while (< (point) end) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity mode structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Visible only: skip invisible parts between siblings. + (when (and visible-only (org-invisible-p2)) + (goto-char (min (1+ (org-find-visible)) end))) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If element has no contents, don't modify it. + ((not cbeg)) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is a headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (org-element--next-mode type t) + (and (memq type '(item plain-list)) + (org-element-property :structure element)) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (push (org-element-put-property element :parent acc) elements) + ;; Update mode. + (setq mode (org-element--next-mode type nil)))) + ;; Return result. + (apply #'org-element-set-contents acc (nreverse elements))))) + +(defun org-element--object-lex (restriction) + "Return next object in current buffer or nil. +RESTRICTION is a list of object types, as symbols, that should be +looked after. This function assumes that the buffer is narrowed +to an appropriate container (e.g., a paragraph)." + (if (memq 'table-cell restriction) (org-element-table-cell-parser) + (let* ((start (point)) + (limit + ;; Object regexp sometimes needs to have a peek at + ;; a character ahead. Therefore, when there is a hard + ;; limit, make it one more than the true beginning of the + ;; radio target. + (save-excursion + (cond ((not org-target-link-regexp) nil) + ((not (memq 'link restriction)) nil) + ((progn + (unless (bolp) (forward-char -1)) + (not (re-search-forward org-target-link-regexp nil t))) + nil) + ;; Since we moved backward, we do not want to + ;; match again an hypothetical 1-character long + ;; radio link before us. Realizing that this can + ;; only happen if such a radio link starts at + ;; beginning of line, we prevent this here. + ((and (= start (1+ (line-beginning-position))) + (= start (match-end 1))) + (and (re-search-forward org-target-link-regexp nil t) + (1+ (match-beginning 1)))) + (t (1+ (match-beginning 1)))))) + found) + (save-excursion + (while (and (not found) + (re-search-forward org-element--object-regexp limit 'move)) + (goto-char (match-beginning 0)) + (let ((result (match-string 0))) + (setq found + (cond + ((string-prefix-p "call_" result t) + (and (memq 'inline-babel-call restriction) + (org-element-inline-babel-call-parser))) + ((string-prefix-p "src_" result t) + (and (memq 'inline-src-block restriction) + (org-element-inline-src-block-parser))) + (t + (pcase (char-after) + (?^ (and (memq 'superscript restriction) + (org-element-superscript-parser))) + (?_ (or (and (memq 'subscript restriction) + (org-element-subscript-parser)) + (and (memq 'underline restriction) + (org-element-underline-parser)))) + (?* (and (memq 'bold restriction) + (org-element-bold-parser))) + (?/ (and (memq 'italic restriction) + (org-element-italic-parser))) + (?~ (and (memq 'code restriction) + (org-element-code-parser))) + (?= (and (memq 'verbatim restriction) + (org-element-verbatim-parser))) + (?+ (and (memq 'strike-through restriction) + (org-element-strike-through-parser))) + (?@ (and (memq 'export-snippet restriction) + (org-element-export-snippet-parser))) + (?{ (and (memq 'macro restriction) + (org-element-macro-parser))) + (?$ (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))) + (?< + (if (eq (aref result 1) ?<) + (or (and (memq 'radio-target restriction) + (org-element-radio-target-parser)) + (and (memq 'target restriction) + (org-element-target-parser))) + (or (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (or (memq 'link restriction) + (memq 'simple-link restriction)) + (org-element-link-parser))))) + (?\\ + (if (eq (aref result 1) ?\\) + (and (memq 'line-break restriction) + (org-element-line-break-parser)) + (or (and (memq 'entity restriction) + (org-element-entity-parser)) + (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))))) + (?\[ + (if (eq (aref result 1) ?\[) + (and (memq 'link restriction) + (org-element-link-parser)) + (or (and (memq 'footnote-reference restriction) + (org-element-footnote-reference-parser)) + (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (memq 'statistics-cookie restriction) + (org-element-statistics-cookie-parser))))) + ;; This is probably a plain link. + (_ (and (or (memq 'link restriction) + (memq 'simple-link restriction)) + (org-element-link-parser))))))) + (or (eobp) (forward-char)))) + (cond (found) + (limit (forward-char -1) + (org-element-link-parser)) ;radio link + (t nil)))))) + +(defun org-element--parse-objects (beg end acc restriction &optional parent) "Parse objects between BEG and END and return recursive structure. -Objects are accumulated in ACC. +Objects are accumulated in ACC. RESTRICTION is a list of object +successors which are allowed in the current object. -RESTRICTION is a list of object successors which are allowed in -the current object." - (let ((candidates 'initial)) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) +ACC becomes the parent for all parsed objects. However, if ACC +is nil (i.e., a secondary string is being parsed) and optional +argument PARENT is non-nil, use it as the parent for all objects. +Eventually, if both ACC and PARENT are nil, the common parent is +the list of objects itself." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (next-object contents) (while (and (not (eobp)) - (setq candidates - (org-element--get-next-object-candidates - restriction candidates))) - (let ((next-object - (let ((pos (apply 'min (mapcar 'cdr candidates)))) - (save-excursion - (goto-char pos) - (funcall (intern (format "org-element-%s-parser" - (car (rassq pos candidates))))))))) - ;; 1. Text before any object. Untabify it. - (let ((obj-beg (org-element-property :begin next-object))) - (unless (= (point) obj-beg) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) obj-beg)))))) - ;; 2. Object... - (let ((obj-end (org-element-property :end next-object)) - (cont-beg (org-element-property :contents-begin next-object))) - ;; Fill contents of NEXT-OBJECT by side-effect, if it has - ;; a recursive type. - (when (and cont-beg - (memq (car next-object) org-element-recursive-objects)) - (org-element--parse-objects - cont-beg (org-element-property :contents-end next-object) - next-object (org-element-restriction next-object))) - (setq acc (org-element-adopt-elements acc next-object)) - (goto-char obj-end)))) - ;; 3. Text after last object. Untabify it. + (setq next-object (org-element--object-lex restriction))) + ;; Text before any object. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (let ((text (buffer-substring-no-properties (point) obj-beg))) + (push (if acc (org-element-put-property text :parent acc) text) + contents)))) + ;; Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + (when acc (org-element-put-property next-object :parent acc)) + (push (if cont-beg + ;; Fill contents of NEXT-OBJECT if possible. + (org-element--parse-objects + cont-beg + (org-element-property :contents-end next-object) + next-object + (org-element-restriction next-object)) + next-object) + contents) + (goto-char obj-end))) + ;; Text after last object. (unless (eobp) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) end))))) - ;; Result. - acc)))) - -(defun org-element--get-next-object-candidates (restriction objects) - "Return an alist of candidates for the next object. - -RESTRICTION is a list of object types, as symbols. Only -candidates with such types are looked after. - -OBJECTS is the previous candidates alist. If it is set to -`initial', no search has been done before, and all symbols in -RESTRICTION should be looked after. - -Return value is an alist whose CAR is the object type and CDR its -beginning position." - (delq - nil - (if (eq objects 'initial) - ;; When searching for the first time, look for every successor - ;; allowed in RESTRICTION. - (mapcar - (lambda (res) - (funcall (intern (format "org-element-%s-successor" res)))) - restriction) - ;; Focus on objects returned during last search. Keep those - ;; still after point. Search again objects before it. - (mapcar - (lambda (obj) - (if (>= (cdr obj) (point)) obj - (let* ((type (car obj)) - (succ (or (cdr (assq type org-element-object-successor-alist)) - type))) - (and succ - (funcall (intern (format "org-element-%s-successor" succ))))))) - objects)))) + (let ((text (buffer-substring-no-properties (point) end))) + (push (if acc (org-element-put-property text :parent acc) text) + contents))) + ;; Result. Set appropriate parent. + (if acc (apply #'org-element-set-contents acc (nreverse contents)) + (let* ((contents (nreverse contents)) + (parent (or parent contents))) + (dolist (datum contents contents) + (org-element-put-property datum :parent parent)))))))) @@ -4468,71 +4478,74 @@ beginning position." ;; `org-element--interpret-affiliated-keywords'. ;;;###autoload -(defun org-element-interpret-data (data &optional parent) +(defun org-element-interpret-data (data) "Interpret DATA as Org syntax. - DATA is a parse tree, an element, an object or a secondary string -to interpret. - -Optional argument PARENT is used for recursive calls. It contains -the element or object containing data, or nil. - -Return Org syntax as a string." - (let* ((type (org-element-type data)) - (results - (cond - ;; Secondary string. - ((not type) - (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) - data "")) - ;; Full Org document. - ((eq type 'org-data) - (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) - (org-element-contents data) "")) - ;; Plain text: return it. - ((stringp data) data) - ;; Element/Object without contents. - ((not (org-element-contents data)) - (funcall (intern (format "org-element-%s-interpreter" type)) - data nil)) - ;; Element/Object with contents. - (t - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (obj) (org-element-interpret-data obj data)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing objects must - ;; have their indentation normalized first. - (org-element-normalize-contents +to interpret. Return Org syntax as a string." + (letrec ((fun + (lambda (data parent) + (let* ((type (org-element-type data)) + ;; Find interpreter for current object or + ;; element. If it doesn't exist (e.g. this is + ;; a pseudo object or element), return contents, + ;; if any. + (interpret + (let ((fun (intern + (format "org-element-%s-interpreter" type)))) + (if (fboundp fun) fun (lambda (_ contents) contents)))) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (funcall fun obj parent)) + data + "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat (lambda (obj) (funcall fun obj parent)) + (org-element-contents data) + "")) + ;; Plain text: return it. + ((stringp data) data) + ;; Element or object without contents. + ((not (org-element-contents data)) + (funcall interpret data nil)) + ;; Element or object with contents. + (t + (funcall + interpret data - ;; When normalizing first paragraph of an - ;; item or a footnote-definition, ignore - ;; first line's indentation. - (and (eq type 'paragraph) - (equal data (car (org-element-contents parent))) - (memq (org-element-type parent) - '(footnote-definition item)))))) - ""))) - (funcall (intern (format "org-element-%s-interpreter" type)) - data - (if greaterp (org-element-normalize-contents contents) - contents))))))) - (if (memq type '(org-data plain-text nil)) results - ;; Build white spaces. If no `:post-blank' property is - ;; specified, assume its value is 0. - (let ((post-blank (or (org-element-property :post-blank data) 0))) - (if (memq type org-element-all-objects) - (concat results (make-string post-blank 32)) - (concat - (org-element--interpret-affiliated-keywords data) - (org-element-normalize-string results) - (make-string post-blank 10))))))) + ;; Recursively interpret contents. + (mapconcat + (lambda (datum) (funcall fun datum data)) + (org-element-contents + (if (not (memq type '(paragraph verse-block))) + data + ;; Fix indentation of elements containing + ;; objects. We ignore `table-row' + ;; elements as they are one line long + ;; anyway. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of + ;; an item or a footnote-definition, + ;; ignore first line's indentation. + (and (eq type 'paragraph) + (memq (org-element-type parent) + '(footnote-definition item)) + (eq data + (car (org-element-contents parent))))))) + "")))))) + (if (memq type '(org-data plain-text nil)) results + ;; Build white spaces. If no `:post-blank' property + ;; is specified, assume its value is 0. + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string blank ?\n))))))))) + (funcall fun data nil))) (defun org-element--interpret-affiliated-keywords (element) "Return ELEMENT's affiliated keywords as Org syntax. @@ -4566,14 +4579,14 @@ If there is no affiliated keyword, return the empty string." ;; List all ELEMENT's properties matching an attribute line or an ;; affiliated keyword, but ignore translated keywords since they ;; cannot belong to the property list. - (loop for prop in (nth 1 element) by 'cddr - when (let ((keyword (upcase (substring (symbol-name prop) 1)))) - (or (string-match "^ATTR_" keyword) - (and - (member keyword org-element-affiliated-keywords) - (not (assoc keyword - org-element-keyword-translation-alist))))) - collect prop) + (cl-loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) ""))) ;; Because interpretation of the parse tree must return the same @@ -4609,67 +4622,1109 @@ If optional argument IGNORE-FIRST is non-nil, ignore first line's indentation to compute maximal common indentation. Return the normalized element that is element with global -indentation removed from its contents. The function assumes that -indentation is not done with TAB characters." - (let* ((min-ind most-positive-fixnum) - find-min-ind ; For byte-compiler. - (find-min-ind - ;; Return minimal common indentation within BLOB. This is - ;; done by walking recursively BLOB and updating MIN-IND - ;; along the way. FIRST-FLAG is non-nil when the first - ;; string hasn't been seen yet. It is required as this - ;; string is the only one whose indentation doesn't happen - ;; after a newline character. - (lambda (blob first-flag) - (dolist (object (org-element-contents blob)) - (when (and first-flag (stringp object)) - (setq first-flag nil) - (string-match "\\` *" object) - (let ((len (match-end 0))) - ;; An indentation of zero means no string will be - ;; modified. Quit the process. - (if (zerop len) (throw 'zero (setq min-ind 0)) - (setq min-ind (min len min-ind))))) - (cond - ((stringp object) - (dolist (line (cdr (org-split-string object " *\n"))) - (unless (string= line "") - (setq min-ind (min (org-get-indentation line) min-ind))))) - ((memq (org-element-type object) org-element-recursive-objects) - (funcall find-min-ind object first-flag))))))) - ;; Find minimal indentation in ELEMENT. - (catch 'zero (funcall find-min-ind element (not ignore-first))) +indentation removed from its contents." + (letrec ((find-min-ind + ;; Return minimal common indentation within BLOB. This is + ;; done by walking recursively BLOB and updating MIN-IND + ;; along the way. FIRST-FLAG is non-nil when the next + ;; object is expected to be a string that doesn't start + ;; with a newline character. It happens for strings at + ;; the beginnings of the contents or right after a line + ;; break. + (lambda (blob first-flag min-ind) + (dolist (datum (org-element-contents blob) min-ind) + (when first-flag + (setq first-flag nil) + (cond + ;; Objects cannot start with spaces: in this + ;; case, indentation is 0. + ((not (stringp datum)) (throw :zero 0)) + ((not (string-match + "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) + (throw :zero 0)) + ((equal (match-string 2 datum) "\n") + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind i datum) + (setq min-ind (min i min-ind)))))) + (cond + ((stringp datum) + (let ((s 0)) + (while (string-match + "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) + (setq s (match-end 1)) + (cond + ((equal (match-string 1 datum) "") + (unless (member (match-string 2 datum) '("" "\n")) + (throw :zero 0))) + ((equal (match-string 2 datum) "\n") + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind i datum) + (setq min-ind (min i min-ind)))))))) + ((eq (org-element-type datum) 'line-break) + (setq first-flag t)) + ((memq (org-element-type datum) org-element-recursive-objects) + (setq min-ind + (funcall find-min-ind datum first-flag min-ind))))))) + (min-ind + (catch :zero + (funcall find-min-ind + element (not ignore-first) most-positive-fixnum)))) (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element ;; Build ELEMENT back, replacing each string with the same ;; string minus common indentation. - (let* (build ; For byte compiler. - (build - (function - (lambda (blob first-flag) - ;; Return BLOB with all its strings indentation - ;; shortened from MIN-IND white spaces. FIRST-FLAG - ;; is non-nil when the first string hasn't been seen - ;; yet. - (setcdr (cdr blob) - (mapcar - #'(lambda (object) - (when (and first-flag (stringp object)) - (setq first-flag nil) - (setq object - (replace-regexp-in-string - (format "\\` \\{%d\\}" min-ind) - "" object))) - (cond - ((stringp object) - (replace-regexp-in-string - (format "\n \\{%d\\}" min-ind) "\n" object)) - ((memq (org-element-type object) - org-element-recursive-objects) - (funcall build object first-flag)) - (t object))) - (org-element-contents blob))) - blob)))) - (funcall build element (not ignore-first)))))) + (letrec ((build + (lambda (datum) + ;; Return DATUM with all its strings indentation + ;; shortened from MIN-IND white spaces. + (setcdr + (cdr datum) + (mapcar + (lambda (object) + (cond + ((stringp object) + (with-temp-buffer + (insert object) + (let ((s (point-min))) + (while (setq s (text-property-not-all + s (point-max) 'org-ind nil)) + (goto-char s) + (let ((i (get-text-property s 'org-ind))) + (delete-region s (progn + (skip-chars-forward " \t") + (point))) + (when (integerp i) (indent-to (- i min-ind)))))) + (buffer-string))) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object)) + (t object))) + (org-element-contents datum))) + datum))) + (funcall build element))))) + + + +;;; Cache +;; +;; Implement a caching mechanism for `org-element-at-point' and +;; `org-element-context', which see. +;; +;; A single public function is provided: `org-element-cache-reset'. +;; +;; Cache is enabled by default, but can be disabled globally with +;; `org-element-use-cache'. `org-element-cache-sync-idle-time', +;; org-element-cache-sync-duration' and `org-element-cache-sync-break' +;; can be tweaked to control caching behaviour. +;; +;; Internally, parsed elements are stored in an AVL tree, +;; `org-element--cache'. This tree is updated lazily: whenever +;; a change happens to the buffer, a synchronization request is +;; registered in `org-element--cache-sync-requests' (see +;; `org-element--cache-submit-request'). During idle time, requests +;; are processed by `org-element--cache-sync'. Synchronization also +;; happens when an element is required from the cache. In this case, +;; the process stops as soon as the needed element is up-to-date. +;; +;; A synchronization request can only apply on a synchronized part of +;; the cache. Therefore, the cache is updated at least to the +;; location where the new request applies. Thus, requests are ordered +;; from left to right and all elements starting before the first +;; request are correct. This property is used by functions like +;; `org-element--cache-find' to retrieve elements in the part of the +;; cache that can be trusted. +;; +;; A request applies to every element, starting from its original +;; location (or key, see below). When a request is processed, it +;; moves forward and may collide the next one. In this case, both +;; requests are merged into a new one that starts from that element. +;; As a consequence, the whole synchronization complexity does not +;; depend on the number of pending requests, but on the number of +;; elements the very first request will be applied on. +;; +;; Elements cannot be accessed through their beginning position, which +;; may or may not be up-to-date. Instead, each element in the tree is +;; associated to a key, obtained with `org-element--cache-key'. This +;; mechanism is robust enough to preserve total order among elements +;; even when the tree is only partially synchronized. +;; +;; Objects contained in an element are stored in a hash table, +;; `org-element--cache-objects'. + + +(defvar org-element-use-cache nil + "Non-nil when Org parser should cache its results. + +WARNING: for the time being, using cache sometimes triggers +freezes. Therefore, it is disabled by default. Activate it if +you want to help debugging the issue.") + +(defvar org-element-cache-sync-idle-time 0.6 + "Length, in seconds, of idle time before syncing cache.") + +(defvar org-element-cache-sync-duration (seconds-to-time 0.04) + "Maximum duration, as a time value, for a cache synchronization. +If the synchronization is not over after this delay, the process +pauses and resumes after `org-element-cache-sync-break' +seconds.") + +(defvar org-element-cache-sync-break (seconds-to-time 0.3) + "Duration, as a time value, of the pause between synchronizations. +See `org-element-cache-sync-duration' for more information.") + + +;;;; Data Structure + +(defvar org-element--cache nil + "AVL tree used to cache elements. +Each node of the tree contains an element. Comparison is done +with `org-element--cache-compare'. This cache is used in +`org-element-at-point'.") + +(defvar org-element--cache-objects nil + "Hash table used as to cache objects. +Key is an element, as returned by `org-element-at-point', and +value is an alist where each association is: + + (PARENT COMPLETEP . OBJECTS) + +where PARENT is an element or object, COMPLETEP is a boolean, +non-nil when all direct children of parent are already cached and +OBJECTS is a list of such children, as objects, from farthest to +closest. + +In the following example, \\alpha, bold object and \\beta are +contained within a paragraph + + \\alpha *\\beta* + +If the paragraph is completely parsed, OBJECTS-DATA will be + + ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT) + (BOLD-OBJECT t ENTITY-OBJECT)) + +whereas in a partially parsed paragraph, it could be + + ((PARAGRAPH nil ENTITY-OBJECT)) + +This cache is used in `org-element-context'.") + +(defvar org-element--cache-sync-requests nil + "List of pending synchronization requests. + +A request is a vector with the following pattern: + + \[NEXT BEG END OFFSET PARENT PHASE] + +Processing a synchronization request consists of three phases: + + 0. Delete modified elements, + 1. Fill missing area in cache, + 2. Shift positions and re-parent elements after the changes. + +During phase 0, NEXT is the key of the first element to be +removed, BEG and END is buffer position delimiting the +modifications. Elements starting between them (inclusive) are +removed. So are elements whose parent is removed. PARENT, when +non-nil, is the parent of the first element to be removed. + +During phase 1, NEXT is the key of the next known element in +cache and BEG its beginning position. Parse buffer between that +element and the one before it in order to determine the parent of +the next element. Set PARENT to the element containing NEXT. + +During phase 2, NEXT is the key of the next element to shift in +the parse tree. All elements starting from this one have their +properties relatives to buffer positions shifted by integer +OFFSET and, if they belong to element PARENT, are adopted by it. + +PHASE specifies the phase number, as an integer.") + +(defvar org-element--cache-sync-timer nil + "Timer used for cache synchronization.") + +(defvar org-element--cache-sync-keys nil + "Hash table used to store keys during synchronization. +See `org-element--cache-key' for more information.") + +(defsubst org-element--cache-key (element) + "Return a unique key for ELEMENT in cache tree. + +Keys are used to keep a total order among elements in the cache. +Comparison is done with `org-element--cache-key-less-p'. + +When no synchronization is taking place, a key is simply the +beginning position of the element, or that position plus one in +the case of an first item (respectively row) in +a list (respectively a table). + +During a synchronization, the key is the one the element had when +the cache was synchronized for the last time. Elements added to +cache during the synchronization get a new key generated with +`org-element--cache-generate-key'. + +Such keys are stored in `org-element--cache-sync-keys'. The hash +table is cleared once the synchronization is complete." + (or (gethash element org-element--cache-sync-keys) + (let* ((begin (org-element-property :begin element)) + ;; Increase beginning position of items (respectively + ;; table rows) by one, so the first item can get + ;; a different key from its parent list (respectively + ;; table). + (key (if (memq (org-element-type element) '(item table-row)) + (1+ begin) + begin))) + (if org-element--cache-sync-requests + (puthash element key org-element--cache-sync-keys) + key)))) + +(defun org-element--cache-generate-key (lower upper) + "Generate a key between LOWER and UPPER. + +LOWER and UPPER are integers or lists, possibly empty. + +If LOWER and UPPER are equals, return LOWER. Otherwise, return +a unique key, as an integer or a list of integers, according to +the following rules: + + - LOWER and UPPER are compared level-wise until values differ. + + - If, at a given level, LOWER and UPPER differ from more than + 2, the new key shares all the levels above with LOWER and + gets a new level. Its value is the mean between LOWER and + UPPER: + + (1 2) + (1 4) --> (1 3) + + - If LOWER has no value to compare with, it is assumed that its + value is `most-negative-fixnum'. E.g., + + (1 1) + (1 1 2) + + is equivalent to + + (1 1 m) + (1 1 2) + + where m is `most-negative-fixnum'. Likewise, if UPPER is + short of levels, the current value is `most-positive-fixnum'. + + - If they differ from only one, the new key inherits from + current LOWER level and fork it at the next level. E.g., + + (2 1) + (3 3) + + is equivalent to + + (2 1) + (2 M) + + where M is `most-positive-fixnum'. + + - If the key is only one level long, it is returned as an + integer: + + (1 2) + (3 2) --> 2 + +When they are not equals, the function assumes that LOWER is +lesser than UPPER, per `org-element--cache-key-less-p'." + (if (equal lower upper) lower + (let ((lower (if (integerp lower) (list lower) lower)) + (upper (if (integerp upper) (list upper) upper)) + skip-upper key) + (catch 'exit + (while t + (let ((min (or (car lower) most-negative-fixnum)) + (max (cond (skip-upper most-positive-fixnum) + ((car upper)) + (t most-positive-fixnum)))) + (if (< (1+ min) max) + (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) + (throw 'exit (if key (nreverse (cons mean key)) mean))) + (when (and (< min max) (not skip-upper)) + ;; When at a given level, LOWER and UPPER differ from + ;; 1, ignore UPPER altogether. Instead create a key + ;; between LOWER and the greatest key with the same + ;; prefix as LOWER so far. + (setq skip-upper t)) + (push min key) + (setq lower (cdr lower) upper (cdr upper))))))))) + +(defsubst org-element--cache-key-less-p (a b) + "Non-nil if key A is less than key B. +A and B are either integers or lists of integers, as returned by +`org-element--cache-key'." + (if (integerp a) (if (integerp b) (< a b) (<= a (car b))) + (if (integerp b) (< (car a) b) + (catch 'exit + (while (and a b) + (cond ((car-less-than-car a b) (throw 'exit t)) + ((car-less-than-car b a) (throw 'exit nil)) + (t (setq a (cdr a) b (cdr b))))) + ;; If A is empty, either keys are equal (B is also empty) and + ;; we return nil, or A is lesser than B (B is longer) and we + ;; return a non-nil value. + ;; + ;; If A is not empty, B is necessarily empty and A is greater + ;; than B (A is longer). Therefore, return nil. + (and (null a) b))))) + +(defun org-element--cache-compare (a b) + "Non-nil when element A is located before element B." + (org-element--cache-key-less-p (org-element--cache-key a) + (org-element--cache-key b))) + +(defsubst org-element--cache-root () + "Return root value in cache. +This function assumes `org-element--cache' is a valid AVL tree." + (avl-tree--node-left (avl-tree--dummyroot org-element--cache))) + + +;;;; Tools + +(defsubst org-element--cache-active-p () + "Non-nil when cache is active in current buffer." + (and org-element-use-cache + org-element--cache + (derived-mode-p 'org-mode))) + +(defun org-element--cache-find (pos &optional side) + "Find element in cache starting at POS or before. + +POS refers to a buffer position. + +When optional argument SIDE is non-nil, the function checks for +elements starting at or past POS instead. If SIDE is `both', the +function returns a cons cell where car is the first element +starting at or before POS and cdr the first element starting +after POS. + +The function can only find elements in the synchronized part of +the cache." + (let ((limit (and org-element--cache-sync-requests + (aref (car org-element--cache-sync-requests) 0))) + (node (org-element--cache-root)) + lower upper) + (while node + (let* ((element (avl-tree--node-data node)) + (begin (org-element-property :begin element))) + (cond + ((and limit + (not (org-element--cache-key-less-p + (org-element--cache-key element) limit))) + (setq node (avl-tree--node-left node))) + ((> begin pos) + (setq upper element + node (avl-tree--node-left node))) + ((< begin pos) + (setq lower element + node (avl-tree--node-right node))) + ;; We found an element in cache starting at POS. If `side' + ;; is `both' we also want the next one in order to generate + ;; a key in-between. + ;; + ;; If the element is the first row or item in a table or + ;; a plain list, we always return the table or the plain + ;; list. + ;; + ;; In any other case, we return the element found. + ((eq side 'both) + (setq lower element) + (setq node (avl-tree--node-right node))) + ((and (memq (org-element-type element) '(item table-row)) + (let ((parent (org-element-property :parent element))) + (and (= (org-element-property :begin element) + (org-element-property :contents-begin parent)) + (setq node nil + lower parent + upper parent))))) + (t + (setq node nil + lower element + upper element))))) + (pcase side + (`both (cons lower upper)) + (`nil lower) + (_ upper)))) + +(defun org-element--cache-put (element &optional data) + "Store ELEMENT in current buffer's cache, if allowed. +When optional argument DATA is non-nil, assume is it object data +relative to ELEMENT and store it in the objects cache." + (cond ((not (org-element--cache-active-p)) nil) + ((not data) + (when org-element--cache-sync-requests + ;; During synchronization, first build an appropriate key + ;; for the new element so `avl-tree-enter' can insert it at + ;; the right spot in the cache. + (let ((keys (org-element--cache-find + (org-element-property :begin element) 'both))) + (puthash element + (org-element--cache-generate-key + (and (car keys) (org-element--cache-key (car keys))) + (cond ((cdr keys) (org-element--cache-key (cdr keys))) + (org-element--cache-sync-requests + (aref (car org-element--cache-sync-requests) 0)))) + org-element--cache-sync-keys))) + (avl-tree-enter org-element--cache element)) + ;; Headlines are not stored in cache, so objects in titles are + ;; not stored either. + ((eq (org-element-type element) 'headline) nil) + (t (puthash element data org-element--cache-objects)))) + +(defsubst org-element--cache-remove (element) + "Remove ELEMENT from cache. +Assume ELEMENT belongs to cache and that a cache is active." + (avl-tree-delete org-element--cache element) + (remhash element org-element--cache-objects)) + + +;;;; Synchronization + +(defsubst org-element--cache-set-timer (buffer) + "Set idle timer for cache synchronization in BUFFER." + (when org-element--cache-sync-timer + (cancel-timer org-element--cache-sync-timer)) + (setq org-element--cache-sync-timer + (run-with-idle-timer + (let ((idle (current-idle-time))) + (if idle (time-add idle org-element-cache-sync-break) + org-element-cache-sync-idle-time)) + nil + #'org-element--cache-sync + buffer))) + +(defsubst org-element--cache-interrupt-p (time-limit) + "Non-nil when synchronization process should be interrupted. +TIME-LIMIT is a time value or nil." + (and time-limit + (or (input-pending-p) + (time-less-p time-limit (current-time))))) + +(defsubst org-element--cache-shift-positions (element offset &optional props) + "Shift ELEMENT properties relative to buffer positions by OFFSET. + +Properties containing buffer positions are `:begin', `:end', +`:contents-begin', `:contents-end' and `:structure'. When +optional argument PROPS is a list of keywords, only shift +properties provided in that list. + +Properties are modified by side-effect." + (let ((properties (nth 1 element))) + ;; Shift `:structure' property for the first plain list only: it + ;; is the only one that really matters and it prevents from + ;; shifting it more than once. + (when (and (or (not props) (memq :structure props)) + (eq (org-element-type element) 'plain-list) + (not (eq (org-element-type (plist-get properties :parent)) + 'item))) + (dolist (item (plist-get properties :structure)) + (cl-incf (car item) offset) + (cl-incf (nth 6 item) offset))) + (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated)) + (let ((value (and (or (not props) (memq key props)) + (plist-get properties key)))) + (and value (plist-put properties key (+ offset value))))))) + +(defun org-element--cache-sync (buffer &optional threshold future-change) + "Synchronize cache with recent modification in BUFFER. + +When optional argument THRESHOLD is non-nil, do the +synchronization for all elements starting before or at threshold, +then exit. Otherwise, synchronize cache for as long as +`org-element-cache-sync-duration' or until Emacs leaves idle +state. + +FUTURE-CHANGE, when non-nil, is a buffer position where changes +not registered yet in the cache are going to happen. It is used +in `org-element--cache-submit-request', where cache is partially +updated before current modification are actually submitted." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((inhibit-quit t) request next) + (when org-element--cache-sync-timer + (cancel-timer org-element--cache-sync-timer)) + (catch 'interrupt + (while org-element--cache-sync-requests + (setq request (car org-element--cache-sync-requests) + next (nth 1 org-element--cache-sync-requests)) + (org-element--cache-process-request + request + (and next (aref next 0)) + threshold + (and (not threshold) + (time-add (current-time) + org-element-cache-sync-duration)) + future-change) + ;; Request processed. Merge current and next offsets and + ;; transfer ending position. + (when next + (cl-incf (aref next 3) (aref request 3)) + (aset next 2 (aref request 2))) + (setq org-element--cache-sync-requests + (cdr org-element--cache-sync-requests)))) + ;; If more requests are awaiting, set idle timer accordingly. + ;; Otherwise, reset keys. + (if org-element--cache-sync-requests + (org-element--cache-set-timer buffer) + (clrhash org-element--cache-sync-keys)))))) + +(defun org-element--cache-process-request + (request next threshold time-limit future-change) + "Process synchronization REQUEST for all entries before NEXT. + +REQUEST is a vector, built by `org-element--cache-submit-request'. + +NEXT is a cache key, as returned by `org-element--cache-key'. + +When non-nil, THRESHOLD is a buffer position. Synchronization +stops as soon as a shifted element begins after it. + +When non-nil, TIME-LIMIT is a time value. Synchronization stops +after this time or when Emacs exits idle state. + +When non-nil, FUTURE-CHANGE is a buffer position where changes +not registered yet in the cache are going to happen. See +`org-element--cache-submit-request' for more information. + +Throw `interrupt' if the process stops before completing the +request." + (catch 'quit + (when (= (aref request 5) 0) + ;; Phase 0. + ;; + ;; Delete all elements starting after BEG, but not after buffer + ;; position END or past element with key NEXT. Also delete + ;; elements contained within a previously removed element + ;; (stored in `last-container'). + ;; + ;; At each iteration, we start again at tree root since + ;; a deletion modifies structure of the balanced tree. + (catch 'end-phase + (while t + (when (org-element--cache-interrupt-p time-limit) + (throw 'interrupt nil)) + ;; Find first element in cache with key BEG or after it. + (let ((beg (aref request 0)) + (end (aref request 2)) + (node (org-element--cache-root)) + data data-key last-container) + (while node + (let* ((element (avl-tree--node-data node)) + (key (org-element--cache-key element))) + (cond + ((org-element--cache-key-less-p key beg) + (setq node (avl-tree--node-right node))) + ((org-element--cache-key-less-p beg key) + (setq data element + data-key key + node (avl-tree--node-left node))) + (t (setq data element + data-key key + node nil))))) + (if data + (let ((pos (org-element-property :begin data))) + (if (if (or (not next) + (org-element--cache-key-less-p data-key next)) + (<= pos end) + (and last-container + (let ((up data)) + (while (and up (not (eq up last-container))) + (setq up (org-element-property :parent up))) + up))) + (progn (when (and (not last-container) + (> (org-element-property :end data) + end)) + (setq last-container data)) + (org-element--cache-remove data)) + (aset request 0 data-key) + (aset request 1 pos) + (aset request 5 1) + (throw 'end-phase nil))) + ;; No element starting after modifications left in + ;; cache: further processing is futile. + (throw 'quit t)))))) + (when (= (aref request 5) 1) + ;; Phase 1. + ;; + ;; Phase 0 left a hole in the cache. Some elements after it + ;; could have parents within. For example, in the following + ;; buffer: + ;; + ;; - item + ;; + ;; + ;; Paragraph1 + ;; + ;; Paragraph2 + ;; + ;; if we remove a blank line between "item" and "Paragraph1", + ;; everything down to "Paragraph2" is removed from cache. But + ;; the paragraph now belongs to the list, and its `:parent' + ;; property no longer is accurate. + ;; + ;; Therefore we need to parse again elements in the hole, or at + ;; least in its last section, so that we can re-parent + ;; subsequent elements, during phase 2. + ;; + ;; Note that we only need to get the parent from the first + ;; element in cache after the hole. + ;; + ;; When next key is lesser or equal to the current one, delegate + ;; phase 1 processing to next request in order to preserve key + ;; order among requests. + (let ((key (aref request 0))) + (when (and next (not (org-element--cache-key-less-p key next))) + (let ((next-request (nth 1 org-element--cache-sync-requests))) + (aset next-request 0 key) + (aset next-request 1 (aref request 1)) + (aset next-request 5 1)) + (throw 'quit t))) + ;; Next element will start at its beginning position plus + ;; offset, since it hasn't been shifted yet. Therefore, LIMIT + ;; contains the real beginning position of the first element to + ;; shift and re-parent. + (let ((limit (+ (aref request 1) (aref request 3)))) + (cond ((and threshold (> limit threshold)) (throw 'interrupt nil)) + ((and future-change (>= limit future-change)) + ;; Changes are going to happen around this element and + ;; they will trigger another phase 1 request. Skip the + ;; current one. + (aset request 5 2)) + (t + (let ((parent (org-element--parse-to limit t time-limit))) + (aset request 4 parent) + (aset request 5 2)))))) + ;; Phase 2. + ;; + ;; Shift all elements starting from key START, but before NEXT, by + ;; OFFSET, and re-parent them when appropriate. + ;; + ;; Elements are modified by side-effect so the tree structure + ;; remains intact. + ;; + ;; Once THRESHOLD, if any, is reached, or once there is an input + ;; pending, exit. Before leaving, the current synchronization + ;; request is updated. + (let ((start (aref request 0)) + (offset (aref request 3)) + (parent (aref request 4)) + (node (org-element--cache-root)) + (stack (list nil)) + (leftp t) + exit-flag) + ;; No re-parenting nor shifting planned: request is over. + (when (and (not parent) (zerop offset)) (throw 'quit t)) + (while node + (let* ((data (avl-tree--node-data node)) + (key (org-element--cache-key data))) + (if (and leftp (avl-tree--node-left node) + (not (org-element--cache-key-less-p key start))) + (progn (push node stack) + (setq node (avl-tree--node-left node))) + (unless (org-element--cache-key-less-p key start) + ;; We reached NEXT. Request is complete. + (when (equal key next) (throw 'quit t)) + ;; Handle interruption request. Update current request. + (when (or exit-flag (org-element--cache-interrupt-p time-limit)) + (aset request 0 key) + (aset request 4 parent) + (throw 'interrupt nil)) + ;; Shift element. + (unless (zerop offset) + (org-element--cache-shift-positions data offset) + ;; Shift associated objects data, if any. + (dolist (object-data (gethash data org-element--cache-objects)) + (dolist (object (cddr object-data)) + (org-element--cache-shift-positions object offset)))) + (let ((begin (org-element-property :begin data))) + ;; Update PARENT and re-parent DATA, only when + ;; necessary. Propagate new structures for lists. + (while (and parent + (<= (org-element-property :end parent) begin)) + (setq parent (org-element-property :parent parent))) + (cond ((and (not parent) (zerop offset)) (throw 'quit nil)) + ((and parent + (let ((p (org-element-property :parent data))) + (or (not p) + (< (org-element-property :begin p) + (org-element-property :begin parent))))) + (org-element-put-property data :parent parent) + (let ((s (org-element-property :structure parent))) + (when (and s (org-element-property :structure data)) + (org-element-put-property data :structure s))))) + ;; Cache is up-to-date past THRESHOLD. Request + ;; interruption. + (when (and threshold (> begin threshold)) (setq exit-flag t)))) + (setq node (if (setq leftp (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack)))))) + ;; We reached end of tree: synchronization complete. + t))) + +(defun org-element--parse-to (pos &optional syncp time-limit) + "Parse elements in current section, down to POS. + +Start parsing from the closest between the last known element in +cache or headline above. Return the smallest element containing +POS. + +When optional argument SYNCP is non-nil, return the parent of the +element containing POS instead. In that case, it is also +possible to provide TIME-LIMIT, which is a time value specifying +when the parsing should stop. The function throws `interrupt' if +the process stopped before finding the expected result." + (catch 'exit + (org-with-wide-buffer + (goto-char pos) + (let* ((cached (and (org-element--cache-active-p) + (org-element--cache-find pos nil))) + (begin (org-element-property :begin cached)) + element next mode) + (cond + ;; Nothing in cache before point: start parsing from first + ;; element following headline above, or first element in + ;; buffer. + ((not cached) + (when (org-with-limited-levels (outline-previous-heading)) + (setq mode 'planning) + (forward-line)) + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ;; Cache returned exact match: return it. + ((= pos begin) + (throw 'exit (if syncp (org-element-property :parent cached) cached))) + ;; There's a headline between cached value and POS: cached + ;; value is invalid. Start parsing from first element + ;; following the headline. + ((re-search-backward + (org-with-limited-levels org-outline-regexp-bol) begin t) + (forward-line) + (skip-chars-forward " \r\t\n") + (beginning-of-line) + (setq mode 'planning)) + ;; Check if CACHED or any of its ancestors contain point. + ;; + ;; If there is such an element, we inspect it in order to know + ;; if we return it or if we need to parse its contents. + ;; Otherwise, we just start parsing from current location, + ;; which is right after the top-most element containing + ;; CACHED. + ;; + ;; As a special case, if POS is at the end of the buffer, we + ;; want to return the innermost element ending there. + ;; + ;; Also, if we find an ancestor and discover that we need to + ;; parse its contents, make sure we don't start from + ;; `:contents-begin', as we would otherwise go past CACHED + ;; again. Instead, in that situation, we will resume parsing + ;; from NEXT, which is located after CACHED or its higher + ;; ancestor not containing point. + (t + (let ((up cached) + (pos (if (= (point-max) pos) (1- pos) pos))) + (goto-char (or (org-element-property :contents-begin cached) begin)) + (while (let ((end (org-element-property :end up))) + (and (<= end pos) + (goto-char end) + (setq up (org-element-property :parent up))))) + (cond ((not up)) + ((eobp) (setq element up)) + (t (setq element up next (point))))))) + ;; Parse successively each element until we reach POS. + (let ((end (or (org-element-property :end element) + (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point)))) + (parent element)) + (while t + (when syncp + (cond ((= (point) pos) (throw 'exit parent)) + ((org-element--cache-interrupt-p time-limit) + (throw 'interrupt nil)))) + (unless element + (setq element (org-element--current-element + end 'element mode + (org-element-property :structure parent))) + (org-element-put-property element :parent parent) + (org-element--cache-put element)) + (let ((elem-end (org-element-property :end element)) + (type (org-element-type element))) + (cond + ;; Skip any element ending before point. Also skip + ;; element ending at point (unless it is also the end of + ;; buffer) since we're sure that another element begins + ;; after it. + ((and (<= elem-end pos) (/= (point-max) elem-end)) + (goto-char elem-end) + (setq mode (org-element--next-mode type nil))) + ;; A non-greater element contains point: return it. + ((not (memq type org-element-greater-elements)) + (throw 'exit element)) + ;; Otherwise, we have to decide if ELEMENT really + ;; contains POS. In that case we start parsing from + ;; contents' beginning. + ;; + ;; If POS is at contents' beginning but it is also at + ;; the beginning of the first item in a list or a table. + ;; In that case, we need to create an anchor for that + ;; list or table, so return it. + ;; + ;; Also, if POS is at the end of the buffer, no element + ;; can start after it, but more than one may end there. + ;; Arbitrarily, we choose to return the innermost of + ;; such elements. + ((let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (when (or syncp + (and cbeg cend + (or (< cbeg pos) + (and (= cbeg pos) + (not (memq type '(plain-list table))))) + (or (> cend pos) + (and (= cend pos) (= (point-max) pos))))) + (goto-char (or next cbeg)) + (setq next nil + mode (org-element--next-mode type t) + parent element + end cend)))) + ;; Otherwise, return ELEMENT as it is the smallest + ;; element containing POS. + (t (throw 'exit element)))) + (setq element nil))))))) + + +;;;; Staging Buffer Changes + +(defconst org-element--cache-sensitive-re + (concat + org-outline-regexp-bol "\\|" + "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" + "^[ \t]*\\(?:" + "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|" + "\\\\begin{[A-Za-z0-9*]+}" "\\|" + ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" + "\\)") + "Regexp matching a sensitive line, structure wise. +A sensitive line is a headline, inlinetask, block, drawer, or +latex-environment boundary. When such a line is modified, +structure changes in the document may propagate in the whole +section, possibly making cache invalid.") + +(defvar org-element--cache-change-warning nil + "Non-nil when a sensitive line is about to be changed. +It is a symbol among nil, t and `headline'.") + +(defun org-element--cache-before-change (beg end) + "Request extension of area going to be modified if needed. +BEG and END are the beginning and end of the range of changed +text. See `before-change-functions' for more information." + (when (org-element--cache-active-p) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (let ((bottom (save-excursion (goto-char end) (line-end-position)))) + (setq org-element--cache-change-warning + (save-match-data + (if (and (org-with-limited-levels (org-at-heading-p)) + (= (line-end-position) bottom)) + 'headline + (let ((case-fold-search t)) + (re-search-forward + org-element--cache-sensitive-re bottom t))))))))) + +(defun org-element--cache-after-change (beg end pre) + "Update buffer modifications for current buffer. +BEG and END are the beginning and end of the range of changed +text, and the length in bytes of the pre-change text replaced by +that range. See `after-change-functions' for more information." + (when (org-element--cache-active-p) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (save-match-data + (let ((top (point)) + (bottom (save-excursion (goto-char end) (line-end-position)))) + ;; Determine if modified area needs to be extended, according + ;; to both previous and current state. We make a special + ;; case for headline editing: if a headline is modified but + ;; not removed, do not extend. + (when (pcase org-element--cache-change-warning + (`t t) + (`headline + (not (and (org-with-limited-levels (org-at-heading-p)) + (= (line-end-position) bottom)))) + (_ + (let ((case-fold-search t)) + (re-search-forward + org-element--cache-sensitive-re bottom t)))) + ;; Effectively extend modified area. + (org-with-limited-levels + (setq top (progn (goto-char top) + (when (outline-previous-heading) (forward-line)) + (point))) + (setq bottom (progn (goto-char bottom) + (if (outline-next-heading) (1- (point)) + (point)))))) + ;; Store synchronization request. + (let ((offset (- end beg pre))) + (org-element--cache-submit-request top (- bottom offset) offset))))) + ;; Activate a timer to process the request during idle time. + (org-element--cache-set-timer (current-buffer)))) + +(defun org-element--cache-for-removal (beg end offset) + "Return first element to remove from cache. + +BEG and END are buffer positions delimiting buffer modifications. +OFFSET is the size of the changes. + +Returned element is usually the first element in cache containing +any position between BEG and END. As an exception, greater +elements around the changes that are robust to contents +modifications are preserved and updated according to the +changes." + (let* ((elements (org-element--cache-find (1- beg) 'both)) + (before (car elements)) + (after (cdr elements))) + (if (not before) after + (let ((up before) + (robust-flag t)) + (while up + (if (let ((type (org-element-type up))) + (and (or (memq type '(center-block dynamic-block quote-block + special-block)) + ;; Drawers named "PROPERTIES" are probably + ;; a properties drawer being edited. Force + ;; parsing to check if editing is over. + (and (eq type 'drawer) + (not (string= + (org-element-property :drawer-name up) + "PROPERTIES")))) + (let ((cbeg (org-element-property :contents-begin up))) + (and cbeg + (<= cbeg beg) + (> (org-element-property :contents-end up) end))))) + ;; UP is a robust greater element containing changes. + ;; We only need to extend its ending boundaries. + (org-element--cache-shift-positions + up offset '(:contents-end :end)) + (setq before up) + (when robust-flag (setq robust-flag nil))) + (setq up (org-element-property :parent up))) + ;; We're at top level element containing ELEMENT: if it's + ;; altered by buffer modifications, it is first element in + ;; cache to be removed. Otherwise, that first element is the + ;; following one. + ;; + ;; As a special case, do not remove BEFORE if it is a robust + ;; container for current changes. + (if (or (< (org-element-property :end before) beg) robust-flag) after + before))))) + +(defun org-element--cache-submit-request (beg end offset) + "Submit a new cache synchronization request for current buffer. +BEG and END are buffer positions delimiting the minimal area +where cache data should be removed. OFFSET is the size of the +change, as an integer." + (let ((next (car org-element--cache-sync-requests)) + delete-to delete-from) + (if (and next + (zerop (aref next 5)) + (> (setq delete-to (+ (aref next 2) (aref next 3))) end) + (<= (setq delete-from (aref next 1)) end)) + ;; Current changes can be merged with first sync request: we + ;; can save a partial cache synchronization. + (progn + (cl-incf (aref next 3) offset) + ;; If last change happened within area to be removed, extend + ;; boundaries of robust parents, if any. Otherwise, find + ;; first element to remove and update request accordingly. + (if (> beg delete-from) + (let ((up (aref next 4))) + (while up + (org-element--cache-shift-positions + up offset '(:contents-end :end)) + (setq up (org-element-property :parent up)))) + (let ((first (org-element--cache-for-removal beg delete-to offset))) + (when first + (aset next 0 (org-element--cache-key first)) + (aset next 1 (org-element-property :begin first)) + (aset next 4 (org-element-property :parent first)))))) + ;; Ensure cache is correct up to END. Also make sure that NEXT, + ;; if any, is no longer a 0-phase request, thus ensuring that + ;; phases are properly ordered. We need to provide OFFSET as + ;; optional parameter since current modifications are not known + ;; yet to the otherwise correct part of the cache (i.e, before + ;; the first request). + (when next (org-element--cache-sync (current-buffer) end beg)) + (let ((first (org-element--cache-for-removal beg end offset))) + (if first + (push (let ((beg (org-element-property :begin first)) + (key (org-element--cache-key first))) + (cond + ;; When changes happen before the first known + ;; element, re-parent and shift the rest of the + ;; cache. + ((> beg end) (vector key beg nil offset nil 1)) + ;; Otherwise, we find the first non robust + ;; element containing END. All elements between + ;; FIRST and this one are to be removed. + ((let ((first-end (org-element-property :end first))) + (and (> first-end end) + (vector key beg first-end offset first 0)))) + (t + (let* ((element (org-element--cache-find end)) + (end (org-element-property :end element)) + (up element)) + (while (and (setq up (org-element-property :parent up)) + (>= (org-element-property :begin up) beg)) + (setq end (org-element-property :end up) + element up)) + (vector key beg end offset element 0))))) + org-element--cache-sync-requests) + ;; No element to remove. No need to re-parent either. + ;; Simply shift additional elements, if any, by OFFSET. + (when org-element--cache-sync-requests + (cl-incf (aref (car org-element--cache-sync-requests) 3) + offset))))))) + + +;;;; Public Functions + +;;;###autoload +(defun org-element-cache-reset (&optional all) + "Reset cache in current buffer. +When optional argument ALL is non-nil, reset cache in all Org +buffers." + (interactive "P") + (dolist (buffer (if all (buffer-list) (list (current-buffer)))) + (with-current-buffer buffer + (when (and org-element-use-cache (derived-mode-p 'org-mode)) + (setq-local org-element--cache + (avl-tree-create #'org-element--cache-compare)) + (setq-local org-element--cache-objects (make-hash-table :test #'eq)) + (setq-local org-element--cache-sync-keys + (make-hash-table :weakness 'key :test #'eq)) + (setq-local org-element--cache-change-warning nil) + (setq-local org-element--cache-sync-requests nil) + (setq-local org-element--cache-sync-timer nil) + (add-hook 'before-change-functions + #'org-element--cache-before-change nil t) + (add-hook 'after-change-functions + #'org-element--cache-after-change nil t))))) + +;;;###autoload +(defun org-element-cache-refresh (pos) + "Refresh cache at position POS." + (when (org-element--cache-active-p) + (org-element--cache-sync (current-buffer) pos) + (org-element--cache-submit-request pos pos 0) + (org-element--cache-set-timer (current-buffer)))) @@ -4678,7 +5733,7 @@ indentation is not done with TAB characters." ;; The first move is to implement a way to obtain the smallest element ;; containing point. This is the job of `org-element-at-point'. It ;; basically jumps back to the beginning of section containing point -;; and moves, element after element, with +;; and proceed, one element after the other, with ;; `org-element--current-element' until the container is found. Note: ;; When using `org-element-at-point', secondary values are never ;; parsed since the function focuses on elements, not on objects. @@ -4689,8 +5744,9 @@ indentation is not done with TAB characters." ;; `org-element-nested-p' and `org-element-swap-A-B' may be used ;; internally by navigation and manipulation tools. + ;;;###autoload -(defun org-element-at-point (&optional keep-trail) +(defun org-element-at-point () "Determine closest element around point. Return value is a list like (TYPE PROPS) where TYPE is the type @@ -4701,118 +5757,36 @@ Possible types are defined in `org-element-all-elements'. Properties depend on element or object type, but always include `:begin', `:end', `:parent' and `:post-blank' properties. -As a special case, if point is at the very beginning of a list or -sub-list, returned element will be that list instead of the first -item. In the same way, if point is at the beginning of the first -row of a table, returned element will be the table instead of the -first row. - -If optional argument KEEP-TRAIL is non-nil, the function returns -a list of elements leading to element at point. The list's CAR -is always the element at point. The following positions contain -element's siblings, then parents, siblings of parents, until the -first element of current section." +As a special case, if point is at the very beginning of the first +item in a list or sub-list, returned element will be that list +instead of the item. Likewise, if point is at the beginning of +the first row of a table, returned element will be the table +instead of the first row. + +When point is at the end of the buffer, return the innermost +element ending there." (org-with-wide-buffer - ;; If at a headline, parse it. It is the sole element that - ;; doesn't require to know about context. Be sure to disallow - ;; secondary string parsing, though. - (if (org-with-limited-levels (org-at-heading-p)) - (progn - (beginning-of-line) - (if (not keep-trail) (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser (point-max) t)))) - ;; Otherwise move at the beginning of the section containing - ;; point. - (catch 'exit - (let ((origin (point)) - (end (save-excursion - (org-with-limited-levels (outline-next-heading)) (point))) - element type special-flag trail struct prevs parent) - (org-with-limited-levels - (if (org-before-first-heading-p) - ;; In empty lines at buffer's beginning, return nil. - (progn (goto-char (point-min)) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - (throw 'exit nil))) - (org-back-to-heading) - (forward-line) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - ;; In blank lines just after the headline, point still - ;; belongs to the headline. - (throw 'exit - (progn (skip-chars-backward " \r\t\n") - (beginning-of-line) - (if (not keep-trail) - (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser - (point-max) t)))))))) - (beginning-of-line) - ;; Parse successively each element, skipping those ending - ;; before original position. - (while t - (setq element - (org-element--current-element end 'element special-flag struct) - type (car element)) - (org-element-put-property element :parent parent) - (when keep-trail (push element trail)) - (cond - ;; 1. Skip any element ending before point. Also skip - ;; element ending at point when we're sure that another - ;; element has started. - ((let ((elem-end (org-element-property :end element))) - (when (or (< elem-end origin) - (and (= elem-end origin) (/= elem-end end))) - (goto-char elem-end)))) - ;; 2. An element containing point is always the element at - ;; point. - ((not (memq type org-element-greater-elements)) - (throw 'exit (if keep-trail trail element))) - ;; 3. At any other greater element type, if point is - ;; within contents, move into it. - (t - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) - ;; Create an anchor for tables and plain lists: - ;; when point is at the very beginning of these - ;; elements, ignoring affiliated keywords, - ;; target them instead of their contents. - (and (= cbeg origin) (memq type '(plain-list table))) - ;; When point is at contents end, do not move - ;; into elements with an explicit ending, but - ;; return that element instead. - (and (= cend origin) - (or (memq type - '(center-block - drawer dynamic-block inlinetask - property-drawer quote-block - special-block)) - ;; Corner case: if a list ends at the - ;; end of a buffer without a final new - ;; line, return last element in last - ;; item instead. - (and (memq type '(item plain-list)) - (progn (goto-char cend) - (or (bolp) (not (eobp)))))))) - (throw 'exit (if keep-trail trail element)) - (setq parent element) - (case type - (plain-list - (setq special-flag 'item - struct (org-element-property :structure element))) - (item (setq special-flag nil)) - (property-drawer - (setq special-flag 'node-property struct nil)) - (table (setq special-flag 'table-row struct nil)) - (otherwise (setq special-flag nil struct nil))) - (setq end cend) - (goto-char cbeg))))))))))) + (let ((origin (point))) + (end-of-line) + (skip-chars-backward " \r\t\n") + (cond + ;; Within blank lines at the beginning of buffer, return nil. + ((bobp) nil) + ;; Within blank lines right after a headline, return that + ;; headline. + ((org-with-limited-levels (org-at-heading-p)) + (beginning-of-line) + (org-element-headline-parser (point-max) t)) + ;; Otherwise parse until we find element containing ORIGIN. + (t + (when (org-element--cache-active-p) + (if (not org-element--cache) (org-element-cache-reset) + (org-element--cache-sync (current-buffer) origin))) + (org-element--parse-to origin)))))) ;;;###autoload (defun org-element-context (&optional element) - "Return closest element or object around point. + "Return smallest element or object around point. Return value is a list like (TYPE PROPS) where TYPE is the type of the element or object and PROPS a plist of properties @@ -4823,34 +5797,36 @@ Possible types are defined in `org-element-all-elements' and object type, but always include `:begin', `:end', `:parent' and `:post-blank'. +As a special case, if point is right after an object and not at +the beginning of any other object, return that object. + Optional argument ELEMENT, when non-nil, is the closest element containing point, as returned by `org-element-at-point'. Providing it allows for quicker computation." (catch 'objects-forbidden (org-with-wide-buffer - (let* ((origin (point)) - (element (or element (org-element-at-point))) - (type (org-element-type element)) - context) - ;; Check if point is inside an element containing objects or at - ;; a secondary string. In that case, narrow buffer to the - ;; containing area. Otherwise, return ELEMENT. + (let* ((pos (point)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) + (post (org-element-property :post-affiliated element))) + ;; If point is inside an element containing objects or + ;; a secondary string, narrow buffer to the container and + ;; proceed with parsing. Otherwise, return ELEMENT. (cond ;; At a parsed affiliated keyword, check if we're inside main ;; or dual value. - ((let ((post (org-element-property :post-affiliated element))) - (and post (< origin post))) + ((and post (< pos post)) (beginning-of-line) (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) (cond ((not (member-ignore-case (match-string 1) org-element-parsed-keywords)) (throw 'objects-forbidden element)) - ((< (match-end 0) origin) + ((< (match-end 0) pos) (narrow-to-region (match-end 0) (line-end-position))) ((and (match-beginning 2) - (>= origin (match-beginning 2)) - (< origin (match-end 2))) + (>= pos (match-beginning 2)) + (< pos (match-end 2))) (narrow-to-region (match-beginning 2) (match-end 2))) (t (throw 'objects-forbidden element))) ;; Also change type to retrieve correct restrictions. @@ -4858,88 +5834,168 @@ Providing it allows for quicker computation." ;; At an item, objects can only be located within tag, if any. ((eq type 'item) (let ((tag (org-element-property :tag element))) - (if (not tag) (throw 'objects-forbidden element) + (if (or (not tag) (/= (line-beginning-position) post)) + (throw 'objects-forbidden element) (beginning-of-line) (search-forward tag (line-end-position)) (goto-char (match-beginning 0)) - (if (and (>= origin (point)) (< origin (match-end 0))) + (if (and (>= pos (point)) (< pos (match-end 0))) (narrow-to-region (point) (match-end 0)) (throw 'objects-forbidden element))))) - ;; At an headline or inlinetask, objects are located within - ;; their title. + ;; At an headline or inlinetask, objects are in title. ((memq type '(headline inlinetask)) - (goto-char (org-element-property :begin element)) - (skip-chars-forward "*") - (if (and (> origin (point)) (< origin (line-end-position))) - (narrow-to-region (point) (line-end-position)) - (throw 'objects-forbidden element))) + (let ((case-fold-search nil)) + (goto-char (org-element-property :begin element)) + (looking-at org-complex-heading-regexp) + (let ((end (match-end 4))) + (if (not end) (throw 'objects-forbidden element) + (goto-char (match-beginning 4)) + (when (looking-at org-comment-string) + (goto-char (match-end 0))) + (if (>= (point) end) (throw 'objects-forbidden element) + (narrow-to-region (point) end)))))) ;; At a paragraph, a table-row or a verse block, objects are ;; located within their contents. ((memq type '(paragraph table-row verse-block)) (let ((cbeg (org-element-property :contents-begin element)) (cend (org-element-property :contents-end element))) ;; CBEG is nil for table rules. - (if (and cbeg cend (>= origin cbeg) (< origin cend)) + (if (and cbeg cend (>= pos cbeg) + (or (< pos cend) (and (= pos cend) (eobp)))) (narrow-to-region cbeg cend) (throw 'objects-forbidden element)))) - ;; At a parsed keyword, objects are located within value. - ((eq type 'keyword) - (if (not (member (org-element-property :key element) - org-element-document-properties)) - (throw 'objects-forbidden element) - (beginning-of-line) - (search-forward ":") - (if (and (>= origin (point)) (< origin (line-end-position))) - (narrow-to-region (point) (line-end-position)) - (throw 'objects-forbidden element)))) ;; At a planning line, if point is at a timestamp, return it, ;; otherwise, return element. ((eq type 'planning) (dolist (p '(:closed :deadline :scheduled)) (let ((timestamp (org-element-property p element))) (when (and timestamp - (<= (org-element-property :begin timestamp) origin) - (> (org-element-property :end timestamp) origin)) + (<= (org-element-property :begin timestamp) pos) + (> (org-element-property :end timestamp) pos)) (throw 'objects-forbidden timestamp)))) + ;; All other locations cannot contain objects: bail out. (throw 'objects-forbidden element)) (t (throw 'objects-forbidden element))) (goto-char (point-min)) (let ((restriction (org-element-restriction type)) - (parent element) - (candidates 'initial)) - (catch 'exit - (while (setq candidates - (org-element--get-next-object-candidates - restriction candidates)) - (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) - candidates))) - ;; If ORIGIN is before next object in element, there's - ;; no point in looking further. - (if (> (cdr closest-cand) origin) (throw 'exit parent) - (let* ((object - (progn (goto-char (cdr closest-cand)) - (funcall (intern (format "org-element-%s-parser" - (car closest-cand)))))) - (cbeg (org-element-property :contents-begin object)) - (cend (org-element-property :contents-end object)) - (obj-end (org-element-property :end object))) - (cond - ;; ORIGIN is after OBJECT, so skip it. - ((<= obj-end origin) (goto-char obj-end)) - ;; ORIGIN is within a non-recursive object or at - ;; an object boundaries: Return that object. - ((or (not cbeg) (< origin cbeg) (>= origin cend)) - (throw 'exit - (org-element-put-property object :parent parent))) - ;; Otherwise, move within current object and - ;; restrict search to the end of its contents. - (t (goto-char cbeg) - (narrow-to-region (point) cend) - (org-element-put-property object :parent parent) - (setq parent object - restriction (org-element-restriction object) - candidates 'initial))))))) - parent)))))) + (parent element) + (cache (cond ((not (org-element--cache-active-p)) nil) + (org-element--cache-objects + (gethash element org-element--cache-objects)) + (t (org-element-cache-reset) nil))) + next object-data last) + (prog1 + (catch 'exit + (while t + ;; When entering PARENT for the first time, get list + ;; of objects within known so far. Store it in + ;; OBJECT-DATA. + (unless next + (let ((data (assq parent cache))) + (if data (setq object-data data) + (push (setq object-data (list parent nil)) cache)))) + ;; Find NEXT object for analysis. + (catch 'found + ;; If NEXT is non-nil, we already exhausted the + ;; cache so we can parse buffer to find the object + ;; after it. + (if next (setq next (org-element--object-lex restriction)) + ;; Otherwise, check if cache can help us. + (let ((objects (cddr object-data)) + (completep (nth 1 object-data))) + (cond + ((and (not objects) completep) (throw 'exit parent)) + ((not objects) + (setq next (org-element--object-lex restriction))) + (t + (let ((cache-limit + (org-element-property :end (car objects)))) + (if (>= cache-limit pos) + ;; Cache contains the information needed. + (dolist (object objects (throw 'exit parent)) + (when (<= (org-element-property :begin object) + pos) + (if (>= (org-element-property :end object) + pos) + (throw 'found (setq next object)) + (throw 'exit parent)))) + (goto-char cache-limit) + (setq next + (org-element--object-lex restriction)))))))) + ;; If we have a new object to analyze, store it in + ;; cache. Otherwise record that there is nothing + ;; more to parse in this element at this depth. + (if next + (progn (org-element-put-property next :parent parent) + (push next (cddr object-data))) + (setcar (cdr object-data) t))) + ;; Process NEXT, if any, in order to know if we need + ;; to skip it, return it or move into it. + (if (or (not next) (> (org-element-property :begin next) pos)) + (throw 'exit (or last parent)) + (let ((end (org-element-property :end next)) + (cbeg (org-element-property :contents-begin next)) + (cend (org-element-property :contents-end next))) + (cond + ;; Skip objects ending before point. Also skip + ;; objects ending at point unless it is also the + ;; end of buffer, since we want to return the + ;; innermost object. + ((and (<= end pos) (/= (point-max) end)) + (goto-char end) + ;; For convenience, when object ends at POS, + ;; without any space, store it in LAST, as we + ;; will return it if no object starts here. + (when (and (= end pos) + (not (memq (char-before) '(?\s ?\t)))) + (setq last next))) + ;; If POS is within a container object, move + ;; into that object. + ((and cbeg cend + (>= pos cbeg) + (or (< pos cend) + ;; At contents' end, if there is no + ;; space before point, also move into + ;; object, for consistency with + ;; convenience feature above. + (and (= pos cend) + (or (= (point-max) pos) + (not (memq (char-before pos) + '(?\s ?\t))))))) + (goto-char cbeg) + (narrow-to-region (point) cend) + (setq parent next + restriction (org-element-restriction next) + next nil + object-data nil)) + ;; Otherwise, return NEXT. + (t (throw 'exit next))))))) + ;; Store results in cache, if applicable. + (org-element--cache-put element cache))))))) + +(defun org-element-lineage (blob &optional types with-self) + "List all ancestors of a given element or object. + +BLOB is an object or element. + +When optional argument TYPES is a list of symbols, return the +first element or object in the lineage whose type belongs to that +list. + +When optional argument WITH-SELF is non-nil, lineage includes +BLOB itself as the first element, and TYPES, if provided, also +apply to it. + +When BLOB is obtained through `org-element-context' or +`org-element-at-point', only ancestors from its section can be +found. There is no such limitation when BLOB belongs to a full +parse tree." + (let ((up (if with-self blob (org-element-property :parent blob))) + ancestors) + (while (and up (not (memq (org-element-type up) types))) + (unless types (push up ancestors)) + (setq up (org-element-property :parent up))) + (if types up (nreverse ancestors)))) (defun org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." @@ -4982,39 +6038,44 @@ end of ELEM-A." (goto-char (org-element-property :end elem-B)) (skip-chars-backward " \r\t\n") (point-at-eol))) - ;; Store overlays responsible for visibility status. We - ;; also need to store their boundaries as they will be + ;; Store inner overlays responsible for visibility status. + ;; We also need to store their boundaries as they will be ;; removed from buffer. (overlays (cons - (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-A end-A)) - (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-B end-B)))) + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-A) + (<= (overlay-end o) end-A) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-A end-A))) + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-B) + (<= (overlay-end o) end-B) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-B end-B))))) ;; Get contents. (body-A (buffer-substring beg-A end-A)) (body-B (delete-and-extract-region beg-B end-B))) (goto-char beg-B) (when specialp (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) - (org-indent-to-column ind-B)) + (indent-to-column ind-B)) (insert body-A) ;; Restore ex ELEM-A overlays. (let ((offset (- beg-B beg-A))) - (mapc (lambda (ov) - (move-overlay - (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset))) - (car overlays)) + (dolist (o (car overlays)) + (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset))) (goto-char beg-A) (delete-region beg-A end-A) (insert body-B) ;; Restore ex ELEM-B overlays. - (mapc (lambda (ov) - (move-overlay - (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset))) - (cdr overlays))) + (dolist (o (cdr overlays)) + (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) (goto-char (org-element-property :end elem-B))))) + (provide 'org-element) ;; Local variables: diff --git a/lisp/org/org-entities.el b/lisp/org/org-entities.el index 3ca2cceea7..05ccf0cf5b 100644 --- a/lisp/org/org-entities.el +++ b/lisp/org/org-entities.el @@ -1,4 +1,4 @@ -;;; org-entities.el --- Support for special entities in Org-mode +;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*- ;; Copyright (C) 2010-2017 Free Software Foundation, Inc. @@ -30,38 +30,36 @@ (declare-function org-toggle-pretty-entities "org" ()) (declare-function org-table-align "org-table" ()) -(eval-when-compile - (require 'cl)) - (defgroup org-entities nil - "Options concerning entities in Org-mode." + "Options concerning entities in Org mode." :tag "Org Entities" :group 'org) -(defcustom org-entities-ascii-explanatory nil - "Non-nil means replace special entities in ASCII. -For example, this will replace \"\\nsup\" with \"[not a superset of]\" -in backends where the corresponding character is not available." - :group 'org-entities - :version "24.1" - :type 'boolean) +(defun org-entities--user-safe-p (v) + "Non-nil if V is a safe value for `org-entities-user'." + (pcase v + (`nil t) + (`(,(and (pred stringp) + (pred (string-match-p "\\`[a-zA-Z][a-zA-Z0-9]*\\'"))) + ,(pred stringp) ,(pred booleanp) ,(pred stringp) + ,(pred stringp) ,(pred stringp) ,(pred stringp)) + t) + (_ nil))) (defcustom org-entities-user nil - "User-defined entities used in Org-mode to produce special characters. + "User-defined entities used in Org to produce special characters. Each entry in this list is a list of strings. It associates the name of the entity that can be inserted into an Org file as \\name with the appropriate replacements for the different export backends. The order of the fields is the following -name As a string, without the leading backslash -LaTeX replacement In ready LaTeX, no further processing will take place -LaTeX mathp A Boolean, either t or nil. t if this entity needs - to be in math mode. +name As a string, without the leading backslash. +LaTeX replacement In ready LaTeX, no further processing will take place. +LaTeX mathp Either t or nil. When t this entity needs to be in + math mode. HTML replacement In ready HTML, no further processing will take place. Usually this will be an &...; entity. -ASCII replacement Plain ASCII, no extensions. Symbols that cannot be - represented will be left as they are, but see the. - variable `org-entities-ascii-explanatory'. +ASCII replacement Plain ASCII, no extensions. Latin1 replacement Use the special characters available in latin1. utf-8 replacement Use the special characters available in utf-8. @@ -77,439 +75,454 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." (string :tag "HTML ") (string :tag "ASCII ") (string :tag "Latin1") - (string :tag "utf-8 ")))) + (string :tag "utf-8 "))) + :safe #'org-entities--user-safe-p) (defconst org-entities - '( - "* Letters" - "** Latin" - ("Agrave" "\\`{A}" nil "À" "A" "À" "À") - ("agrave" "\\`{a}" nil "à" "a" "à" "à") - ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") - ("aacute" "\\'{a}" nil "á" "a" "á" "á") - ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") - ("acirc" "\\^{a}" nil "â" "a" "â" "â") - ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") - ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") - ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") - ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") - ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") - ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") - ("aring" "\\aa{}" nil "å" "a" "å" "å") - ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") - ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") - ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") - ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") - ("Egrave" "\\`{E}" nil "È" "E" "È" "È") - ("egrave" "\\`{e}" nil "è" "e" "è" "è") - ("Eacute" "\\'{E}" nil "É" "E" "É" "É") - ("eacute" "\\'{e}" nil "é" "e" "é" "é") - ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") - ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") - ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") - ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") - ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") - ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") - ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") - ("iacute" "\\'{i}" nil "í" "i" "í" "í") - ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") - ("icirc" "\\^{i}" nil "î" "i" "î" "î") - ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") - ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") - ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") - ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") - ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") - ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") - ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") - ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") - ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") - ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") - ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") - ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") - ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") - ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") - ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") - ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") - ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") - ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") - ("Scaron" "\\v{S}" nil "Š" "S" "S" "Š") - ("scaron" "\\v{s}" nil "š" "s" "s" "š") - ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") - ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") - ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") - ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") - ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") - ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") - ("ucirc" "\\^{u}" nil "û" "u" "û" "û") - ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") - ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") - ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") - ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") - ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") - ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") - - "** Latin (special face)" - ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") - ("real" "\\Re" t "ℜ" "R" "R" "ℜ") - ("image" "\\Im" t "ℑ" "I" "I" "ℑ") - ("weierp" "\\wp" t "℘" "P" "P" "℘") - ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") - ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") - ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "ȷ") - - "** Greek" - ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") - ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") - ("Beta" "B" nil "Β" "Beta" "Beta" "Β") - ("beta" "\\beta" t "β" "beta" "beta" "β") - ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") - ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") - ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") - ("delta" "\\delta" t "δ" "delta" "delta" "δ") - ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") - ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") - ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") - ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") - ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") - ("Eta" "H" nil "Η" "Eta" "Eta" "Η") - ("eta" "\\eta" t "η" "eta" "eta" "η") - ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") - ("theta" "\\theta" t "θ" "theta" "theta" "θ") - ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") - ("iota" "\\iota" t "ι" "iota" "iota" "ι") - ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") - ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") - ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") - ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") - ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") - ("mu" "\\mu" t "μ" "mu" "mu" "μ") - ("nu" "\\nu" t "ν" "nu" "nu" "ν") - ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") - ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") - ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") - ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") - ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") - ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") - ("pi" "\\pi" t "π" "pi" "pi" "π") - ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") - ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") - ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") - ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") - ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") - ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") - ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") - ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Υ") - ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") - ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") - ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") - ("phi" "\\phi" t "φ" "phi" "phi" "φ") - ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") - ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") - ("chi" "\\chi" t "χ" "chi" "chi" "χ") - ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") - ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") - ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") - ("tau" "\\tau" t "τ" "tau" "tau" "τ") - ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") - ("omega" "\\omega" t "ω" "omega" "omega" "ω") - ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") - ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") - ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") - - "** Hebrew" - ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") - ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") - ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") - - "** Dead languages" - ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") - ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") - ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") - ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") - - "* Punctuation" - "** Dots and Marks" - ("dots" "\\dots{}" nil "…" "..." "..." "…") - ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") - ("hellip" "\\dots{}" nil "…" "..." "..." "…") - ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") - ("iexcl" "!`" nil "¡" "!" "¡" "¡") - ("iquest" "?`" nil "¿" "?" "¿" "¿") - - "** Dash-like" - ("shy" "\\-" nil "­" "" "" "") - ("ndash" "--" nil "–" "-" "-" "–") - ("mdash" "---" nil "—" "--" "--" "—") - - "** Quotations" - ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") - ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") - ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") - ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") - ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") - ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") - ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") - ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") - ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") - ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") - ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") - ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") - - "* Other" - "** Misc. (often used)" - ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") - ("vert" "\\vert{}" t "|" "|" "|" "|") - ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") - ("S" "\\S" nil "§" "paragraph" "§" "§") - ("sect" "\\S" nil "§" "paragraph" "§" "§") - ("amp" "\\&" nil "&" "&" "&" "&") - ("lt" "\\textless{}" nil "<" "<" "<" "<") - ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") - ("slash" "/" nil "/" "/" "/" "/") - ("plus" "+" nil "+" "+" "+" "+") - ("under" "\\_" nil "_" "_" "_" "_") - ("equal" "=" nil "=" "=" "=" "=") - ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") - ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") - ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") - ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - - "** Whitespace" - ("nbsp" "~" nil " " " " " " " ") - ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") - ("emsp" "\\hspace*{1em}" nil " " " " " " " ") - ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") - - "** Currency" - ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") - ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") - ("pound" "\\pounds{}" nil "£" "pound" "£" "£") - ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") - ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") - ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") - ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") - ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") - ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") - ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") - - "** Property Marks" - ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") - ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") - ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") - - "** Science et al." - ("minus" "\\minus" t "−" "-" "-" "−") - ("pm" "\\textpm{}" nil "±" "+-" "±" "±") - ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") - ("times" "\\texttimes{}" nil "×" "*" "×" "×") - ("frasl" "/" nil "⁄" "/" "/" "⁄") - ("colon" "\\colon" t ":" ":" ":" ":") - ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") - ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") - ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") - ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") - ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") - ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") - ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") - ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") - ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") - ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") - ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") - ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") - ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") - ("deg" "\\textdegree{}" nil "°" "degree" "°" "°") - ("prime" "\\prime" t "′" "'" "'" "′") - ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") - ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") - ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") - ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") - ("propto" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") - ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") - ("neg" "\\neg{}" t "¬" "[angled dash]" "¬" "¬") - ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") - ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") - ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") - ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") - ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") - ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") - ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") - ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") - ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") - ("because" "\\because" t "∵" "[because]" "[because]" "∵") - ("sim" "\\sim" t "∼" "~" "~" "∼") - ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") - ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") - ("asymp" "\\asymp" t "≈" "[almost equal to]" "[almost equal to]" "≈") - ("approx" "\\approx" t "≈" "[almost equal to]" "[almost equal to]" "≈") - ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") - ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") - ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") - - ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") - ("le" "\\le" t "≤" "<=" "<=" "≤") - ("leq" "\\le" t "≤" "<=" "<=" "≤") - ("ge" "\\ge" t "≥" ">=" ">=" "≥") - ("geq" "\\ge" t "≥" ">=" ">=" "≥") - ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") - ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") - ("ll" "\\ll" t "≪" "<<" "<<" "≪") - ("Ll" "\\lll" t "⋘" "<<<" "<<<" "⋘") - ("lll" "\\lll" t "⋘" "<<<" "<<<" "⋘") - ("gg" "\\gg" t "≫" ">>" ">>" "≫") - ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") - ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") - ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") - ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") - ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") - ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") - ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") - ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") - ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") - ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") - ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") - ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") - ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") - ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") - ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") - ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") - ("setminus" "\\setminus" t "∖" "\" "\" "⧵") - ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") - ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") - ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") - ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") - ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") - ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") - ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") - ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") - ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") - ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") - ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") - ("lceil" "\\lceil" t "⌈" "[left ceiling]" "[left ceiling]" "⌈") - ("rceil" "\\rceil" t "⌉" "[right ceiling]" "[right ceiling]" "⌉") - ("lfloor" "\\lfloor" t "⌊" "[left floor]" "[left floor]" "⌊") - ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") - ("lang" "\\langle" t "⟨" "<" "<" "⟨") - ("rang" "\\rangle" t "⟩" ">" ">" "⟩") - ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") - ("mho" "\\mho" t "℧" "mho" "mho" "℧") - - "** Arrows" - ("larr" "\\leftarrow" t "←" "<-" "<-" "←") - ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") - ("gets" "\\gets" t "←" "<-" "<-" "←") - ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("rarr" "\\rightarrow" t "→" "->" "->" "→") - ("to" "\\to" t "→" "->" "->" "→") - ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") - ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - - "** Function names" - ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") - ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") - ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") - ("arg" "\\arg" t "arg" "arg" "arg" "arg") - ("cos" "\\cos" t "cos" "cos" "cos" "cos") - ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh") - ("cot" "\\cot" t "cot" "cot" "cot" "cot") - ("coth" "\\coth" t "coth" "coth" "coth" "coth") - ("csc" "\\csc" t "csc" "csc" "csc" "csc") - ("deg" "\\deg" t "°" "deg" "deg" "deg") - ("det" "\\det" t "det" "det" "det" "det") - ("dim" "\\dim" t "dim" "dim" "dim" "dim") - ("exp" "\\exp" t "exp" "exp" "exp" "exp") - ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd") - ("hom" "\\hom" t "hom" "hom" "hom" "hom") - ("inf" "\\inf" t "inf" "inf" "inf" "inf") - ("ker" "\\ker" t "ker" "ker" "ker" "ker") - ("lg" "\\lg" t "lg" "lg" "lg" "lg") - ("lim" "\\lim" t "lim" "lim" "lim" "lim") - ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf") - ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup") - ("ln" "\\ln" t "ln" "ln" "ln" "ln") - ("log" "\\log" t "log" "log" "log" "log") - ("max" "\\max" t "max" "max" "max" "max") - ("min" "\\min" t "min" "min" "min" "min") - ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr") - ("sec" "\\sec" t "sec" "sec" "sec" "sec") - ("sin" "\\sin" t "sin" "sin" "sin" "sin") - ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh") - ("sup" "\\sup" t "⊃" "sup" "sup" "sup") - ("tan" "\\tan" t "tan" "tan" "tan" "tan") - ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") - - "** Signs & Symbols" - ("bull" "\\textbullet{}" nil "•" "*" "*" "•") - ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") - ("star" "\\star" t "*" "*" "*" "⋆") - ("lowast" "\\ast" t "∗" "*" "*" "∗") - ("ast" "\\ast" t "∗" "*" "*" "*") - ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") - ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") - ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") - ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") - - "** Miscellaneous (seldom used)" - ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") - ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") - ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") - ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") - ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") - ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") - ("zwnj" "\\/{}" nil "‌" "" "" "‌") - ("zwj" "" nil "‍" "" "" "‍") - ("lrm" "" nil "‎" "" "" "‎") - ("rlm" "" nil "‏" "" "" "‏") - - "** Smilies" - ("smile" "\\smile" t "⌣" ":-)" ":-)" "⌣") - ("frown" "\\frown" t "⌢" ":-(" ":-(" "⌢") - ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") - ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") - ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") - - "** Suits" - ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") - ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") - ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") - ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "⧫") - ) - "Default entities used in Org-mode to produce special characters. + (append + '("* Letters" + "** Latin" + ("Agrave" "\\`{A}" nil "À" "A" "À" "À") + ("agrave" "\\`{a}" nil "à" "a" "à" "à") + ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") + ("aacute" "\\'{a}" nil "á" "a" "á" "á") + ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") + ("acirc" "\\^{a}" nil "â" "a" "â" "â") + ("Amacr" "\\bar{A}" nil "Ā" "A" "Ã" "Ã") + ("amacr" "\\bar{a}" nil "ā" "a" "ã" "ã") + ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") + ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") + ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") + ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") + ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") + ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") + ("aring" "\\aa{}" nil "å" "a" "å" "å") + ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") + ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") + ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") + ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") + ("Egrave" "\\`{E}" nil "È" "E" "È" "È") + ("egrave" "\\`{e}" nil "è" "e" "è" "è") + ("Eacute" "\\'{E}" nil "É" "E" "É" "É") + ("eacute" "\\'{e}" nil "é" "e" "é" "é") + ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") + ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") + ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") + ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") + ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") + ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") + ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") + ("iacute" "\\'{i}" nil "í" "i" "í" "í") + ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") + ("icirc" "\\^{i}" nil "î" "i" "î" "î") + ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") + ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") + ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") + ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") + ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") + ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") + ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") + ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") + ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") + ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") + ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") + ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") + ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") + ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") + ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") + ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") + ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") + ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") + ("Scaron" "\\v{S}" nil "Š" "S" "S" "Š") + ("scaron" "\\v{s}" nil "š" "s" "s" "š") + ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") + ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") + ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") + ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") + ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") + ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") + ("ucirc" "\\^{u}" nil "û" "u" "û" "û") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") + ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") + ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") + ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") + ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") + ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") + + "** Latin (special face)" + ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") + ("real" "\\Re" t "ℜ" "R" "R" "ℜ") + ("image" "\\Im" t "ℑ" "I" "I" "ℑ") + ("weierp" "\\wp" t "℘" "P" "P" "℘") + ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") + ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") + ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "ȷ") + + "** Greek" + ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") + ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") + ("Beta" "B" nil "Β" "Beta" "Beta" "Β") + ("beta" "\\beta" t "β" "beta" "beta" "β") + ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") + ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") + ("Delta" "\\Delta" t "Δ" "Delta" "Delta" "Δ") + ("delta" "\\delta" t "δ" "delta" "delta" "δ") + ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") + ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") + ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") + ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") + ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") + ("Eta" "H" nil "Η" "Eta" "Eta" "Η") + ("eta" "\\eta" t "η" "eta" "eta" "η") + ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") + ("theta" "\\theta" t "θ" "theta" "theta" "θ") + ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") + ("iota" "\\iota" t "ι" "iota" "iota" "ι") + ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") + ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") + ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") + ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") + ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") + ("mu" "\\mu" t "μ" "mu" "mu" "μ") + ("nu" "\\nu" t "ν" "nu" "nu" "ν") + ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") + ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") + ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") + ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") + ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") + ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") + ("pi" "\\pi" t "π" "pi" "pi" "π") + ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") + ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") + ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") + ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") + ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") + ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") + ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") + ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Υ") + ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") + ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") + ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") + ("phi" "\\phi" t "φ" "phi" "phi" "ɸ") + ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "φ") + ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") + ("chi" "\\chi" t "χ" "chi" "chi" "χ") + ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") + ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") + ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") + ("tau" "\\tau" t "τ" "tau" "tau" "τ") + ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") + ("omega" "\\omega" t "ω" "omega" "omega" "ω") + ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") + + "** Hebrew" + ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") + ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") + ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") + + "** Dead languages" + ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") + ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") + ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") + ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") + + "* Punctuation" + "** Dots and Marks" + ("dots" "\\dots{}" nil "…" "..." "..." "…") + ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") + ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") + ("iexcl" "!`" nil "¡" "!" "¡" "¡") + ("iquest" "?`" nil "¿" "?" "¿" "¿") + + "** Dash-like" + ("shy" "\\-" nil "­" "" "" "") + ("ndash" "--" nil "–" "-" "-" "–") + ("mdash" "---" nil "—" "--" "--" "—") + + "** Quotations" + ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") + ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") + ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") + ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") + ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") + ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") + ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") + ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") + ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") + ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") + ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") + ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") + + "* Other" + "** Misc. (often used)" + ("circ" "\\^{}" nil "ˆ" "^" "^" "∘") + ("vert" "\\vert{}" t "|" "|" "|" "|") + ("vbar" "|" nil "|" "|" "|" "|") + ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("S" "\\S" nil "§" "paragraph" "§" "§") + ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("amp" "\\&" nil "&" "&" "&" "&") + ("lt" "\\textless{}" nil "<" "<" "<" "<") + ("gt" "\\textgreater{}" nil ">" ">" ">" ">") + ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") + ("slash" "/" nil "/" "/" "/" "/") + ("plus" "+" nil "+" "+" "+" "+") + ("under" "\\_" nil "_" "_" "_" "_") + ("equal" "=" nil "=" "=" "=" "=") + ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") + ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") + ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + + "** Whitespace" + ("nbsp" "~" nil " " " " "\x00A0" "\x00A0") + ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") + ("emsp" "\\hspace*{1em}" nil " " " " " " " ") + ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") + + "** Currency" + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") + ("pound" "\\pounds{}" nil "£" "pound" "£" "£") + ("yen" "\\textyen{}" nil "¥" "yen" "¥" "¥") + ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("EUR" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + + "** Property Marks" + ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") + ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") + ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") + + "** Science et al." + ("minus" "\\minus" t "−" "-" "-" "−") + ("pm" "\\textpm{}" nil "±" "+-" "±" "±") + ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") + ("times" "\\texttimes{}" nil "×" "*" "×" "×") + ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("colon" "\\colon" t ":" ":" ":" ":") + ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") + ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") + ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") + ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") + ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") + ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") + ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") + ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") + ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") + ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") + ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") + ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") + ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") + ("deg" "\\textdegree{}" nil "°" "degree" "°" "°") + ("prime" "\\prime" t "′" "'" "'" "′") + ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") + ("infin" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") + ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") + ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("propto" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("neg" "\\neg{}" t "¬" "[angled dash]" "¬" "¬") + ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") + ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") + ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") + ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") + ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") + ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") + ("smile" "\\smile" t "⌣" "[cup product]" "[cup product]" "⌣") + ("frown" "\\frown" t "⌢" "[Cap product]" "[cap product]" "⌢") + ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") + ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("because" "\\because" t "∵" "[because]" "[because]" "∵") + ("sim" "\\sim" t "∼" "~" "~" "∼") + ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("asymp" "\\asymp" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("approx" "\\approx" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") + ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") + ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") + + ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") + ("le" "\\le" t "≤" "<=" "<=" "≤") + ("leq" "\\le" t "≤" "<=" "<=" "≤") + ("ge" "\\ge" t "≥" ">=" ">=" "≥") + ("geq" "\\ge" t "≥" ">=" ">=" "≥") + ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") + ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") + ("ll" "\\ll" t "≪" "<<" "<<" "≪") + ("Ll" "\\lll" t "⋘" "<<<" "<<<" "⋘") + ("lll" "\\lll" t "⋘" "<<<" "<<<" "⋘") + ("gg" "\\gg" t "≫" ">>" ">>" "≫") + ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") + ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") + ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") + ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") + ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") + ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") + ("setminus" "\\setminus" t "∖" "\" "\" "⧵") + ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") + ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") + ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") + ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") + ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") + ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") + ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") + ("parallel" "\\parallel" t "∥" "||" "||" "∥") + ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("lceil" "\\lceil" t "⌈" "[left ceiling]" "[left ceiling]" "⌈") + ("rceil" "\\rceil" t "⌉" "[right ceiling]" "[right ceiling]" "⌉") + ("lfloor" "\\lfloor" t "⌊" "[left floor]" "[left floor]" "⌊") + ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") + ("lang" "\\langle" t "⟨" "<" "<" "⟨") + ("rang" "\\rangle" t "⟩" ">" ">" "⟩") + ("langle" "\\langle" t "⟨" "<" "<" "⟨") + ("rangle" "\\rangle" t "⟩" ">" ">" "⟩") + ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") + ("mho" "\\mho" t "℧" "mho" "mho" "℧") + + "** Arrows" + ("larr" "\\leftarrow" t "←" "<-" "<-" "←") + ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") + ("gets" "\\gets" t "←" "<-" "<-" "←") + ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("rarr" "\\rightarrow" t "→" "->" "->" "→") + ("to" "\\to" t "→" "->" "->" "→") + ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") + ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + + "** Function names" + ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") + ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") + ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") + ("arg" "\\arg" t "arg" "arg" "arg" "arg") + ("cos" "\\cos" t "cos" "cos" "cos" "cos") + ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh") + ("cot" "\\cot" t "cot" "cot" "cot" "cot") + ("coth" "\\coth" t "coth" "coth" "coth" "coth") + ("csc" "\\csc" t "csc" "csc" "csc" "csc") + ("deg" "\\deg" t "°" "deg" "deg" "deg") + ("det" "\\det" t "det" "det" "det" "det") + ("dim" "\\dim" t "dim" "dim" "dim" "dim") + ("exp" "\\exp" t "exp" "exp" "exp" "exp") + ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd") + ("hom" "\\hom" t "hom" "hom" "hom" "hom") + ("inf" "\\inf" t "inf" "inf" "inf" "inf") + ("ker" "\\ker" t "ker" "ker" "ker" "ker") + ("lg" "\\lg" t "lg" "lg" "lg" "lg") + ("lim" "\\lim" t "lim" "lim" "lim" "lim") + ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf") + ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup") + ("ln" "\\ln" t "ln" "ln" "ln" "ln") + ("log" "\\log" t "log" "log" "log" "log") + ("max" "\\max" t "max" "max" "max" "max") + ("min" "\\min" t "min" "min" "min" "min") + ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr") + ("sec" "\\sec" t "sec" "sec" "sec" "sec") + ("sin" "\\sin" t "sin" "sin" "sin" "sin") + ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh") + ("sup" "\\sup" t "⊃" "sup" "sup" "sup") + ("tan" "\\tan" t "tan" "tan" "tan" "tan") + ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") + + "** Signs & Symbols" + ("bull" "\\textbullet{}" nil "•" "*" "*" "•") + ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") + ("star" "\\star" t "*" "*" "*" "⋆") + ("lowast" "\\ast" t "∗" "*" "*" "∗") + ("ast" "\\ast" t "∗" "*" "*" "*") + ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") + ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") + ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + + "** Miscellaneous (seldom used)" + ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") + ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") + ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") + ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") + ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") + ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") + ("zwnj" "\\/{}" nil "‌" "" "" "‌") + ("zwj" "" nil "‍" "" "" "‍") + ("lrm" "" nil "‎" "" "" "‎") + ("rlm" "" nil "‏" "" "" "‏") + + "** Smilies" + ("smiley" "\\ddot\\smile" t "☺" ":-)" ":-)" "☺") + ("blacksmile" "\\ddot\\smile" t "☻" ":-)" ":-)" "☻") + ("sad" "\\ddot\\frown" t "☹" ":-(" ":-(" "☹") + ("frowny" "\\ddot\\frown" t "☹" ":-(" ":-(" "☹") + + "** Suits" + ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "⧫")) + ;; Add "\_ "-entity family for spaces. + (let (space-entities html-spaces (entity "_")) + (dolist (n (number-sequence 1 20) (nreverse space-entities)) + (let ((spaces (make-string n ?\s))) + (push (list (setq entity (concat entity " ")) + (format "\\hspace*{%sem}" (* n .5)) + nil + (setq html-spaces (concat " " html-spaces)) + spaces + spaces + (make-string n ?\x2002)) + space-entities))))) + "Default entities used in Org mode to produce special characters. For details see `org-entities-user'.") (defsubst org-entity-get (name) @@ -518,52 +531,27 @@ This first checks the user list, then the built-in list." (or (assoc name org-entities-user) (assoc name org-entities))) -(defun org-entity-get-representation (name kind) - "Get the correct representation of entity NAME for export type KIND. -Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." - (let* ((e (org-entity-get name)) - (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4) - (latin1 . 5) (utf8 . 6))))) - (r (and e n (nth n e)))) - (if (and e r - (not org-entities-ascii-explanatory) - (memq kind '(ascii latin1 utf8)) - (= (string-to-char r) ?\[)) - (concat "\\" name) - r))) - -(defsubst org-entity-latex-math-p (name) - "Does entity NAME require math mode in LaTeX?" - (nth 2 (org-entity-get name))) - ;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org (defun org-entities-create-table () "Create an Org mode table with all entities." (interactive) - (let ((pos (point)) e latex mathp html latin utf8 name ascii) + (let ((pos (point))) (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") - (mapc (lambda (e) (when (listp e) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n"))) - org-entities) + (dolist (e org-entities) + (pcase e + (`(,name ,latex ,mathp ,html ,ascii ,latin ,utf8) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n")))) (goto-char pos) (org-table-align))) @@ -572,31 +560,27 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." "Create a Help buffer with all available entities." (interactive) (with-output-to-temp-buffer "*Org Entity Help*" - (princ "Org-mode entities\n=================\n\n") + (princ "Org mode entities\n=================\n\n") (let ((ll (append '("* User-defined additions (variable org-entities-user)") org-entities-user org-entities)) - e latex mathp html latin utf8 name ascii (lastwasstring t) (head (concat "\n" " Symbol Org entity LaTeX code HTML code\n" " -----------------------------------------------------------\n"))) - (while ll - (setq e (pop ll)) - (if (stringp e) - (progn - (princ e) - (princ "\n") - (setq lastwasstring t)) - (if lastwasstring (princ head)) - (setq lastwasstring nil) - (setq name (car e) - latex (nth 1 e) - html (nth 3 e) - utf8 (nth 6 e)) - (princ (format " %-8s \\%-16s %-22s %-13s\n" - utf8 name latex html)))))) + (dolist (e ll) + (pcase e + (`(,name ,latex ,_ ,html ,_ ,_ ,utf8) + (when lastwasstring + (princ head) + (setq lastwasstring nil)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html))) + ((pred stringp) + (princ e) + (princ "\n") + (setq lastwasstring t)))))) (with-current-buffer "*Org Entity Help*" (org-mode) (when org-pretty-entities @@ -604,12 +588,6 @@ Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." (select-window (get-buffer-window "*Org Entity Help*"))) -(defun replace-amp () - "Postprocess HTML file to unescape the ampersand." - (interactive) - (while (re-search-forward "&\\([^<;]+;\\)" nil t) - (replace-match (concat "&" (match-string 1)) t t))) - (provide 'org-entities) ;; Local variables: diff --git a/lisp/org/org-eshell.el b/lisp/org/org-eshell.el index 9eddd3fcf4..34cc4ffbb8 100644 --- a/lisp/org/org-eshell.el +++ b/lisp/org/org-eshell.el @@ -1,4 +1,4 @@ -;;; org-eshell.el - Support for links to working directories in eshell +;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -27,8 +27,9 @@ (require 'eshell) (require 'esh-mode) -(org-add-link-type "eshell" 'org-eshell-open) -(add-hook 'org-store-link-functions 'org-eshell-store-link) +(org-link-set-parameters "eshell" + :follow #'org-eshell-open + :store #'org-eshell-store-link) (defun org-eshell-open (link) "Switch to am eshell buffer and execute a command line. @@ -43,7 +44,7 @@ (eshell-buffer-name (car buffer-and-command)) (command (cadr buffer-and-command))) (if (get-buffer eshell-buffer-name) - (org-pop-to-buffer-same-window eshell-buffer-name) + (pop-to-buffer-same-window eshell-buffer-name) (eshell)) (goto-char (point-max)) (eshell-kill-input) diff --git a/lisp/org/org-eww.el b/lisp/org/org-eww.el new file mode 100644 index 0000000000..7bc248d4df --- /dev/null +++ b/lisp/org/org-eww.el @@ -0,0 +1,175 @@ +;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*- + +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. + +;; Author: Marco Wahl a +;; Keywords: link, eww +;; Homepage: http://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; This program 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. + +;; This program 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: + +;; When this module is active `org-store-link' (often on key C-c l) in +;; a eww buffer stores a link to the current url of the eww buffer. + +;; In an eww buffer function `org-eww-copy-for-org-mode' kills either +;; a region or the whole buffer if no region is set and transforms the +;; text on the fly so that it can be pasted into an Org buffer with +;; hot links. + +;; C-c C-x C-w (and also C-c C-x M-w) trigger +;; `org-eww-copy-for-org-mode'. + +;; Hint: A lot of code of this module comes from module org-w3m which +;; has been written by Andy Steward based on the idea of Richard +;; Riley. Thanks! + +;; Potential: Since the code for w3m and eww is so similar one could +;; try to refactor. + + +;;; Code: +(require 'org) +(require 'cl-lib) + +(defvar eww-current-title) +(defvar eww-current-url) +(defvar eww-data) +(defvar eww-mode-map) + +(declare-function eww-current-url "eww") + + +;; Store Org-link in eww-mode buffer +(org-link-set-parameters "eww" :follow #'eww :store #'org-eww-store-link) +(defun org-eww-store-link () + "Store a link to the url of a Eww buffer." + (when (eq major-mode 'eww-mode) + (org-store-link-props + :type "eww" + :link (if (< emacs-major-version 25) + eww-current-url + (eww-current-url)) + :url (url-view-url t) + :description (if (< emacs-major-version 25) + (or eww-current-title eww-current-url) + (or (plist-get eww-data :title) + (eww-current-url)))))) + + +;; Some auxiliary functions concerning links in eww buffers +(defun org-eww-goto-next-url-property-change () + "Move to the start of next link if exists. +Otherwise point is not moved. Return point." + (goto-char + (or (next-single-property-change (point) 'shr-url) + (point)))) + +(defun org-eww-has-further-url-property-change-p () + "Non-nil if there is a next url property change." + (save-excursion + (not (eq (point) (org-eww-goto-next-url-property-change))))) + +(defun org-eww-url-below-point () + "Return the url below point if there is an url; otherwise, return nil." + (get-text-property (point) 'shr-url)) + + +(defun org-eww-copy-for-org-mode () + "Copy current buffer content or active region with `org-mode' style links. +This will encode `link-title' and `link-location' with +`org-make-link-string', and insert the transformed test into the kill ring, +so that it can be yanked into an Org mode buffer with links working correctly. + +Further lines starting with a star get quoted with a comma to keep +the structure of the Org file." + (interactive) + (let* ((regionp (org-region-active-p)) + (transform-start (point-min)) + (transform-end (point-max)) + return-content + link-location link-title + temp-position out-bound) + (when regionp + (setq transform-start (region-beginning)) + (setq transform-end (region-end)) + ;; Deactivate mark if current mark is activate. + (when (fboundp 'deactivate-mark) (deactivate-mark))) + (message "Transforming links...") + (save-excursion + (goto-char transform-start) + (while (and (not out-bound) ; still inside region to copy + (org-eww-has-further-url-property-change-p)) ; there is a next link + ;; Store current point before jump next anchor. + (setq temp-position (point)) + ;; Move to next anchor when current point is not at anchor. + (or (org-eww-url-below-point) + (org-eww-goto-next-url-property-change)) + (cl-assert + (org-eww-url-below-point) t + "program logic error: point must have an url below but it hasn't") + (if (<= (point) transform-end) ; if point is inside transform bound + (progn + ;; Get content between two links. + (when (< temp-position (point)) + (setq return-content (concat return-content + (buffer-substring + temp-position (point))))) + ;; Get link location at current point. + (setq link-location (org-eww-url-below-point)) + ;; Get link title at current point. + (setq link-title + (buffer-substring + (point) + (org-eww-goto-next-url-property-change))) + ;; concat `org-mode' style url to `return-content'. + (setq return-content + (concat return-content + (if (stringp link-location) + ;; hint: link-location is different for form-elements. + (org-make-link-string link-location link-title) + link-title)))) + (goto-char temp-position) ; reset point before jump next anchor + (setq out-bound t) ; for break out `while' loop + )) + ;; Add the rest until end of the region to be copied. + (when (< (point) transform-end) + (setq return-content + (concat return-content + (buffer-substring (point) transform-end)))) + ;; Quote lines starting with *. + (org-kill-new (replace-regexp-in-string "^\\*" ",*" return-content)) + (message "Transforming links...done, use C-y to insert text into Org mode file")))) + + +;; Additional keys for eww-mode + +(defun org-eww-extend-eww-keymap () + (define-key eww-mode-map "\C-c\C-x\M-w" 'org-eww-copy-for-org-mode) + (define-key eww-mode-map "\C-c\C-x\C-w" 'org-eww-copy-for-org-mode)) + +(when (and (boundp 'eww-mode-map) + (keymapp eww-mode-map)) ; eww is already up. + (org-eww-extend-eww-keymap)) + +(add-hook 'eww-mode-hook #'org-eww-extend-eww-keymap) + + +(provide 'org-eww) + +;;; org-eww.el ends here diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index c340aca73a..cd43d37178 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -1,4 +1,4 @@ -;;; org-faces.el --- Face definitions for Org-mode. +;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -28,32 +28,12 @@ ;;; Code: -(require 'org-macs) -(require 'org-compat) - -(defun org-copy-face (old-face new-face docstring &rest attributes) - (unless (facep new-face) - (if (fboundp 'set-face-attribute) - (progn - (make-face new-face) - (set-face-attribute new-face nil :inherit old-face) - (apply 'set-face-attribute new-face nil attributes) - (set-face-doc-string new-face docstring)) - (copy-face old-face new-face) - (if (fboundp 'set-face-doc-string) - (set-face-doc-string new-face docstring))))) -(put 'org-copy-face 'lisp-indent-function 2) - -(when (featurep 'xemacs) - (put 'mode-line 'face-alias 'modeline)) - (defgroup org-faces nil - "Faces in Org-mode." + "Faces in Org mode." :tag "Org Faces" :group 'org-appearance) -(defface org-default - (org-compatible-face 'default nil) +(defface org-default '((t :inherit default)) "Face used for default text." :group 'org-faces) @@ -65,99 +45,49 @@ The foreground color of this face should be equal to the background color of the frame." :group 'org-faces) -(defface org-level-1 ;; originally copied from font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-level-1 '((t :inherit outline-1)) "Face used for level 1 headlines." :group 'org-faces) -(defface org-level-2 ;; originally copied from font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) +(defface org-level-2 '((t :inherit outline-2)) "Face used for level 2 headlines." :group 'org-faces) -(defface org-level-3 ;; originally copied from font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) +(defface org-level-3 '((t :inherit outline-3)) "Face used for level 3 headlines." :group 'org-faces) -(defface org-level-4 ;; originally copied from font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) +(defface org-level-4 '((t :inherit outline-4)) "Face used for level 4 headlines." :group 'org-faces) -(defface org-level-5 ;; originally copied from font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) +(defface org-level-5 '((t :inherit outline-5)) "Face used for level 5 headlines." :group 'org-faces) -(defface org-level-6 ;; originally copied from font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) +(defface org-level-6 '((t :inherit outline-6)) "Face used for level 6 headlines." :group 'org-faces) -(defface org-level-7 ;; originally copied from font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) +(defface org-level-7 '((t :inherit outline-7)) "Face used for level 7 headlines." :group 'org-faces) -(defface org-level-8 ;; originally copied from font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) +(defface org-level-8 '((t :inherit outline-8)) "Face used for level 8 headlines." :group 'org-faces) -(defface org-special-keyword ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) +(defface org-special-keyword '((t :inherit font-lock-keyword-face)) "Face used for special keywords." :group 'org-faces) -(defface org-drawer ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-drawer ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t))) "Face used for drawers." :group 'org-faces) @@ -166,18 +96,17 @@ color of the frame." :group 'org-faces) (defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" - :weight normal :slant normal :strike-through nil - :underline nil)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" + :weight normal :slant normal :strike-through nil + :underline nil)) + (t (:inverse-video t))) "Face for column display of entry properties. This is actually only part of the face definition for the text in column view. The following faces apply, with this priority. @@ -198,59 +127,33 @@ character (this might for example be the a TODO keyword) might still shine through in some properties. So when your column view looks funny, with \"random\" colors, weight, strike-through, try to explicitly set the properties in the `org-column' face. For example, set -:underline to nil, or the :slant to `normal'. - -Under XEmacs, the rules are simpler, because the XEmacs version of -column view defines special faces for each outline level. See the file -`org-colview-xemacs.el' in Org's contrib/ directory for details." +:underline to nil, or the :slant to `normal'." :group 'org-faces) (defface org-column-title - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :underline t :weight bold)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :underline t :weight bold)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" :underline t :weight bold)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :underline t :weight bold)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :underline t :weight bold)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" :underline t :weight bold)) + (t (:inverse-video t))) "Face for column display of entry properties." :group 'org-faces) -(defface org-agenda-column-dateline - (org-compatible-face 'org-column - '((t nil))) +(defface org-agenda-column-dateline '((t :inherit org-column)) "Face used in agenda column view for datelines with summaries." :group 'org-faces) -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) +(defface org-warning '((t :inherit font-lock-warning-face)) "Face for deadlines and TODO keywords." :group 'org-faces) -(defface org-archived ; similar to shadow - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-archived '((t :inherit shadow)) "Face for headline with the ARCHIVE tag." :group 'org-faces) -(defface org-link - (org-compatible-face 'link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t)))) +(defface org-link '((t :inherit link)) "Face for links." :group 'org-faces) @@ -283,12 +186,11 @@ column view defines special faces for each outline level. See the file :group 'org-faces) (defface org-date-selected - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) - (t (:inverse-video t)))) + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) + (t (:inverse-video t))) "Face for highlighting the calendar day when using `org-read-date'. Using a bold face here might cause discrepancies while displaying the calendar." @@ -301,43 +203,38 @@ calendar." "Face for diary-like sexp date specifications." :group 'org-faces) -(defface org-tag - '((t (:bold t))) +(defface org-tag '((t (:bold t))) "Default face for tags. Note that the variable `org-tag-faces' can be used to overrule this face for specific tags." :group 'org-faces) -(defface org-list-dt - '((t (:bold t))) +(defface org-list-dt '((t (:bold t))) "Default face for definition terms in lists." :group 'org-faces) -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) +(defface org-todo ;Copied from `font-lock-warning-face' + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:inverse-video t :bold t))) "Face for TODO keywords." :group 'org-faces) -(defface org-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) +(defface org-done ;Copied from `font-lock-type-face' + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t))) "Face used for todo keywords that indicate DONE items." :group 'org-faces) -(defface org-agenda-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold nil)))) +(defface org-agenda-done ;Copied from `font-lock-type-face' + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold nil))) "Face used in agenda, to indicate lines switched to DONE. This face is used to de-emphasize items that where brightly colored in the agenda because they were things to do, or overdue. The DONE state itself @@ -346,11 +243,10 @@ is of course immediately visible, but for example a passed deadline is of the frame, for example." :group 'org-faces) -(defface org-headline-done ;; originally copied from font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) +(defface org-headline-done ;Copied from `font-lock-string-face' + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8) (background light)) (:bold nil))) "Face used to indicate that a headline is DONE. This face is only used if `org-fontify-done-headline' is set. If applies to the part of the headline after the DONE keyword." @@ -388,11 +284,7 @@ determines if it is a foreground or a background color." (string :tag "Color") (sexp :tag "Face"))))) -(defface org-priority ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) +(defface org-priority '((t :inherit font-lock-keyword-face)) "Face used for priority cookies." :group 'org-faces) @@ -421,18 +313,17 @@ determines if it is a foreground or a background color." (setq org-tags-special-faces-re (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) -(defface org-checkbox - (org-compatible-face 'bold - '((t (:bold t)))) +(defface org-checkbox '((t :inherit bold)) "Face for checkboxes." :group 'org-faces) +(defface org-checkbox-statistics-todo '((t (:inherit org-todo))) + "Face used for unfinished checkbox statistics." + :group 'org-faces) -(org-copy-face 'org-todo 'org-checkbox-statistics-todo - "Face used for unfinished checkbox statistics.") - -(org-copy-face 'org-done 'org-checkbox-statistics-done - "Face used for finished checkbox statistics.") +(defface org-checkbox-statistics-done '((t (:inherit org-done))) + "Face used for finished checkbox statistics." + :group 'org-faces) (defcustom org-tag-faces nil "Faces for specific tags. @@ -454,44 +345,32 @@ changes." (string :tag "Foreground color") (sexp :tag "Face"))))) -(defface org-table ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) +(defface org-table ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8) (background light)) (:foreground "blue")) + (((class color) (min-colors 8) (background dark)))) "Face used for tables." :group 'org-faces) (defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red")) + (t (:bold t :italic t))) "Face for formulas." :group 'org-faces) -(defface org-code - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-code '((t :inherit shadow)) "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") -(defface org-meta-line - (org-compatible-face 'font-lock-comment-face nil) - "Face for meta lines startin with \"#+\"." +(defface org-meta-line '((t :inherit font-lock-comment-face)) + "Face for meta lines starting with \"#+\"." :group 'org-faces :version "22.1") @@ -510,60 +389,37 @@ changes." follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." :group 'org-faces) -(defface org-document-info-keyword - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) +(defface org-document-info-keyword '((t :inherit shadow)) "Face for #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." :group 'org-faces) -(defface org-block - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50")) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70")) - (((class color) (min-colors 8) (background light)) - (:foreground "green")) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow")))) - "Face text in #+begin ... #+end blocks." +(defface org-block '((t :inherit shadow)) + "Face text in #+begin ... #+end blocks. +For source-blocks `org-src-block-faces' takes precedence. +See also `org-fontify-quote-and-verse-blocks'." :group 'org-faces - :version "22.1") + :version "26.1") -(defface org-block-background '((t ())) - "Face used for the source block background.") - -(org-copy-face 'org-meta-line 'org-block-begin-line - "Face used for the line delimiting the begin of source blocks.") - -(org-copy-face 'org-meta-line 'org-block-end-line - "Face used for the line delimiting the end of source blocks.") - -(defface org-verbatim - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." +(defface org-block-begin-line '((t (:inherit org-meta-line))) + "Face used for the line delimiting the begin of source blocks." + :group 'org-faces) + +(defface org-block-end-line '((t (:inherit org-block-begin-line))) + "Face used for the line delimiting the end of source blocks." + :group 'org-faces) + +(defface org-verbatim '((t (:inherit shadow))) + "Face for fixed-with text like code snippets" :group 'org-faces :version "22.1") -(org-copy-face 'org-block 'org-quote - "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") -(org-copy-face 'org-block 'org-verse - "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") +(defface org-quote '((t (:inherit org-block))) + "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks." + :group 'org-faces) + +(defface org-verse '((t (:inherit org-block))) + "Face for #+BEGIN_VERSE ... #+END_VERSE blocks." + :group 'org-faces) (defcustom org-fontify-quote-and-verse-blocks nil "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. @@ -573,64 +429,64 @@ content of these blocks will still be treated as Org syntax." :version "24.1" :type 'boolean) -(defface org-clock-overlay ;; copied from secondary-selection - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) - (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) - (:background "SkyBlue4")) - (((class color) (min-colors 16) (background light)) - (:background "yellow")) - (((class color) (min-colors 16) (background dark)) - (:background "SkyBlue4")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) +(defface org-clock-overlay ;Copied from `secondary-selection' + '((((class color) (min-colors 88) (background light)) + (:background "LightGray" :foreground "black")) + (((class color) (min-colors 88) (background dark)) + (:background "SkyBlue4" :foreground "white")) + (((class color) (min-colors 16) (background light)) + (:background "gray" :foreground "black")) + (((class color) (min-colors 16) (background dark)) + (:background "SkyBlue4" :foreground "white")) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black")) + (t (:inverse-video t))) "Basic face for displaying the secondary selection." :group 'org-faces) -(defface org-agenda-structure ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) +(defface org-agenda-structure ;Copied from `font-lock-function-name-face' + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t))) "Face used in agenda for captions and dates." :group 'org-faces) -(org-copy-face 'org-agenda-structure 'org-agenda-date - "Face used in agenda for normal days.") +(defface org-agenda-date '((t (:inherit org-agenda-structure))) + "Face used in agenda for normal days." + :group 'org-faces) -(org-copy-face 'org-agenda-date 'org-agenda-date-today +(defface org-agenda-date-today + '((t (:inherit org-agenda-date :weight bold :italic t))) "Face used in agenda for today." - :weight 'bold :italic 't) + :group 'org-faces) -(org-copy-face 'secondary-selection 'org-agenda-clocking - "Face marking the current clock item in the agenda.") +(defface org-agenda-clocking '((t (:inherit secondary-selection))) + "Face marking the current clock item in the agenda." + :group 'org-faces) -(org-copy-face 'org-agenda-date 'org-agenda-date-weekend +(defface org-agenda-date-weekend '((t (:inherit org-agenda-date :weight bold))) "Face used in agenda for weekend days. -See the variable `org-agenda-weekend-days' for a definition of which days -belong to the weekend." - :weight 'bold) + +See the variable `org-agenda-weekend-days' for a definition of +which days belong to the weekend." + :group 'org-faces) (defface org-scheduled - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t))) "Face for items scheduled for a certain day." :group 'org-faces) (defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t))) "Face for items scheduled for a certain day." :group 'org-faces) @@ -641,22 +497,20 @@ belong to the weekend." :group 'org-faces) (defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t))) "Face for items scheduled previously, and not yet done." :group 'org-faces) (defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t))) "Face for items scheduled previously, and not yet done." :group 'org-faces) @@ -666,7 +520,7 @@ belong to the weekend." (0.0 . default)) "Faces for showing deadlines in the agenda. This is a list of cons cells. The cdr of each cell is a face to be used, -and it can also just be like (:foreground \"yellow\"). +and it can also just be like \\='(:foreground \"yellow\"). Each car is a fraction of the head-warning time that must have passed for this the face in the cdr to be used for display. The numbers must be given in descending order. The head-warning time is normally taken @@ -686,65 +540,61 @@ month and 365.24 days for a year)." (sexp :tag "Face")))) (defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) + '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) + (t (:inverse-video t))) "Face for showing the agenda restriction lock." :group 'org-faces) -(defface org-agenda-filter-tags - (org-compatible-face 'mode-line nil) +(defface org-agenda-filter-tags '((t :inherit mode-line)) "Face for tag(s) in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-agenda-filter-regexp - (org-compatible-face 'mode-line nil) +(defface org-agenda-filter-regexp '((t :inherit mode-line)) "Face for regexp(s) in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-agenda-filter-category - (org-compatible-face 'mode-line nil) - "Face for categories(s) in the mode-line when filtering the agenda." +(defface org-agenda-filter-category '((t :inherit mode-line)) + "Face for categories in the mode-line when filtering the agenda." :group 'org-faces) -(defface org-time-grid ;; originally copied from font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) +(defface org-agenda-filter-effort '((t :inherit mode-line)) + "Face for effort in the mode-line when filtering the agenda." + :group 'org-faces) + +(defface org-time-grid ;Copied from `font-lock-variable-name-face' + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light))) "Face used for time grids." :group 'org-faces) -(org-copy-face 'org-time-grid 'org-agenda-current-time - "Face used to show the current time in the time grid.") +(defface org-agenda-current-time '((t (:inherit org-time-grid))) + "Face used to show the current time in the time grid." + :group 'org-faces) -(defface org-agenda-diary - (org-compatible-face 'default nil) +(defface org-agenda-diary '((t :inherit default)) "Face used for agenda entries that come from the Emacs diary." :group 'org-faces) -(defface org-agenda-calendar-event - (org-compatible-face 'default nil) +(defface org-agenda-calendar-event '((t :inherit default)) "Face used to show events and appointments in the agenda." :group 'org-faces) -(defface org-agenda-calendar-sexp - (org-compatible-face 'default nil) +(defface org-agenda-calendar-sexp '((t :inherit default)) "Face used to show events computed from a S-expression." :group 'org-faces) (defconst org-level-faces '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) + org-level-5 org-level-6 org-level-7 org-level-8)) (defcustom org-n-level-faces (length org-level-faces) "The number of different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. +Org mode defines 8 different headline faces, so this can be at most 8. If it is less than 8, the level-1 face gets re-used for level N+1 etc." :type 'integer :group 'org-faces) @@ -777,25 +627,26 @@ level org-n-level-faces" :version "24.4" :package-version '(Org . "8.0")) -(defface org-macro - (org-compatible-face 'org-latex-and-related nil) +(defface org-macro '((t :inherit org-latex-and-related)) "Face for macros." :group 'org-faces :version "24.4" :package-version '(Org . "8.0")) -(defface org-tag-group - (org-compatible-face 'org-tag nil) +(defface org-tag-group '((t :inherit org-tag)) "Face for group tags." :group 'org-faces :version "24.4" :package-version '(Org . "8.0")) -(org-copy-face 'mode-line 'org-mode-line-clock - "Face used for clock display in mode line.") -(org-copy-face 'mode-line 'org-mode-line-clock-overrun +(defface org-mode-line-clock '((t (:inherit mode-line))) + "Face used for clock display in mode line." + :group 'org-faces) + +(defface org-mode-line-clock-overrun + '((t (:inherit mode-line :background "red"))) "Face used for clock display for overrun tasks in mode line." - :background "red") + :group 'org-faces) (provide 'org-faces) diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index cfb4b4f7e3..6ebe5ecf5d 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -1,4 +1,4 @@ -;;; org-feed.el --- Add RSS feed items to Org files +;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; @@ -24,11 +24,11 @@ ;; ;;; Commentary: ;; -;; This module allows entries to be created and changed in an Org-mode -;; file triggered by items in an RSS feed. The basic functionality is -;; geared toward simply adding new items found in a feed as outline nodes -;; to an Org file. Using hooks, arbitrary actions can be triggered for -;; new or changed items. +;; This module allows entries to be created and changed in an Org mode +;; file triggered by items in an RSS feed. The basic functionality +;; is geared toward simply adding new items found in a feed as +;; outline nodes to an Org file. Using hooks, arbitrary actions can +;; be triggered for new or changed items. ;; ;; Selecting feeds and target locations ;; ------------------------------------ @@ -77,10 +77,8 @@ ;; org-feed.el needs to keep track of which feed items have been handled ;; before, so that they will not be handled again. For this, org-feed.el ;; stores information in a special drawer, FEEDSTATUS, under the heading -;; that received the input of the feed. You should add FEEDSTATUS -;; to your list of drawers in the files that receive feed input: +;; that received the input of the feed. ;; -;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS ;; ;; Acknowledgments ;; --------------- @@ -102,8 +100,8 @@ (declare-function xml-substitute-special "xml" (string)) (declare-function org-capture-escaped-% "org-capture" ()) +(declare-function org-capture-expand-embedded-elisp "org-capture" (&optional mark)) (declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) -(declare-function org-capture-expand-embedded-elisp "org-capture" ()) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." @@ -117,7 +115,9 @@ to create inbox items in Org. Each entry is a list with the following items: name a custom name for this feed URL the Feed URL -file the target Org file where entries should be listed +file the target Org file where entries should be listed, when + nil the target becomes the current buffer (may be an + indirect buffer) each time the feed update is invoked headline the headline under which entries should be listed Additional arguments can be given using keyword-value pairs. Many of these @@ -216,10 +216,7 @@ Here are the keyword-value pair allows in `org-feed-alist'. (defcustom org-feed-drawer "FEEDSTATUS" "The name of the drawer for feed status information. Each feed may also specify its own drawer name using the `:drawer' -parameter in `org-feed-alist'. -Note that in order to make these drawers behave like drawers, they must -be added to the variable `org-drawers' or configured with a #+DRAWERS -line." +parameter in `org-feed-alist'." :group 'org-feed :type '(string :tag "Drawer Name")) @@ -300,7 +297,8 @@ it can be a list structured like an entry in `org-feed-alist'." (catch 'exit (let ((name (car feed)) (url (nth 1 feed)) - (file (nth 2 feed)) + (file (or (nth 2 feed) (buffer-file-name (or (buffer-base-buffer) + (current-buffer))))) (headline (nth 3 feed)) (filter (nth 1 (memq :filter feed))) (formatter (nth 1 (memq :formatter feed))) @@ -315,7 +313,7 @@ it can be a list structured like an entry in `org-feed-alist'." (parse-entry (or (nth 1 (memq :parse-entry feed)) 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted - entries old-status status new changed guid-alist e guid olds) + entries old-status status new changed guid-alist guid olds) (setq feed-buffer (org-feed-get-feed url)) (unless (and feed-buffer (bufferp (get-buffer feed-buffer))) (error "Cannot get feed %s" name)) @@ -407,8 +405,8 @@ it can be a list structured like an entry in `org-feed-alist'." ;; Normalize the visibility of the inbox tree (goto-char inbox-pos) - (hide-subtree) - (show-children) + (outline-hide-subtree) + (org-show-children) (org-cycle-hide-drawers 'children) ;; Hooks and messages @@ -442,7 +440,7 @@ it can be a list structured like an entry in `org-feed-alist'." (if (stringp feed) (setq feed (assoc feed org-feed-alist))) (unless feed (error "No such feed in `org-feed-alist")) - (org-pop-to-buffer-same-window + (pop-to-buffer-same-window (org-feed-update feed 'retrieve-only)) (goto-char (point-min))) @@ -477,8 +475,7 @@ This will find DRAWER and extract the alist." "Write the feed STATUS to DRAWER in entry at POS." (save-excursion (goto-char pos) - (let ((end (save-excursion (org-end-of-subtree t t))) - guid) + (let ((end (save-excursion (org-end-of-subtree t t)))) (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n") end t) (progn @@ -514,66 +511,77 @@ ENTRY is a property list. This function adds a `:formatted-for-org' property and returns the full property list. If that property is already present, nothing changes." (require 'org-capture) - (if formatter - (funcall formatter entry) - (let (dlines time escape name tmp - v-h v-t v-T v-u v-U v-a) - (setq dlines (org-split-string (or (plist-get entry :description) "???") - "\n") - v-h (or (plist-get entry :title) (car dlines) "???") - time (or (if (plist-get entry :pubDate) - (org-read-date t t (plist-get entry :pubDate))) - (current-time)) - v-t (format-time-string (org-time-stamp-format nil nil) time) - v-T (format-time-string (org-time-stamp-format t nil) time) - v-u (format-time-string (org-time-stamp-format nil t) time) - v-U (format-time-string (org-time-stamp-format t t) time) - v-a (if (setq tmp (or (and (plist-get entry :guid-permalink) - (plist-get entry :guid)) - (plist-get entry :link))) - (concat "[[" tmp "]]\n") - "")) + (if formatter (funcall formatter entry) + (let* ((dlines + (org-split-string (or (plist-get entry :description) "???") + "\n")) + (time (or (if (plist-get entry :pubDate) + (org-read-date t t (plist-get entry :pubDate))) + (current-time))) + (v-h (or (plist-get entry :title) (car dlines) "???")) + (v-t (format-time-string (org-time-stamp-format nil nil) time)) + (v-T (format-time-string (org-time-stamp-format t nil) time)) + (v-u (format-time-string (org-time-stamp-format nil t) time)) + (v-U (format-time-string (org-time-stamp-format t t) time)) + (v-a (let ((tmp (or (and (plist-get entry :guid-permalink) + (plist-get entry :guid)) + (plist-get entry :link)))) + (if tmp (format "[[%s]]\n" tmp ) "")))) (with-temp-buffer - (insert template) - - ;; Simple %-escapes - ;; before embedded elisp to support simple %-escapes as - ;; arguments for embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (setq name (match-string 1) - escape (org-capture-inside-embedded-elisp-p)) - (cond - ((member name '("h" "t" "T" "u" "U" "a")) - (setq tmp (symbol-value (intern (concat "v-" name))))) - ((setq tmp (plist-get entry (intern (concat ":" name)))) - (save-excursion - (save-match-data - (beginning-of-line 1) - (when (looking-at - (concat "^\\([ \t]*\\)%" name "[ \t]*$")) - (setq tmp (org-feed-make-indented-block - tmp (org-get-indentation)))))))) - (when tmp - ;; escape string delimiters `"' when inside %() embedded lisp - (when escape - (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) - (replace-match tmp t t)))) - - ;; %() embedded elisp - (org-capture-expand-embedded-elisp) - - (decode-coding-string - (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) + (insert template) + (goto-char (point-min)) + + ;; Mark %() embedded elisp for later evaluation. + (org-capture-expand-embedded-elisp 'mark) + + ;; Simple %-escapes. `org-capture-escaped-%' may modify + ;; buffer and cripple match-data. Use markers instead. + (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) + (let ((key (match-string 1)) + (beg (copy-marker (match-beginning 0))) + (end (copy-marker (match-end 0)))) + (unless (org-capture-escaped-%) + (delete-region beg end) + (set-marker beg nil) + (set-marker end nil) + (let ((replacement + (pcase key + ("h" v-h) + ("t" v-t) + ("T" v-T) + ("u" v-u) + ("U" v-U) + ("a" v-a) + (name + (let ((v (plist-get entry (intern (concat ":" name))))) + (save-excursion + (save-match-data + (beginning-of-line) + (if (looking-at + (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (org-feed-make-indented-block + v (org-get-indentation)) + v)))))))) + (when replacement + (insert + ;; Escape string delimiters within embedded lisp. + (if (org-capture-inside-embedded-elisp-p) + (replace-regexp-in-string "\"" "\\\\\"" replacement) + replacement))))))) + + ;; %() embedded elisp + (org-capture-expand-embedded-elisp) + + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." (if (not (string-match "\n" s)) s (mapconcat 'identity - (org-split-string s "\n") - (concat "\n" (make-string n ?\ ))))) + (org-split-string s "\n") + (concat "\n" (make-string n ?\ ))))) (defun org-feed-skip-http-headers (buffer) "Remove HTTP headers from BUFFER, and return it. @@ -605,6 +613,7 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." + (require 'xml) (let ((case-fold-search t) entries beg end item guid entry) (with-current-buffer buffer @@ -616,7 +625,7 @@ containing the properties `:guid' and `:item-full-text'." (match-beginning 0))) (setq item (buffer-substring beg end) guid (if (string-match ".*?>\\(.*?\\)" item) - (org-match-string-no-properties 1 item))) + (xml-substitute-special (match-string-no-properties 1 item)))) (setq entry (list :guid guid :item-full-text item)) (push entry entries) (widen) diff --git a/lisp/org/org-footnote.el b/lisp/org/org-footnote.el index 553f124042..af03fbfe7b 100644 --- a/lisp/org/org-footnote.el +++ b/lisp/org/org-footnote.el @@ -1,4 +1,4 @@ -;;; org-footnote.el --- Footnote support in Org and elsewhere +;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; @@ -24,72 +24,68 @@ ;; ;;; Commentary: -;; This file contains the code dealing with footnotes in Org-mode. -;; The code can also be used in arbitrary text modes to provide -;; footnotes. Compared to Steven L Baur's footnote.el it provides -;; better support for resuming editing. It is less configurable than -;; Steve's code, though. +;; This file contains the code dealing with footnotes in Org mode. ;;; Code: -(eval-when-compile - (require 'cl)) +;;;; Declarations + +(require 'cl-lib) (require 'org-macs) (require 'org-compat) -(declare-function message-point-in-header-p "message" ()) +(declare-function org-at-comment-p "org" ()) +(declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-edit-footnote-reference "org-src" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) (declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) (declare-function org-fill-paragraph "org" (&optional justify)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-id-uuid "org-id" ()) (declare-function org-in-block-p "org" (names)) -(declare-function org-in-commented-line "org" ()) -(declare-function org-in-indented-comment-line "org" ()) (declare-function org-in-regexp "org" (re &optional nlines visually)) (declare-function org-in-verbatim-emphasis "org" ()) (declare-function org-inside-LaTeX-fragment-p "org" ()) (declare-function org-inside-latex-macro-p "org" ()) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function org-show-context "org" (&optional key)) -(declare-function org-trim "org" (s)) -(declare-function org-skip-whitespace "org" ()) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function outline-next-heading "outline") -(declare-function org-skip-whitespace "org" ()) -(defvar org-outline-regexp-bol) ; defined in org.el -(defvar org-odd-levels-only) ; defined in org.el +(defvar electric-indent-mode) +(defvar org-blank-before-new-entry) ; defined in org.el (defvar org-bracket-link-regexp) ; defined in org.el -(defvar message-cite-prefix-regexp) ; defined in message.el -(defvar message-signature-separator) ; defined in message.el +(defvar org-complex-heading-regexp) ; defined in org.el +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-outline-regexp) ; defined in org.el +(defvar org-outline-regexp-bol) ; defined in org.el + + +;;;; Constants (defconst org-footnote-re - ;; Only [1]-like footnotes are closed in this regexp, as footnotes - ;; from other types might contain square brackets (i.e. links) in - ;; their definition. - ;; - ;; `org-re' is used for regexp compatibility with XEmacs. - (concat "\\[\\(?:" - ;; Match inline footnotes. - (org-re "fn:\\([-_[:word:]]+\\)?:\\|") - ;; Match other footnotes. - "\\(?:\\([0-9]+\\)\\]\\)\\|" - (org-re "\\(fn:[-_[:word:]]+\\)") - "\\)") - "Regular expression for matching footnotes.") - -(defconst org-footnote-definition-re - (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") - "Regular expression matching the definition of a footnote.") - -(defconst org-footnote-forbidden-blocks - '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") + "\\[fn:\\(?:\\(?1:[-_[:word:]]+\\)?\\(:\\)\\|\\(?1:[-_[:word:]]+\\)\\]\\)" + "Regular expression for matching footnotes. +Match group 1 contains footnote's label. It is nil for anonymous +footnotes. Match group 2 is non-nil only when footnote is +inline, i.e., it contains its own definition.") + +(defconst org-footnote-definition-re "^\\[fn:\\([-_[:word:]]+\\)\\]" + "Regular expression matching the definition of a footnote. +Match group 1 contains definition's label.") + +(defconst org-footnote-forbidden-blocks '("comment" "example" "export" "src") "Names of blocks where footnotes are not allowed.") + +;;;; Customization + (defgroup org-footnote nil - "Footnotes in Org-mode." + "Footnotes in Org mode." :tag "Org Footnote" :group 'org) @@ -106,25 +102,21 @@ the notes. However, by hand you may place definitions *anywhere*. If this is a string, during export, all subtrees starting with -this heading will be ignored." - :group 'org-footnote - :type '(choice - (string :tag "Collect footnotes under heading") - (const :tag "Define footnotes locally" nil))) +this heading will be ignored. -(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:" - "Tag marking the beginning of footnote section. -The Org footnote engine can be used in arbitrary text files as well -as in Org-mode. Outside Org mode, new footnotes are always placed at -the end of the file. When you normalize the notes, any line containing -only this tag will be removed, a new one will be inserted at the end -of the file, followed by the collected and normalized footnotes. +If you don't use the customize interface to change this variable, +you will need to run the following command after the change: -If you don't want any tag in such buffers, set this variable to nil." + `\\[universal-argument] \\[org-element-cache-reset]'" :group 'org-footnote + :initialize 'custom-initialize-default + :set (lambda (var val) + (set var val) + (when (fboundp 'org-element-cache-reset) + (org-element-cache-reset 'all))) :type '(choice - (string :tag "Collect footnotes under tag") - (const :tag "Don't use a tag" nil))) + (string :tag "Collect footnotes under heading") + (const :tag "Define footnotes locally" nil))) (defcustom org-footnote-define-inline nil "Non-nil means define footnotes inline, at reference location. @@ -143,15 +135,13 @@ t Create unique labels of the form [fn:1], [fn:2], etc. confirm Like t, but let the user edit the created value. The label can be removed from the minibuffer to create an anonymous footnote. -random Automatically generate a unique, random label. -plain Automatically create plain number labels like [1]." +random Automatically generate a unique, random label." :group 'org-footnote :type '(choice (const :tag "Prompt for label" nil) (const :tag "Create automatic [fn:N]" t) (const :tag "Offer automatic [fn:N] for editing" confirm) - (const :tag "Create a random label" random) - (const :tag "Create automatic [N]" plain))) + (const :tag "Create a random label" random))) (defcustom org-footnote-auto-adjust nil "Non-nil means automatically adjust footnotes after insert/delete. @@ -179,23 +169,19 @@ extracted will be filled again." :group 'org-footnote :type 'boolean) + +;;;; Predicates + (defun org-footnote-in-valid-context-p () "Is point in a context where footnotes are allowed?" (save-match-data - (not (or (org-in-commented-line) - (org-in-indented-comment-line) + (not (or (org-at-comment-p) (org-inside-LaTeX-fragment-p) ;; Avoid literal example. (org-in-verbatim-emphasis) (save-excursion (beginning-of-line) (looking-at "[ \t]*:[ \t]+")) - ;; Avoid cited text and headers in message-mode. - (and (derived-mode-p 'message-mode) - (or (save-excursion - (beginning-of-line) - (looking-at message-cite-prefix-regexp)) - (message-point-in-header-p))) ;; Avoid forbidden blocks. (org-in-block-p org-footnote-forbidden-blocks))))) @@ -208,13 +194,9 @@ positions, and the definition, when inlined." (or (looking-at org-footnote-re) (org-in-regexp org-footnote-re) (save-excursion (re-search-backward org-footnote-re nil t))) - (/= (match-beginning 0) (point-at-bol))) + (/= (match-beginning 0) (line-beginning-position))) (let* ((beg (match-beginning 0)) - (label (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - ;; Anonymous footnotes don't have labels - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) + (label (match-string-no-properties 1)) ;; Inline footnotes don't end at (match-end 0) as ;; `org-footnote-re' stops just after the second colon. ;; Find the real ending with `scan-sexps', so Org doesn't @@ -222,7 +204,8 @@ positions, and the definition, when inlined." (end (ignore-errors (scan-sexps beg 1)))) ;; Point is really at a reference if it's located before true ;; ending of the footnote. - (when (and end (< (point) end) + (when (and end + (< (point) end) ;; Verify match isn't a part of a link. (not (save-excursion (goto-char beg) @@ -234,16 +217,17 @@ positions, and the definition, when inlined." (not (org-inside-latex-macro-p))) (list label beg end ;; Definition: ensure this is an inline footnote first. - (and (or (not label) (match-string 1)) - (org-trim (buffer-substring-no-properties - (match-end 0) (1- end))))))))) + (and (match-end 2) + (org-trim + (buffer-substring-no-properties + (match-end 0) (1- end))))))))) (defun org-footnote-at-definition-p () "Is point within a footnote definition? This matches only pure definitions like [1] or [fn:name] at the beginning of a line. It does not match references like -[fn:name:definition], where the footnote text is included and +\[fn:name:definition], where the footnote text is included and defined locally. The return value will be nil if not at a footnote definition, and @@ -259,26 +243,224 @@ otherwise." (concat org-outline-regexp-bol "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) (when (re-search-backward org-footnote-definition-re lim t) - (let ((label (org-match-string-no-properties 1)) + (let ((label (match-string-no-properties 1)) (beg (match-beginning 0)) (beg-def (match-end 0)) - ;; In message-mode, do not search after signature. - (end (let ((bound (and (derived-mode-p 'message-mode) - (save-excursion - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t))))) - (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) - (match-beginning 0) - (point))))) + (end (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") nil 'move)) + (match-beginning 0) + (point)))) (list label beg end (org-trim (buffer-substring-no-properties beg-def end))))))))) + +;;;; Internal functions + +(defun org-footnote--allow-reference-p () + "Non-nil when a footnote reference can be inserted at point." + ;; XXX: This is similar to `org-footnote-in-valid-context-p' but + ;; more accurate and usually faster, except in some corner cases. + ;; It may replace it after doing proper benchmarks as it would be + ;; used in fontification. + (unless (bolp) + (let* ((context (org-element-context)) + (type (org-element-type context))) + (cond + ;; No footnote reference in attributes. + ((let ((post (org-element-property :post-affiliated context))) + (and post (< (point) post))) + nil) + ;; Paragraphs and blank lines at top of document are fine. + ((memq type '(nil paragraph))) + ;; So are contents of verse blocks. + ((eq type 'verse-block) + (and (>= (point) (org-element-property :contents-begin context)) + (< (point) (org-element-property :contents-end context)))) + ;; In an headline or inlinetask, point must be either on the + ;; heading itself or on the blank lines below. + ((memq type '(headline inlinetask)) + (or (not (org-at-heading-p)) + (and (save-excursion + (beginning-of-line) + (and (let ((case-fold-search t)) + (not (looking-at-p "\\*+ END[ \t]*$"))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) + (match-beginning 4) + (>= (point) (match-beginning 4)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5)))))) + ;; White spaces after an object or blank lines after an element + ;; are OK. + ((>= (point) + (save-excursion (goto-char (org-element-property :end context)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class context) 'object) (point) + (1+ (line-beginning-position 2)))))) + ;; Other elements are invalid. + ((eq (org-element-class context) 'element) nil) + ;; Just before object is fine. + ((= (point) (org-element-property :begin context))) + ;; Within recursive object too, but not in a link. + ((eq type 'link) nil) + ((let ((cbeg (org-element-property :contents-begin context)) + (cend (org-element-property :contents-end context))) + (and cbeg (>= (point) cbeg) (<= (point) cend)))))))) + +(defun org-footnote--clear-footnote-section () + "Remove all footnote sections in buffer and create a new one. +New section is created at the end of the buffer, before any file +local variable definition. Leave point within the new section." + (when org-footnote-section + (goto-char (point-min)) + (let ((regexp + (format "^\\*+ +%s[ \t]*$" + (regexp-quote org-footnote-section)))) + (while (re-search-forward regexp nil t) + (delete-region + (match-beginning 0) + (progn (org-end-of-subtree t t) + (if (not (eobp)) (point) + (org-footnote--goto-local-insertion-point) + (skip-chars-forward " \t\n") + (if (eobp) (point) (line-beginning-position))))))) + (goto-char (point-max)) + (org-footnote--goto-local-insertion-point) + (when (and (cdr (assq 'heading org-blank-before-new-entry)) + (zerop (save-excursion (org-back-over-empty-lines)))) + (insert "\n")) + (insert "* " org-footnote-section "\n"))) + +(defun org-footnote--set-label (label) + "Set label of footnote at point to string LABEL. +Assume point is at the beginning of the reference or definition +to rename." + (forward-char 4) + (cond ((eq (char-after) ?:) (insert label)) + ((looking-at "\\([-_[:word:]]+\\)") (replace-match label nil nil nil 1)) + (t nil))) + +(defun org-footnote--collect-references (&optional anonymous) + "Collect all labelled footnote references in current buffer. + +Return an alist where associations follow the pattern + + (LABEL MARKER TOP-LEVEL SIZE) + +with + + LABEL the label of the of the definition, + MARKER a marker pointing to its beginning, + TOP-LEVEL a boolean, nil when the footnote is contained within + another one, + SIZE the length of the inline definition, in characters, + or nil for non-inline references. + +When optional ANONYMOUS is non-nil, also collect anonymous +references. In such cases, LABEL is nil. + +References are sorted according to a deep-reading order." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((regexp (if anonymous org-footnote-re "\\[fn:[-_[:word:]]+[]:]")) + references nested) + (save-excursion + (while (re-search-forward regexp nil t) + ;; Ignore definitions. + (unless (and (eq (char-before) ?\]) + (= (line-beginning-position) (match-beginning 0))) + ;; Ensure point is within the reference before parsing it. + (backward-char) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'footnote-reference) + (let* ((label (org-element-property :label object)) + (begin (org-element-property :begin object)) + (size + (and (eq (org-element-property :type object) 'inline) + (- (org-element-property :contents-end object) + (org-element-property :contents-begin object))))) + (let ((d (org-element-lineage object '(footnote-definition)))) + (push (list label (copy-marker begin) (not d) size) + references) + (when d + ;; Nested references are stored in alist NESTED. + ;; Associations there follow the pattern + ;; + ;; (DEFINITION-LABEL . REFERENCES) + (let* ((def-label (org-element-property :label d)) + (labels (assoc def-label nested))) + (if labels (push label (cdr labels)) + (push (list def-label label) nested))))))))))) + ;; Sort the list of references. Nested footnotes have priority + ;; over top-level ones. + (letrec ((ordered nil) + (add-reference + (lambda (ref allow-nested) + (when (or allow-nested (nth 2 ref)) + (push ref ordered) + (dolist (r (mapcar (lambda (l) (assoc l references)) + (reverse + (cdr (assoc (nth 0 ref) nested))))) + (funcall add-reference r t)))))) + (dolist (r (reverse references) (nreverse ordered)) + (funcall add-reference r nil)))))) + +(defun org-footnote--collect-definitions (&optional delete) + "Collect all footnote definitions in current buffer. + +Return an alist where associations follow the pattern + + (LABEL . DEFINITION) + +with LABEL and DEFINITION being, respectively, the label and the +definition of the footnote, as strings. + +When optional argument DELETE is non-nil, delete the definition +while collecting them." + (org-with-wide-buffer + (goto-char (point-min)) + (let (definitions seen) + (while (re-search-forward org-footnote-definition-re nil t) + (backward-char) + (let ((element (org-element-at-point))) + (let ((label (org-element-property :label element))) + (when (and (eq (org-element-type element) 'footnote-definition) + (not (member label seen))) + (push label seen) + (let* ((beg (progn + (goto-char (org-element-property :begin element)) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2)))) + (end (progn + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + (def (org-trim (buffer-substring-no-properties beg end)))) + (push (cons label def) definitions) + (when delete (delete-region beg end))))))) + definitions))) + +(defun org-footnote--goto-local-insertion-point () + "Find insertion point for footnote, just before next outline heading. +Assume insertion point is within currently accessible part of the buffer." + (org-with-limited-levels (outline-next-heading)) + ;; Skip file local variables. See `modify-file-local-variable'. + (when (eobp) + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*# +Local Variables:" + (max (- (point-max) 3000) (point-min)) + t))) + (skip-chars-backward " \t\n") + (forward-line) + (unless (bolp) (insert "\n"))) + + +;;;; Navigation + (defun org-footnote-get-next-reference (&optional label backward limit) "Return complete reference of the next footnote. @@ -289,7 +471,7 @@ the buffer position bounding the search. Return value is a list like those provided by `org-footnote-at-reference-p'. If no footnote is found, return nil." (save-excursion - (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re))) + (let* ((label-fmt (if label (format "\\[fn:%s[]:]" label) org-footnote-re))) (catch 'exit (while t (unless (funcall (if backward #'re-search-backward #'re-search-forward) @@ -313,59 +495,54 @@ If no footnote is found, return nil." (unless (re-search-forward org-footnote-re limit t) (goto-char origin) (throw 'exit nil)) - ;; Beware: with [1]-like footnotes point will be just after + ;; Beware: with non-inline footnotes point will be just after ;; the closing square bracket. (backward-char) (cond ((setq ref (org-footnote-at-reference-p)) (throw 'exit ref)) - ;; Definition: also grab the last square bracket, only - ;; matched in `org-footnote-re' for [1]-like footnotes. + ;; Definition: also grab the last square bracket, matched in + ;; `org-footnote-re' for non-inline footnotes. ((save-match-data (org-footnote-at-definition-p)) (let ((end (match-end 0))) (throw 'exit (list nil (match-beginning 0) - (if (eq (char-before end) 93) end (1+ end))))))))))) + (if (eq (char-before end) ?\]) end (1+ end))))))))))) -(defun org-footnote-get-definition (label) - "Return label, boundaries and definition of the footnote LABEL." - (let* ((label (regexp-quote (org-footnote-normalize-label label))) - (re (format "^\\[%s\\]\\|.\\[%s:" label label)) - pos) - (save-excursion - (save-restriction - (when (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) - (and (progn (widen) t) - (goto-char (point-min)) - (re-search-forward re nil t))) - (let ((refp (org-footnote-at-reference-p))) - (cond - ((and (nth 3 refp) refp)) - ((org-footnote-at-definition-p))))))))) - -(defun org-footnote-goto-definition (label) +(defun org-footnote-goto-definition (label &optional location) "Move point to the definition of the footnote LABEL. -Return a non-nil value when a definition has been found." + +LOCATION, when non-nil specifies the buffer position of the +definition. + +Throw an error if there is no definition or if it cannot be +reached from current narrowed part of buffer. Return a non-nil +value if point was successfully moved." (interactive "sLabel: ") - (org-mark-ring-push) - (let ((def (org-footnote-get-definition label))) - (if (not def) - (error "Cannot find definition of footnote %s" label) - (goto-char (nth 1 def)) - (looking-at (format "\\[%s\\]\\|\\[%s:" label label)) - (goto-char (match-end 0)) - (org-show-context 'link-search) - (when (derived-mode-p 'org-mode) - (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")) - t))) + (let* ((label (org-footnote-normalize-label label)) + (def-start (or location (nth 1 (org-footnote-get-definition label))))) + (cond + ((not def-start) + (user-error "Cannot find definition of footnote %s" label)) + ((or (> def-start (point-max)) (< def-start (point-min))) + (user-error "Definition is outside narrowed part of buffer"))) + (org-mark-ring-push) + (goto-char def-start) + (looking-at (format "\\[fn:%s[]:] ?" (regexp-quote label))) + (goto-char (match-end 0)) + (org-show-context 'link-search) + (when (derived-mode-p 'org-mode) + (message "%s" (substitute-command-keys + "Edit definition and go back with \ +`\\[org-mark-ring-goto]' or, if unique, with `\\[org-ctrl-c-ctrl-c]'."))) + t)) (defun org-footnote-goto-previous-reference (label) "Find the first closest (to point) reference of footnote with label LABEL." (interactive "sLabel: ") (org-mark-ring-push) - (let* ((label (org-footnote-normalize-label label)) ref) + (let ((label (org-footnote-normalize-label label)) + ref) (save-excursion (setq ref (or (org-footnote-get-next-reference label t) (org-footnote-get-next-reference label) @@ -379,62 +556,74 @@ Return a non-nil value when a definition has been found." (goto-char (nth 1 ref)) (org-show-context 'link-search)))) + +;;;; Getters + (defun org-footnote-normalize-label (label) - "Return LABEL as an appropriate string." - (cond - ((numberp label) (number-to-string label)) - ((equal "" label) nil) - ((not (string-match "^[0-9]+$\\|^fn:" label)) - (concat "fn:" label)) - (t label))) - -(defun org-footnote-all-labels (&optional with-defs) - "Return list with all defined foot labels used in the buffer. - -If WITH-DEFS is non-nil, also associate the definition to each -label. The function will then return an alist whose key is label -and value definition." - (let* (rtn - (push-to-rtn - (function - ;; Depending on WITH-DEFS, store label or (label . def) of - ;; footnote reference/definition given as argument in RTN. - (lambda (el) - (let ((lbl (car el))) - (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn)))))) - (save-excursion - (save-restriction - (widen) - ;; Find all labels found in definitions. - (goto-char (point-min)) - (let (def) - (while (re-search-forward org-footnote-definition-re nil t) - (when (setq def (org-footnote-at-definition-p)) - (funcall push-to-rtn def)))) - ;; Find all labels found in references. - (goto-char (point-min)) - (let (ref) - (while (setq ref (org-footnote-get-next-reference)) - (goto-char (nth 2 ref)) - (and (car ref) ; ignore anonymous footnotes - (not (funcall (if with-defs #'assoc #'member) (car ref) rtn)) - (funcall push-to-rtn ref)))))) - rtn)) + "Return LABEL without \"fn:\" prefix. +If LABEL is the empty string or constituted of white spaces only, +return nil instead." + (pcase (org-trim label) + ("" nil) + ((pred (string-prefix-p "fn:")) (substring label 3)) + (_ label))) + +(defun org-footnote-get-definition (label) + "Return label, boundaries and definition of the footnote LABEL." + (let* ((label (regexp-quote (org-footnote-normalize-label label))) + (re (format "^\\[fn:%s\\]\\|.\\[fn:%s:" label label))) + (org-with-wide-buffer + (goto-char (point-min)) + (catch 'found + (while (re-search-forward re nil t) + (let* ((datum (progn (backward-char) (org-element-context))) + (type (org-element-type datum))) + (when (memq type '(footnote-definition footnote-reference)) + (throw 'found + (list + label + (org-element-property :begin datum) + (org-element-property :end datum) + (let ((cbeg (org-element-property :contents-begin datum))) + (if (not cbeg) "" + (replace-regexp-in-string + "[ \t\n]*\\'" + "" + (buffer-substring-no-properties + cbeg + (org-element-property :contents-end datum)))))))))) + nil)))) + +(defun org-footnote-all-labels () + "List all defined footnote labels used throughout the buffer. +This function ignores narrowing, if any." + (org-with-wide-buffer + (goto-char (point-min)) + (let (all) + (while (re-search-forward org-footnote-re nil t) + (backward-char) + (let ((context (org-element-context))) + (when (memq (org-element-type context) + '(footnote-definition footnote-reference)) + (let ((label (org-element-property :label context))) + (when label (cl-pushnew label all :test #'equal)))))) + all))) (defun org-footnote-unique-label (&optional current) "Return a new unique footnote label. -The function returns the first \"fn:N\" or \"N\" label that is -currently not used. +The function returns the first numeric label currently unused. Optional argument CURRENT is the list of labels active in the buffer." - (unless current (setq current (org-footnote-all-labels))) - (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d")) - (cnt 1)) - (while (member (format fmt cnt) current) - (incf cnt)) - (format fmt cnt))) + (let ((current (or current (org-footnote-all-labels)))) + (let ((count 1)) + (while (member (number-to-string count) current) + (cl-incf count)) + (number-to-string count)))) + + +;;;; Adding, Deleting Footnotes (defun org-footnote-new () "Insert a new footnote. @@ -442,343 +631,66 @@ This command prompts for a label. If this is a label referencing an existing label, only insert the label. If the footnote label is empty or new, let the user edit the definition of the footnote." (interactive) - (unless (org-footnote-in-valid-context-p) - (error "Cannot insert a footnote here")) - (let* ((lbls (and (not (equal org-footnote-auto-label 'random)) - (org-footnote-all-labels))) - (propose (and (not (equal org-footnote-auto-label 'random)) - (org-footnote-unique-label lbls))) + (unless (org-footnote--allow-reference-p) + (user-error "Cannot insert a footnote here")) + (let* ((all (org-footnote-all-labels)) (label - (org-footnote-normalize-label - (cond - ((member org-footnote-auto-label '(t plain)) - propose) - ((equal org-footnote-auto-label 'random) - (require 'org-id) - (substring (org-id-uuid) 0 8)) - (t - (org-icompleting-read - "Label (leave empty for anonymous): " - (mapcar 'list lbls) nil nil - (if (eq org-footnote-auto-label 'confirm) propose nil))))))) - (cond - ((bolp) (error "Cannot create a footnote reference at left margin")) - ((not label) - (insert "[fn:: ]") - (backward-char 1)) - ((member label lbls) - (insert "[" label "]") - (message "New reference to existing note")) - (org-footnote-define-inline - (insert "[" label ": ]") - (backward-char 1) - (org-footnote-auto-adjust-maybe)) - (t - (insert "[" label "]") - (org-footnote-create-definition label) - (org-footnote-auto-adjust-maybe))))) - -(defvar org-blank-before-new-entry) ; silence byte-compiler + (if (eq org-footnote-auto-label 'random) + (format "%x" (random most-positive-fixnum)) + (org-footnote-normalize-label + (let ((propose (org-footnote-unique-label all))) + (if (eq org-footnote-auto-label t) propose + (completing-read + "Label (leave empty for anonymous): " + (mapcar #'list all) nil nil + (and (eq org-footnote-auto-label 'confirm) propose)))))))) + (cond ((not label) + (insert "[fn::]") + (backward-char 1)) + ((member label all) + (insert "[fn:" label "]") + (message "New reference to existing note")) + (org-footnote-define-inline + (insert "[fn:" label ":]") + (backward-char 1) + (org-footnote-auto-adjust-maybe)) + (t + (insert "[fn:" label "]") + (let ((p (org-footnote-create-definition label))) + ;; `org-footnote-goto-definition' needs to be called + ;; after `org-footnote-auto-adjust-maybe'. Otherwise + ;; both label and location of the definition are lost. + ;; On the contrary, it needs to be called before + ;; `org-edit-footnote-reference' so that the remote + ;; editing buffer can display the correct label. + (if (ignore-errors (org-footnote-goto-definition label p)) + (org-footnote-auto-adjust-maybe) + ;; Definition was created outside current scope: edit + ;; it remotely. + (org-footnote-auto-adjust-maybe) + (org-edit-footnote-reference))))))) + (defun org-footnote-create-definition (label) - "Start the definition of a footnote with label LABEL." - (interactive "sLabel: ") + "Start the definition of a footnote with label LABEL. +Return buffer position at the beginning of the definition. This +function doesn't move point." (let ((label (org-footnote-normalize-label label)) - electric-indent-mode) ;; Prevent wrong indentation - (cond - ;; In an Org file. - ((derived-mode-p 'org-mode) - ;; If `org-footnote-section' is defined, find it, or create it - ;; at the end of the buffer. - (when org-footnote-section - (goto-char (point-min)) - (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))) - (unless (or (re-search-forward re nil t) - (and (progn (widen) t) - (re-search-forward re nil t))) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (unless (bolp) (newline)) - ;; Insert new section. Separate it from the previous one - ;; with a blank line, unless `org-blank-before-new-entry' - ;; explicitly says no. - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n")))) - ;; Move to the end of this entry (which may be - ;; `org-footnote-section' or the current one). - (org-footnote-goto-local-insertion-point) - (org-show-context 'link-search)) - (t - ;; In a non-Org file. Search for footnote tag, or create it if - ;; specified (at the end of buffer, or before signature if in - ;; Message mode). Set point after any definition already there. - (let ((tag (and org-footnote-tag-for-non-org-mode-files - (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (max (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t)) - (progn - ;; Ensure one blank line separates last - ;; footnote from signature. - (beginning-of-line) - (open-line 2) - (point-marker)) - (point-max-marker)))) - (set-marker-insertion-type max t) - (goto-char max) - ;; Check if the footnote tag is defined but missing. In this - ;; case, insert it, before any footnote or one blank line - ;; after any previous text. - (when (and tag (not (re-search-backward tag nil t))) - (skip-chars-backward " \t\r\n") - (while (re-search-backward org-footnote-definition-re nil t)) - (unless (bolp) (newline 2)) - (insert org-footnote-tag-for-non-org-mode-files "\n\n")) - ;; Remove superfluous white space and clear marker. - (goto-char max) - (skip-chars-backward " \t\r\n") - (delete-region (point) max) - (unless (bolp) (newline)) - (set-marker max nil)))) - ;; Insert footnote label. - (when (zerop (org-back-over-empty-lines)) (newline)) - (insert "[" label "] \n") - (backward-char) - ;; Only notify user about next possible action when in an Org - ;; buffer, as the bindings may have different meanings otherwise. - (when (derived-mode-p 'org-mode) - (message - "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) - -;;;###autoload -(defun org-footnote-action (&optional special) - "Do the right thing for footnotes. - -When at a footnote reference, jump to the definition. - -When at a definition, jump to the references if they exist, offer -to create them otherwise. - -When neither at definition or reference, create a new footnote, -interactively. - -With prefix arg SPECIAL, offer additional commands in a menu." - (interactive "P") - (let (tmp c) - (cond - (special - (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete") - (setq c (read-char-exclusive)) - (cond - ((eq c ?s) (org-footnote-normalize 'sort)) - ((eq c ?r) (org-footnote-renumber-fn:N)) - ((eq c ?S) - (org-footnote-renumber-fn:N) - (org-footnote-normalize 'sort)) - ((eq c ?n) (org-footnote-normalize)) - ((eq c ?d) (org-footnote-delete)) - (t (error "No such footnote command %c" c)))) - ((setq tmp (org-footnote-at-reference-p)) - (cond - ;; Anonymous footnote: move point at the beginning of its - ;; definition. - ((not (car tmp)) - (goto-char (nth 1 tmp)) - (forward-char 5)) - ;; A definition exists: move to it. - ((ignore-errors (org-footnote-goto-definition (car tmp)))) - ;; No definition exists: offer to create it. - ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp))) - (org-footnote-create-definition (car tmp))))) - ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-previous-reference (car tmp))) - (t (org-footnote-new))))) - -;;;###autoload -(defun org-footnote-normalize (&optional sort-only) - "Collect the footnotes in various formats and normalize them. - -This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format. - -When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence." - ;; This is based on Paul's function, but rewritten. - ;; - ;; Re-create `org-with-limited-levels', but not limited to Org - ;; buffers. - (let* ((limit-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level))) - (nstars (and limit-level - (if org-odd-levels-only (1- (* limit-level 2)) - limit-level))) - (org-outline-regexp - (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - (count 0) - ins-point ref ref-table) - (save-excursion - ;; 1. Find every footnote reference, extract the definition, and - ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also - ;; normalize references. - (goto-char (point-min)) - (while (setq ref (org-footnote-get-next-reference)) - (let* ((lbl (car ref)) - (pos (nth 1 ref)) - ;; When footnote isn't anonymous, check if it's label - ;; (REF) is already stored in REF-TABLE. In that case, - ;; extract number used to identify it (MARKER). If - ;; footnote is unknown, increment the global counter - ;; (COUNT) to create an unused identifier. - (a (and lbl (assoc lbl ref-table))) - (marker (or (nth 1 a) (incf count))) - ;; Is the reference inline or pointing to an inline - ;; footnote? - (inlinep (or (stringp (nth 3 ref)) (nth 3 a)))) - ;; Replace footnote reference with [MARKER]. Maybe fill - ;; paragraph once done. If SORT-ONLY is non-nil, only move - ;; to the end of reference found to avoid matching it twice. - (if sort-only (goto-char (nth 2 ref)) - (delete-region (nth 1 ref) (nth 2 ref)) - (goto-char (nth 1 ref)) - (insert (format "[%d]" marker)) - (and inlinep - org-footnote-fill-after-inline-note-extraction - (org-fill-paragraph))) - ;; Add label (REF), identifier (MARKER), definition (DEF) - ;; type (INLINEP) and position (POS) to REF-TABLE if data - ;; was unknown. - (unless a - (let ((def (or (nth 3 ref) ; Inline definition. - (nth 3 (org-footnote-get-definition lbl))))) - (push (list lbl marker def - ;; Reference beginning position is a marker - ;; to preserve it during further buffer - ;; modifications. - inlinep (copy-marker pos)) ref-table))))) - ;; 2. Find and remove the footnote section, if any. Also - ;; determine where footnotes shall be inserted (INS-POINT). - (cond - ((and org-footnote-section (derived-mode-p 'org-mode)) - (goto-char (point-min)) - (if (re-search-forward - (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) - "[ \t]*$") nil t) - (delete-region (match-beginning 0) (org-end-of-subtree t t))) - ;; A new footnote section is inserted by default at the end of - ;; the buffer. - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (forward-line) - (unless (bolp) (newline))) - ;; No footnote section set: Footnotes will be added at the end - ;; of the section containing their first reference. - ((derived-mode-p 'org-mode)) - (t - ;; Remove any left-over tag in the buffer, if one is set up. - (when org-footnote-tag-for-non-org-mode-files - (let ((tag (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (goto-char (point-min)) - (while (re-search-forward tag nil t) - (replace-match "") - (delete-region (point) (progn (forward-line) (point)))))) - ;; In Message mode, ensure footnotes are inserted before the - ;; signature. - (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t)) - (beginning-of-line) - (goto-char (point-max))))) - (setq ins-point (point-marker)) - ;; 3. Clean-up REF-TABLE. - (setq ref-table - (delq nil - (mapcar - (lambda (x) - (cond - ;; When only sorting, ignore inline footnotes. - ;; Also clear position marker. - ((and sort-only (nth 3 x)) - (set-marker (nth 4 x) nil) nil) - ;; No definition available: provide one. - ((not (nth 2 x)) - (append - (list (car x) (nth 1 x) - (format "DEFINITION NOT FOUND: %s" (car x))) - (nthcdr 3 x))) - (t x))) - ref-table))) - (setq ref-table (nreverse ref-table)) - ;; 4. Remove left-over definitions in the buffer. - (mapc (lambda (x) - (unless (nth 3 x) (org-footnote-delete-definitions (car x)))) - ref-table) - ;; 5. Insert the footnotes again in the buffer, at the - ;; appropriate spot. - (goto-char ins-point) - (cond - ;; No footnote: exit. - ((not ref-table)) - ;; Cases when footnotes should be inserted in one place. - ((or (not (derived-mode-p 'org-mode)) org-footnote-section) - ;; Insert again the section title, if any. Ensure that title, - ;; or the subsequent footnotes, will be separated by a blank - ;; lines from the rest of the document. In an Org buffer, - ;; separate section with a blank line, unless explicitly - ;; stated in `org-blank-before-new-entry'. - (if (not (derived-mode-p 'org-mode)) - (progn (skip-chars-backward " \t\n\r") - (delete-region (point) ins-point) - (unless (bolp) (newline)) - (when org-footnote-tag-for-non-org-mode-files - (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n")) - (set-marker ins-point nil) - ;; Insert the footnotes, separated by a blank line. - (insert - (mapconcat - (lambda (x) - ;; Clean markers. - (set-marker (nth 4 x) nil) - (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) - ref-table "\n")) - (unless (eobp) (insert "\n\n"))) - ;; Each footnote definition has to be inserted at the end of - ;; the section where its first reference belongs. - (t - (mapc - (lambda (x) - (let ((pos (nth 4 x))) - (goto-char pos) - ;; Clean marker. - (set-marker pos nil)) - (org-footnote-goto-local-insertion-point) - (insert (format "\n[%s] %s\n" - (if sort-only (car x) (nth 1 x)) - (nth 2 x)))) - ref-table)))))) - -(defun org-footnote-goto-local-insertion-point () - "Find insertion point for footnote, just before next outline heading." - (org-with-limited-levels (outline-next-heading)) - (or (bolp) (newline)) - (beginning-of-line 0) - (while (and (not (bobp)) (= (char-after) ?#)) - (beginning-of-line 0)) - (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2)) - (end-of-line 1) - (skip-chars-backward "\n\r\t ") - (forward-line)) + electric-indent-mode) ; Prevent wrong indentation. + (org-with-wide-buffer + (cond + ((not org-footnote-section) (org-footnote--goto-local-insertion-point)) + ((save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^\\*+[ \t]+" (regexp-quote org-footnote-section) "[ \t]*$") + nil t)) + (goto-char (match-end 0)) + (forward-line) + (unless (bolp) (insert "\n"))) + (t (org-footnote--clear-footnote-section))) + (when (zerop (org-back-over-empty-lines)) (insert "\n")) + (insert "[fn:" label "] \n") + (line-beginning-position 0)))) (defun org-footnote-delete-references (label) "Delete every reference to footnote LABEL. @@ -789,7 +701,7 @@ Return the number of footnotes removed." (while (setq ref (org-footnote-get-next-reference label)) (goto-char (nth 1 ref)) (delete-region (nth 1 ref) (nth 2 ref)) - (incf nref)) + (cl-incf nref)) nref))) (defun org-footnote-delete-definitions (label) @@ -797,17 +709,21 @@ Return the number of footnotes removed." Return the number of footnotes removed." (save-excursion (goto-char (point-min)) - (let ((def-re (concat "^\\[" (regexp-quote label) "\\]")) + (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label))) (ndef 0)) (while (re-search-forward def-re nil t) - (let ((full-def (org-footnote-at-definition-p))) - (when full-def - ;; Remove the footnote, and all blank lines before it. - (goto-char (nth 1 full-def)) - (skip-chars-backward " \r\t\n") - (unless (bolp) (forward-line)) - (delete-region (point) (nth 2 full-def)) - (incf ndef)))) + (pcase (org-footnote-at-definition-p) + (`(,_ ,start ,end ,_) + ;; Remove the footnote, and all blank lines before it. + (delete-region (progn + (goto-char start) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2))) + (progn + (goto-char end) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2)))) + (cl-incf ndef)))) ndef))) (defun org-footnote-delete (&optional label) @@ -843,24 +759,165 @@ If LABEL is non-nil, delete that footnote instead." (message "%d definition(s) of and %d reference(s) of footnote %s removed" ndef nref label)))) + +;;;; Sorting, Renumbering, Normalizing + (defun org-footnote-renumber-fn:N () - "Renumber the simple footnotes like fn:17 into a sequence in the document." + "Order numbered footnotes into a sequence in the document." (interactive) - (let (map (n 0)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t) - (save-excursion - (goto-char (match-beginning 0)) - ;; Ensure match is a footnote reference or definition. - (when (save-match-data (if (bolp) - (org-footnote-at-definition-p) - (org-footnote-at-reference-p))) - (let ((new-val (or (cdr (assoc (match-string 1) map)) - (number-to-string (incf n))))) - (unless (assoc (match-string 1) map) - (push (cons (match-string 1) new-val) map)) - (replace-match new-val nil nil nil 1)))))))) + (let ((references (org-footnote--collect-references))) + (unwind-protect + (let* ((c 0) + (references (cl-remove-if-not + (lambda (r) (string-match-p "\\`[0-9]+\\'" (car r))) + references)) + (alist (mapcar (lambda (l) (cons l (number-to-string (cl-incf c)))) + (delete-dups (mapcar #'car references))))) + (org-with-wide-buffer + ;; Re-number references. + (dolist (ref references) + (goto-char (nth 1 ref)) + (org-footnote--set-label (cdr (assoc (nth 0 ref) alist)))) + ;; Re-number definitions. + (goto-char (point-min)) + (while (re-search-forward "^\\[fn:\\([0-9]+\\)\\]" nil t) + (replace-match (or (cdr (assoc (match-string 1) alist)) + ;; Un-referenced definitions get + ;; higher numbers. + (number-to-string (cl-incf c))) + nil nil nil 1)))) + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(defun org-footnote-sort () + "Rearrange footnote definitions in the current buffer. +Sort footnote definitions so they match order of footnote +references. Also relocate definitions at the end of their +relative section or within a single footnote section, according +to `org-footnote-section'. Inline definitions are ignored." + (let ((references (org-footnote--collect-references))) + (unwind-protect + (let ((definitions (org-footnote--collect-definitions 'delete))) + (org-with-wide-buffer + (org-footnote--clear-footnote-section) + ;; Insert footnote definitions at the appropriate location, + ;; separated by a blank line. Each definition is inserted + ;; only once throughout the buffer. + (let (inserted) + (dolist (cell references) + (let ((label (car cell)) + (nested (not (nth 2 cell))) + (inline (nth 3 cell))) + (unless (or (member label inserted) inline) + (push label inserted) + (unless (or org-footnote-section nested) + ;; If `org-footnote-section' is non-nil, or + ;; reference is nested, point is already at the + ;; correct position. Otherwise, move at the + ;; appropriate location within the section + ;; containing the reference. + (goto-char (nth 1 cell)) + (org-footnote--goto-local-insertion-point)) + (insert "\n" + (or (cdr (assoc label definitions)) + (format "[fn:%s] DEFINITION NOT FOUND." label)) + "\n")))) + ;; Insert un-referenced footnote definitions at the end. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) (insert "\n" (cdr d) "\n")))))) + ;; Clear dangling markers in the buffer. + (dolist (r references) (set-marker (nth 1 r) nil))))) + +(defun org-footnote-normalize () + "Turn every footnote in buffer into a numbered one." + (interactive) + (let ((references (org-footnote--collect-references 'anonymous))) + (unwind-protect + (let ((n 0) + (translations nil) + (definitions nil)) + (org-with-wide-buffer + ;; Update label for reference. We need to do this before + ;; clearing definitions in order to rename nested footnotes + ;; before they are deleted. + (dolist (cell references) + (let* ((label (car cell)) + (anonymous (not label)) + (new + (cond + ;; In order to differentiate anonymous + ;; references from regular ones, set their + ;; labels to integers, not strings. + (anonymous (setcar cell (cl-incf n))) + ((cdr (assoc label translations))) + (t (let ((l (number-to-string (cl-incf n)))) + (push (cons label l) translations) + l))))) + (goto-char (nth 1 cell)) ; Move to reference's start. + (org-footnote--set-label + (if anonymous (number-to-string new) new)) + (let ((size (nth 3 cell))) + ;; Transform inline footnotes into regular references + ;; and retain their definition for later insertion as + ;; a regular footnote definition. + (when size + (let ((def (concat + (format "[fn:%s] " new) + (org-trim + (substring + (delete-and-extract-region + (point) (+ (point) size 1)) + 1))))) + (push (cons (if anonymous new label) def) definitions) + (when org-footnote-fill-after-inline-note-extraction + (org-fill-paragraph))))))) + ;; Collect definitions. Update labels according to ALIST. + (let ((definitions + (nconc definitions + (org-footnote--collect-definitions 'delete))) + (inserted)) + (org-footnote--clear-footnote-section) + (dolist (cell references) + (let* ((label (car cell)) + (anonymous (integerp label)) + (pos (nth 1 cell))) + ;; Move to appropriate location, if required. When + ;; there is a footnote section or reference is + ;; nested, point is already at the expected location. + (unless (or org-footnote-section (not (nth 2 cell))) + (goto-char pos) + (org-footnote--goto-local-insertion-point)) + ;; Insert new definition once label is updated. + (unless (member label inserted) + (push label inserted) + (let ((stored (cdr (assoc label definitions))) + ;; Anonymous footnotes' label is already + ;; up-to-date. + (new (if anonymous label + (cdr (assoc label translations))))) + (insert "\n" + (cond + ((not stored) + (format "[fn:%s] DEFINITION NOT FOUND." new)) + (anonymous stored) + (t + (replace-regexp-in-string + "\\`\\[fn:\\(.*?\\)\\]" new stored nil nil 1))) + "\n"))))) + ;; Insert un-referenced footnote definitions at the end. + (let ((unreferenced + (cl-remove-if (lambda (d) (member (car d) inserted)) + definitions))) + (dolist (d unreferenced) + (insert "\n" + (replace-regexp-in-string + org-footnote-definition-re + (format "[fn:%d]" (cl-incf n)) + (cdr d)) + "\n")))))) + ;; Clear dangling markers. + (dolist (r references) (set-marker (nth 1 r) nil))))) (defun org-footnote-auto-adjust-maybe () "Renumber and/or sort footnotes according to user settings." @@ -868,14 +925,77 @@ If LABEL is non-nil, delete that footnote instead." (org-footnote-renumber-fn:N)) (when (memq org-footnote-auto-adjust '(t sort)) (let ((label (car (org-footnote-at-definition-p)))) - (org-footnote-normalize 'sort) + (org-footnote-sort) (when label (goto-char (point-min)) - (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]") + (and (re-search-forward (format "^\\[fn:%s\\]" (regexp-quote label)) nil t) (progn (insert " ") (just-one-space))))))) + +;;;; End-user interface + +;;;###autoload +(defun org-footnote-action (&optional special) + "Do the right thing for footnotes. + +When at a footnote reference, jump to the definition. + +When at a definition, jump to the references if they exist, offer +to create them otherwise. + +When neither at definition or reference, create a new footnote, +interactively if possible. + +With prefix arg SPECIAL, or when no footnote can be created, +offer additional commands in a menu." + (interactive "P") + (let* ((context (and (not special) (org-element-context))) + (type (org-element-type context))) + (cond + ;; On white space after element, insert a new footnote. + ((and context + (> (point) + (save-excursion + (goto-char (org-element-property :end context)) + (skip-chars-backward " \t") + (point)))) + (org-footnote-new)) + ((eq type 'footnote-reference) + (let ((label (org-element-property :label context))) + (cond + ;; Anonymous footnote: move point at the beginning of its + ;; definition. + ((not label) + (goto-char (org-element-property :contents-begin context))) + ;; Check if a definition exists: then move to it. + ((let ((p (nth 1 (org-footnote-get-definition label)))) + (when p (org-footnote-goto-definition label p)))) + ;; No definition exists: offer to create it. + ((yes-or-no-p (format "No definition for %s. Create one? " label)) + (let ((p (org-footnote-create-definition label))) + (or (ignore-errors (org-footnote-goto-definition label p)) + ;; Since definition was created outside current scope, + ;; edit it remotely. + (org-edit-footnote-reference))))))) + ((eq type 'footnote-definition) + (org-footnote-goto-previous-reference + (org-element-property :label context))) + ((or special (not (org-footnote--allow-reference-p))) + (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s | [n]ormalize | \ +\[d]elete") + (pcase (read-char-exclusive) + (?s (org-footnote-sort)) + (?r (org-footnote-renumber-fn:N)) + (?S (org-footnote-renumber-fn:N) + (org-footnote-sort)) + (?n (org-footnote-normalize)) + (?d (org-footnote-delete)) + (char (error "No such footnote command %c" char)))) + (t (org-footnote-new))))) + + (provide 'org-footnote) ;; Local variables: diff --git a/lisp/org/org-gnus.el b/lisp/org/org-gnus.el index 1d287a740b..b9d098957c 100644 --- a/lisp/org/org-gnus.el +++ b/lisp/org/org-gnus.el @@ -1,4 +1,4 @@ -;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode +;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -25,8 +25,8 @@ ;; ;;; Commentary: -;; This file implements links to Gnus groups and messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to Gnus groups and messages from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -36,18 +36,20 @@ (eval-when-compile (require 'gnus-sum)) ;; Declare external functions and variables + (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) -;; The following line suppresses a compiler warning stemming from gnus-sum.el (declare-function gnus-summary-last-subject "gnus-sum" nil) +(declare-function nnvirtual-map-article "nnvirtual" (article)) + ;; Customization variables -(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) +(defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) (defcustom org-gnus-prefer-web-links nil "If non-nil, `org-store-link' creates web links to Google groups or Gmane. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') +\\When nil, Gnus will be used for such links. +Using a prefix argument to the command `\\[org-store-link]' (`org-store-link') negates this setting for the duration of the command." :group 'org-link-store :type 'boolean) @@ -72,20 +74,21 @@ this variable to t." :type 'boolean) ;; Install the link type -(org-add-link-type "gnus" 'org-gnus-open) -(add-hook 'org-store-link-functions 'org-gnus-store-link) +(org-link-set-parameters "gnus" :follow #'org-gnus-open :store #'org-gnus-store-link) ;; Implementation -;; FIXME: nnimap-group-overview-filename was removed from Gnus in -;; September 2010. Perhaps remove this function? (defun org-gnus-nnimap-cached-article-number (group server message-id) "Return cached article number (uid) of message in GROUP on SERVER. MESSAGE-ID is the message-id header field that identifies the message. If the uid is not cached, return nil." (with-temp-buffer - (let ((nov (nnimap-group-overview-filename group server))) - (when (file-exists-p nov) + (let ((nov (and (fboundp 'nnimap-group-overview-filename) + ;; nnimap-group-overview-filename was removed from + ;; Gnus in September 2010, and therefore should + ;; only be present in Emacs 23.1. + (nnimap-group-overview-filename group server)))) + (when (and nov (file-exists-p nov)) (mm-insert-file-contents nov) (set-buffer-modified-p nil) (goto-char (point-min)) @@ -104,7 +107,7 @@ Otherwise create a link to the group inside Gnus. If `org-store-link' was called with a prefix arg the meaning of `org-gnus-prefer-web-links' is reversed." (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group))) - (if (and (string-match "^nntp" group) ;; Only for nntp groups + (if (and (string-prefix-p "nntp" group) ;; Only for nntp groups (org-xor current-prefix-arg org-gnus-prefer-web-links)) (concat (if (string-match "gmane" unprefixed-group) @@ -156,21 +159,17 @@ If `org-store-link' was called with a prefix arg the meaning of (header (with-current-buffer gnus-summary-buffer (gnus-summary-article-header))) (from (mail-header-from header)) - (message-id (org-remove-angle-brackets (mail-header-id header))) + (message-id (org-unbracket-string "<" ">" (mail-header-id header))) (date (org-trim (mail-header-date header))) - (date-ts (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t) - (date-to-time date))))) - (date-ts-ia (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t t) - (date-to-time date))))) (subject (copy-sequence (mail-header-subject header))) (to (cdr (assq 'To (mail-header-extra header)))) newsgroups x-no-archive desc link) + (cl-case (car (gnus-find-method-for-group gnus-newsgroup-name)) + (nnvirtual + (setq group (car (nnvirtual-map-article + (gnus-summary-article-number))))) + (nnir + (setq group (nnir-article-group (gnus-summary-article-number))))) ;; Remove text properties of subject string to avoid Emacs bug ;; #3506 (set-text-properties 0 (length subject) nil subject) @@ -183,11 +182,8 @@ If `org-store-link' was called with a prefix arg the meaning of (setq to (or to (gnus-fetch-original-field "To")) newsgroups (gnus-fetch-original-field "Newsgroups") x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject + (org-store-link-props :type "gnus" :from from :date date :subject subject :message-id message-id :group group :to to) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description) link (org-gnus-article-link group newsgroups message-id x-no-archive)) @@ -206,7 +202,7 @@ If `org-store-link' was called with a prefix arg the meaning of (let ((gcc (car (last (message-unquote-tokens (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) - (id (org-remove-angle-brackets (mail-fetch-field "Message-ID"))) + (id (org-unbracket-string "<" ">" (mail-fetch-field "Message-ID"))) (to (mail-fetch-field "To")) (from (mail-fetch-field "From")) (subject (mail-fetch-field "Subject")) @@ -250,10 +246,8 @@ If `org-store-link' was called with a prefix arg the meaning of (require 'gnus) (funcall (cdr (assq 'gnus org-link-frame-setup))) (if gnus-other-frame-object (select-frame gnus-other-frame-object)) - (when group - (setq group (org-no-properties group))) - (when article - (setq article (org-no-properties article))) + (setq group (org-no-properties group)) + (setq article (org-no-properties article)) (cond ((and group article) (gnus-activate-group group) (condition-case nil diff --git a/lisp/org/org-habit.el b/lisp/org/org-habit.el index bbbf845d14..1f61565719 100644 --- a/lisp/org/org-habit.el +++ b/lisp/org/org-habit.el @@ -1,4 +1,4 @@ -;;; org-habit.el --- The habit tracking code for Org-mode +;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. @@ -24,18 +24,16 @@ ;; ;;; Commentary: -;; This file contains the habit tracking code for Org-mode +;; This file contains the habit tracking code for Org mode ;;; Code: +(require 'cl-lib) (require 'org) (require 'org-agenda) -(eval-when-compile - (require 'cl)) - (defgroup org-habit nil - "Options concerning habit tracking in Org-mode." + "Options concerning habit tracking in Org mode." :tag "Org Habit" :group 'org-progress) @@ -165,16 +163,17 @@ Returns a list with the following elements: 2: Optional deadline (nil if not present) 3: If deadline, the repeater for the deadline, otherwise nil 4: A list of all the past dates this todo was mark closed + 5: Repeater type as a string This list represents a \"habit\" for the rest of this module." (save-excursion (if pom (goto-char pom)) - (assert (org-is-habit-p (point))) + (cl-assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) (scheduled-repeat (org-get-repeat org-scheduled-string)) (end (org-entry-end-position)) (habit-entry (org-no-properties (nth 4 (org-heading-components)))) - closed-dates deadline dr-days sr-days) + closed-dates deadline dr-days sr-days sr-type) (if scheduled (setq scheduled (time-to-days scheduled)) (error "Habit %s has no scheduled date" habit-entry)) @@ -182,7 +181,9 @@ This list represents a \"habit\" for the rest of this module." (error "Habit `%s' has no scheduled repeat period or has an incorrect one" habit-entry)) - (setq sr-days (org-habit-duration-to-days scheduled-repeat)) + (setq sr-days (org-habit-duration-to-days scheduled-repeat) + sr-type (progn (string-match "[\\.+]?\\+" scheduled-repeat) + (match-string-no-properties 0 scheduled-repeat))) (unless (> sr-days 0) (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) @@ -197,17 +198,33 @@ This list represents a \"habit\" for the rest of this module." (reversed org-log-states-order-reversed) (search (if reversed 're-search-forward 're-search-backward)) (limit (if reversed end (point))) - (count 0)) + (count 0) + (re (format + "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)" + (regexp-opt org-done-keywords) + org-ts-regexp-inactive + (let ((value (cdr (assq 'done org-log-note-headings)))) + (if (not value) "" + (concat "\\|" + (org-replace-escapes + (regexp-quote value) + `(("%d" . ,org-ts-regexp-inactive) + ("%D" . ,org-ts-regexp) + ("%s" . "\"\\S-+\"") + ("%S" . "\"\\S-+\"") + ("%t" . ,org-ts-regexp-inactive) + ("%T" . ,org-ts-regexp) + ("%u" . ".*?") + ("%U" . ".*?"))))))))) (unless reversed (goto-char end)) - (while (and (< count maxdays) - (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]" - (regexp-opt org-done-keywords)) - limit t)) + (while (and (< count maxdays) (funcall search re limit t)) (push (time-to-days - (org-time-string-to-time (match-string-no-properties 1))) + (org-time-string-to-time + (or (match-string-no-properties 1) + (match-string-no-properties 2)))) closed-dates) (setq count (1+ count)))) - (list scheduled sr-days deadline dr-days closed-dates)))) + (list scheduled sr-days deadline dr-days closed-dates sr-type)))) (defsubst org-habit-scheduled (habit) (nth 0 habit)) @@ -225,6 +242,8 @@ This list represents a \"habit\" for the rest of this module." (org-habit-scheduled-repeat habit))) (defsubst org-habit-done-dates (habit) (nth 4 habit)) +(defsubst org-habit-repeat-type (habit) + (nth 5 habit)) (defsubst org-habit-get-priority (habit &optional moment) "Determine the relative priority of a habit. @@ -265,7 +284,6 @@ Habits are assigned colors on the following basis: schedule's repeat period." (let* ((scheduled (or scheduled-days (org-habit-scheduled habit))) (s-repeat (org-habit-scheduled-repeat habit)) - (scheduled-end (+ scheduled (1- s-repeat))) (d-repeat (org-habit-deadline-repeat habit)) (deadline (if scheduled-days (+ scheduled-days (- d-repeat s-repeat)) @@ -289,13 +307,14 @@ Habits are assigned colors on the following basis: CURRENT gives the current time between STARTING and ENDING, for the purpose of drawing the graph. It need not be the actual current time." - (let* ((done-dates (sort (org-habit-done-dates habit) '<)) + (let* ((all-done-dates (sort (org-habit-done-dates habit) #'<)) + (done-dates all-done-dates) (scheduled (org-habit-scheduled habit)) (s-repeat (org-habit-scheduled-repeat habit)) (start (time-to-days starting)) (now (time-to-days current)) (end (time-to-days ending)) - (graph (make-string (1+ (- end start)) ?\ )) + (graph (make-string (1+ (- end start)) ?\s)) (index 0) last-done-date) (while (and done-dates (< (car done-dates) start)) @@ -304,18 +323,55 @@ current time." (while (< start end) (let* ((in-the-past-p (< start now)) (todayp (= start now)) - (donep (and done-dates - (= start (car done-dates)))) - (faces (if (and in-the-past-p - (not last-done-date) - (not (< scheduled now))) - '(org-habit-clear-face . org-habit-clear-future-face) - (org-habit-get-faces - habit start (and in-the-past-p - (if last-done-date - (+ last-done-date s-repeat) - scheduled)) - donep))) + (donep (and done-dates (= start (car done-dates)))) + (faces + (if (and in-the-past-p + (not last-done-date) + (not (< scheduled now))) + '(org-habit-clear-face . org-habit-clear-future-face) + (org-habit-get-faces + habit start + (and in-the-past-p + last-done-date + ;; Compute scheduled time for habit at the time + ;; START was current. + (let ((type (org-habit-repeat-type habit))) + (cond + ;; At the last done date, use current + ;; scheduling in all cases. + ((null done-dates) scheduled) + ((equal type ".+") (+ last-done-date s-repeat)) + ((equal type "+") + ;; Since LAST-DONE-DATE, each done mark + ;; shifted scheduled date by S-REPEAT. + (- scheduled (* (length done-dates) s-repeat))) + (t + ;; Compute the scheduled time after the + ;; first repeat. This is the closest time + ;; past FIRST-DONE which can reach SCHEDULED + ;; by a number of S-REPEAT hops. + ;; + ;; Then, play TODO state change history from + ;; the beginning in order to find current + ;; scheduled time. + (let* ((first-done (car all-done-dates)) + (s (let ((shift (mod (- scheduled first-done) + s-repeat))) + (+ (if (= shift 0) s-repeat shift) + first-done)))) + (if (= first-done last-done-date) s + (catch :exit + (dolist (done (cdr all-done-dates) s) + ;; Each repeat shifts S by any + ;; number of S-REPEAT hops it takes + ;; to get past DONE, with a minimum + ;; of one hop. + (cl-incf s (* (1+ (/ (max (- done s) 0) + s-repeat)) + s-repeat)) + (when (= done last-done-date) + (throw :exit s)))))))))) + donep))) markedp face) (if donep (let ((done-time (time-add @@ -348,7 +404,7 @@ current time." (defun org-habit-insert-consistency-graphs (&optional line) "Insert consistency graph for any habitual tasks." - (let ((inhibit-read-only t) l c + (let ((inhibit-read-only t) (buffer-invisibility-spec '(org-link)) (moment (time-subtract (current-time) (list 0 (* 3600 org-extend-today-until) 0)))) diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 54fc733578..f07d243b8c 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -1,4 +1,4 @@ -;;; org-id.el --- Global identifiers for Org-mode entries +;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; @@ -24,7 +24,7 @@ ;; ;;; Commentary: -;; This file implements globally unique identifiers for Org-mode entries. +;; This file implements globally unique identifiers for Org entries. ;; Identifiers are stored in the entry as an :ID: property. Functions ;; are provided that create and retrieve such identifiers, and that find ;; entries based on the identifier. @@ -73,20 +73,17 @@ (require 'org) (declare-function message-make-fqdn "message" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) ;;; Customization (defgroup org-id nil - "Options concerning global entry identifiers in Org-mode." + "Options concerning global entry identifiers in Org mode." :tag "Org ID" :group 'org) -(define-obsolete-variable-alias - 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") (defcustom org-id-link-to-org-use-id nil "Non-nil means storing a link to an Org file will use entry IDs. +\\\ The variable can have the following values: @@ -101,7 +98,7 @@ create-if-interactive call `org-capture' that automatically and preemptively creates a link. If you do want to get an ID link in a capture template to an entry not having an ID, create it first by explicitly creating - a link to it, using `C-c C-l' first. + a link to it, using `\\[org-store-link]' first. create-if-interactive-and-no-custom-id Like create-if-interactive, but do not create an ID if there is @@ -203,7 +200,7 @@ This variable is only relevant when `org-id-track-globally' is set." When Org reparses files to remake the list of files and IDs it is tracking, it will normally scan the agenda files, the archives related to agenda files, any files that are listed as ID containing in the current register, and -any Org-mode files currently visited by Emacs. +any Org file currently visited by Emacs. You can list additional files here. This variable is only relevant when `org-id-track-globally' is set." :group 'org-id @@ -277,7 +274,7 @@ If necessary, the ID is created." (move-marker pom nil)))) ;;;###autoload -(defun org-id-get-with-outline-drilling (&optional targets) +(defun org-id-get-with-outline-drilling () "Use an outline-cycling interface to retrieve the ID of an entry. This only finds entries in the current buffer, using `org-get-location'. It returns the ID of the entry. If necessary, the ID is created." @@ -294,7 +291,7 @@ Move the cursor to that entry in that buffer." (let ((m (org-id-find id 'marker))) (unless m (error "Cannot find entry with ID \"%s\"" id)) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) (move-marker m nil) (org-show-context))) @@ -447,8 +444,7 @@ and time is the usual three-integer representation of time." Store the relation between files and corresponding IDs. This will scan all agenda files, all associated archives, and all files currently mentioned in `org-id-locations'. -When FILES is given, scan these files instead. -When CHECK is given, prepare detailed information about duplicate IDs." +When FILES is given, scan these files instead." (interactive) (if (not org-id-track-globally) (error "Please turn on `org-id-track-globally' if you want to track IDs") @@ -466,7 +462,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (if (symbolp org-id-extra-files) (symbol-value org-id-extra-files) org-id-extra-files) - ;; Files associated with live org-mode buffers + ;; Files associated with live Org buffers (delq nil (mapcar (lambda (b) (with-current-buffer b @@ -494,7 +490,7 @@ When CHECK is given, prepare detailed information about duplicate IDs." (goto-char (point-min)) (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" nil t) - (setq id (org-match-string-no-properties 1)) + (setq id (match-string-no-properties 1)) (if (member id found) (progn (message "Duplicate ID \"%s\", also in file %s" @@ -678,7 +674,7 @@ optional argument MARKERP, return the position as a new marker." (move-marker m nil) (org-show-context))) -(org-add-link-type "id" 'org-id-open) +(org-link-set-parameters "id" :follow #'org-id-open) (provide 'org-id) diff --git a/lisp/org/org-indent.el b/lisp/org/org-indent.el index baaff2ff7c..10c96179b6 100644 --- a/lisp/org/org-indent.el +++ b/lisp/org/org-indent.el @@ -1,4 +1,5 @@ -;;; org-indent.el --- Dynamic indentation for Org-mode +;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*- + ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik @@ -39,8 +40,7 @@ (require 'org-compat) (require 'org) -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (declare-function org-inlinetask-get-task-level "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) @@ -52,20 +52,6 @@ :tag "Org Indent" :group 'org) -(defconst org-indent-max 40 - "Maximum indentation in characters.") -(defconst org-indent-max-levels 20 - "Maximum added level through virtual indentation, in characters. - -It is computed by multiplying `org-indent-indentation-per-level' -minus one by actual level of the headline minus one.") - -(defvar org-indent-strings nil - "Vector with all indentation strings. -It will be set in `org-indent-initialize'.") -(defvar org-indent-stars nil - "Vector with all indentation star strings. -It will be set in `org-indent-initialize'.") (defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning)) "First star of inline tasks, with correct face.") (defvar org-indent-agent-timer nil @@ -82,7 +68,7 @@ Delay used when the buffer to initialize is current.") Delay used when the buffer to initialize isn't current.") (defvar org-indent-agent-resume-delay '(0 0 100000) "Minimal time for other idle processes before switching back to agent.") -(defvar org-indent-initial-marker nil +(defvar org-indent--initial-marker nil "Position of initialization before interrupt. This is used locally in each buffer being initialized.") (defvar org-hide-leading-stars-before-indent-mode nil @@ -92,15 +78,12 @@ This is used locally in each buffer being initialized.") It is modified by `org-indent-notify-modified-headline'.") -(defcustom org-indent-boundary-char ?\ ; comment to protect space char +(defcustom org-indent-boundary-char ?\s "The end of the virtual indentation strings, a single-character string. The default is just a space, but if you wish, you can use \"|\" or so. This can be useful on a terminal window - under a windowing system, -it may be prettier to customize the org-indent face." +it may be prettier to customize the `org-indent' face." :group 'org-indent - :set (lambda (var val) - (set var val) - (and org-indent-strings (org-indent-initialize))) :type 'character) (defcustom org-indent-mode-turns-off-org-adapt-indentation t @@ -121,29 +104,56 @@ turn on `org-hide-leading-stars'." :group 'org-indent :type 'integer) -(defface org-indent - (org-compatible-face nil nil) +(defface org-indent '((t (:inherit org-hide))) "Face for outline indentation. The default is to make it look like whitespace. But you may find it useful to make it ever so slightly different." :group 'org-faces) -(defun org-indent-initialize () - "Initialize the indentation strings." - (setq org-indent-strings (make-vector (1+ org-indent-max) nil)) - (setq org-indent-stars (make-vector (1+ org-indent-max) nil)) - (aset org-indent-strings 0 nil) - (aset org-indent-stars 0 nil) - (loop for i from 1 to org-indent-max do - (aset org-indent-strings i - (org-add-props - (concat (make-string (1- i) ?\ ) - (char-to-string org-indent-boundary-char)) +(defvar org-indent--text-line-prefixes nil + "Vector containing line prefixes strings for regular text.") + +(defvar org-indent--heading-line-prefixes nil + "Vector containing line prefix strings for headlines.") + +(defvar org-indent--inlinetask-line-prefixes nil + "Vector containing line prefix strings for inline tasks.") + +(defconst org-indent--deepest-level 50 + "Maximum theoretical headline depth.") + +(defun org-indent--compute-prefixes () + "Compute prefix strings for regular text and headlines." + (setq org-indent--heading-line-prefixes + (make-vector org-indent--deepest-level nil)) + (setq org-indent--inlinetask-line-prefixes + (make-vector org-indent--deepest-level nil)) + (setq org-indent--text-line-prefixes + (make-vector org-indent--deepest-level nil)) + (dotimes (n org-indent--deepest-level) + (let ((indentation (if (<= n 1) 0 + (* (1- org-indent-indentation-per-level) + (1- n))))) + ;; Headlines line prefixes. + (let ((heading-prefix (make-string indentation ?*))) + (aset org-indent--heading-line-prefixes + n + (org-add-props heading-prefix nil 'face 'org-indent)) + ;; Inline tasks line prefixes + (aset org-indent--inlinetask-line-prefixes + n + (org-add-props (if (bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring heading-prefix 1)) + heading-prefix) nil 'face 'org-indent))) - (loop for i from 1 to org-indent-max-levels do - (aset org-indent-stars i - (org-add-props (make-string i ?*) - nil 'face 'org-hide)))) + ;; Text line prefixes. + (aset org-indent--text-line-prefixes + n + (concat (org-add-props (make-string (+ n indentation) ?\s) + nil 'face 'org-indent) + (and (> n 0) + (char-to-string org-indent-boundary-char))))))) (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." @@ -162,34 +172,25 @@ buffer, which can take a few seconds on large buffers, is done during idle time." nil " Ind" nil (cond - ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refusing to turn it on") - (setq org-indent-mode nil)) - ((and org-indent-mode - (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") - (ding) - (sit-for 1) - (setq org-indent-mode nil)) (org-indent-mode ;; mode was turned on. - (org-set-local 'indent-tabs-mode nil) - (or org-indent-strings (org-indent-initialize)) - (org-set-local 'org-indent-initial-marker (copy-marker 1)) + (setq-local indent-tabs-mode nil) + (setq-local org-indent--initial-marker (copy-marker 1)) (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) + (setq-local org-adapt-indentation nil)) (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (org-add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete))) - nil t) - (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) - (org-add-hook 'before-change-functions - 'org-indent-notify-modified-headline nil 'local) + (setq-local org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (setq-local org-hide-leading-stars t)) + (org-indent--compute-prefixes) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete))) + nil t) + (add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) + (add-hook 'before-change-functions + 'org-indent-notify-modified-headline nil 'local) (and font-lock-mode (org-restart-font-lock)) (org-indent-remove-properties (point-min) (point-max)) ;; Submit current buffer to initialize agent. If it's the first @@ -205,11 +206,11 @@ during idle time." (kill-local-variable 'org-adapt-indentation) (setq org-indent-agentized-buffers (delq (current-buffer) org-indent-agentized-buffers)) - (when (markerp org-indent-initial-marker) - (set-marker org-indent-initial-marker nil)) + (when (markerp org-indent--initial-marker) + (set-marker org-indent--initial-marker nil)) (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) + (setq-local org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) (remove-hook 'filter-buffer-substring-functions (lambda (fun start end delete) (org-indent-remove-properties-from-string @@ -245,7 +246,7 @@ When no more buffer is being watched, the agent suppress itself." (when org-indent-agent-resume-timer (cancel-timer org-indent-agent-resume-timer)) (setq org-indent-agentized-buffers - (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) + (cl-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) (cond ;; Job done: kill agent. ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer)) @@ -269,46 +270,44 @@ a time value." (let ((interruptp ;; Always nil unless interrupted. (catch 'interrupt - (and org-indent-initial-marker - (marker-position org-indent-initial-marker) - (org-indent-add-properties org-indent-initial-marker + (and org-indent--initial-marker + (marker-position org-indent--initial-marker) + (equal (marker-buffer org-indent--initial-marker) + buffer) + (org-indent-add-properties org-indent--initial-marker (point-max) delay) nil)))) - (move-marker org-indent-initial-marker interruptp) + (move-marker org-indent--initial-marker interruptp) ;; Job is complete: un-agentize buffer. (unless interruptp (setq org-indent-agentized-buffers (delq buffer org-indent-agentized-buffers)))))))) -(defsubst org-indent-set-line-properties (l w h) +(defun org-indent-set-line-properties (level indentation &optional heading) "Set prefix properties on current line an move to next one. -Prefix properties `line-prefix' and `wrap-prefix' in current line -are set to, respectively, length L and W. - -If H is non-nil, `line-prefix' will be starred. If H is -`inline', the first star will have `org-warning' face. - -Assume point is at beginning of line." - (let ((line (cond - ((eq 'inline h) - (let ((stars (aref org-indent-stars - (min l org-indent-max-levels)))) - (and stars - (if (org-bound-and-true-p org-inlinetask-show-first-star) - (concat org-indent-inlinetask-first-star - (substring stars 1)) - stars)))) - (h (aref org-indent-stars - (min l org-indent-max-levels))) - (t (aref org-indent-strings - (min l org-indent-max))))) - (wrap (aref org-indent-strings (min w org-indent-max)))) +LEVEL is the current level of heading. INDENTATION is the +expected indentation when wrapping line. + +When optional argument HEADING is non-nil, assume line is at +a heading. Moreover, if is is `inlinetask', the first star will +have `org-warning' face." + (let* ((line (aref (pcase heading + (`nil org-indent--text-line-prefixes) + (`inlinetask org-indent--inlinetask-line-prefixes) + (_ org-indent--heading-line-prefixes)) + level)) + (wrap + (org-add-props + (concat line + (if heading (concat (make-string level ?*) " ") + (make-string indentation ?\s))) + nil 'face 'org-indent))) ;; Add properties down to the next line to indent empty lines. - (add-text-properties (point) (min (1+ (point-at-eol)) (point-max)) + (add-text-properties (line-beginning-position) (line-beginning-position 2) `(line-prefix ,line wrap-prefix ,wrap))) - (forward-line 1)) + (forward-line)) (defun org-indent-add-properties (beg end &optional delay) "Add indentation properties between BEG and END. @@ -322,26 +321,14 @@ stopped." (org-with-wide-buffer (goto-char beg) (beginning-of-line) - ;; 1. Initialize prefix at BEG. This is done by storing two - ;; variables: INLINE-PF and PF, representing respectively - ;; length of current `line-prefix' when line is inside an - ;; inline task or not. + ;; Initialize prefix at BEG, according to current entry's level. (let* ((case-fold-search t) (limited-re (org-get-limited-outline-regexp)) - (added-ind-per-lvl (abs (1- org-indent-indentation-per-level))) - (pf (save-excursion - (and (ignore-errors (let ((outline-regexp limited-re)) - (org-back-to-heading t))) - (+ (* org-indent-indentation-per-level - (- (match-end 0) (match-beginning 0) 2)) 2)))) - (pf-inline (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (+ (* org-indent-indentation-per-level - (1- (org-inlinetask-get-task-level))) 2))) + (level (or (org-current-level) 0)) (time-limit (and delay (time-add (current-time) delay)))) - ;; 2. For each line, set `line-prefix' and `wrap-prefix' - ;; properties depending on the type of line (headline, - ;; inline task, item or other). + ;; For each line, set `line-prefix' and `wrap-prefix' + ;; properties depending on the type of line (headline, inline + ;; task, item or other). (org-with-silent-modifications (while (and (<= (point) end) (not (eobp))) (cond @@ -354,38 +341,23 @@ stopped." ((and delay (time-less-p time-limit (current-time))) (setq org-indent-agent-resume-timer (run-with-idle-timer - (time-add (current-idle-time) - org-indent-agent-resume-delay) + (time-add (current-idle-time) org-indent-agent-resume-delay) nil #'org-indent-initialize-agent)) (throw 'interrupt (point))) ;; Headline or inline task. ((looking-at org-outline-regexp) (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (line (* added-ind-per-lvl (1- nstars))) - (wrap (+ line (1+ nstars)))) - (cond - ;; Headline: new value for PF. - ((looking-at limited-re) - (org-indent-set-line-properties line wrap t) - (setq pf wrap)) - ;; End of inline task: PF-INLINE is now nil. - ((looking-at "\\*+ end[ \t]*$") - (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline nil)) - ;; Start of inline task. Determine if it contains - ;; text, or if it is only one line long. Set - ;; PF-INLINE accordingly. - (t (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) + (type (or (looking-at-p limited-re) 'inlinetask))) + (org-indent-set-line-properties nstars 0 type) + ;; At an headline, define new value for LEVEL. + (unless (eq type 'inlinetask) (setq level nstars)))) ;; List item: `wrap-prefix' is set where body starts. ((org-at-item-p) - (let* ((line (or pf-inline pf 0)) - (wrap (+ (org-list-item-body-column (point)) line))) - (org-indent-set-line-properties line wrap nil))) - ;; Normal line: use PF-INLINE, PF or nil as prefixes. - (t (let* ((line (or pf-inline pf 0)) - (wrap (+ line (org-get-indentation)))) - (org-indent-set-line-properties line wrap nil)))))))))) + (org-indent-set-line-properties + level (org-list-item-body-column (point)))) + ;; Regular line. + (t + (org-indent-set-line-properties level (org-get-indentation)))))))))) (defun org-indent-notify-modified-headline (beg end) "Set `org-indent-modified-headline-flag' depending on context. @@ -398,13 +370,14 @@ Flag will be non-nil if command is going to modify or delete an headline." (when org-indent-mode (setq org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (save-match-data - (or (and (org-at-heading-p) (< beg (match-end 0))) - (re-search-forward org-outline-regexp-bol end t))))))) - -(defun org-indent-refresh-maybe (beg end dummy) + (org-with-wide-buffer + (goto-char beg) + (save-match-data + (or (and (org-at-heading-p) (< beg (match-end 0))) + (re-search-forward + (org-with-limited-levels org-outline-regexp-bol) end t))))))) + +(defun org-indent-refresh-maybe (beg end _) "Refresh indentation properties in an adequate portion of buffer. BEG and END are the positions of the beginning and end of the range of inserted text. DUMMY is an unused argument. @@ -414,19 +387,21 @@ This function is meant to be called by `after-change-functions'." (save-match-data ;; If a headline was modified or inserted, set properties until ;; next headline. - (if (or org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (beginning-of-line) - (re-search-forward org-outline-regexp-bol end t))) - (let ((end (save-excursion - (goto-char end) - (org-with-limited-levels (outline-next-heading)) - (point)))) - (setq org-indent-modified-headline-flag nil) - (org-indent-add-properties beg end)) - ;; Otherwise, only set properties on modified area. - (org-indent-add-properties beg end))))) + (org-with-wide-buffer + (if (or org-indent-modified-headline-flag + (save-excursion + (goto-char beg) + (beginning-of-line) + (re-search-forward + (org-with-limited-levels org-outline-regexp-bol) end t))) + (let ((end (save-excursion + (goto-char end) + (org-with-limited-levels (outline-next-heading)) + (point)))) + (setq org-indent-modified-headline-flag nil) + (org-indent-add-properties beg end)) + ;; Otherwise, only set properties on modified area. + (org-indent-add-properties beg end)))))) (provide 'org-indent) diff --git a/lisp/org/org-info.el b/lisp/org/org-info.el index c8f6f06de0..79b9bcc3d9 100644 --- a/lisp/org/org-info.el +++ b/lisp/org/org-info.el @@ -1,4 +1,4 @@ -;;; org-info.el --- Support for links to Info nodes from within Org-Mode +;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,8 +24,8 @@ ;; ;;; Commentary: -;; This file implements links to Info nodes from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to Info nodes from within Org mode. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -40,19 +40,20 @@ (defvar Info-current-node) ;; Install the link type -(org-add-link-type "info" 'org-info-open) -(add-hook 'org-store-link-functions 'org-info-store-link) +(org-link-set-parameters "info" + :follow #'org-info-open + :export #'org-info-export + :store #'org-info-store-link) ;; Implementation (defun org-info-store-link () "Store a link to an Info file and node." (when (eq major-mode 'Info-mode) - (let (link desc) - (setq link (concat "info:" - (file-name-nondirectory Info-current-file) - "#" Info-current-node)) - (setq desc (concat (file-name-nondirectory Info-current-file) - "#" Info-current-node)) + (let ((link (concat "info:" + (file-name-nondirectory Info-current-file) + "#" Info-current-node)) + (desc (concat (file-name-nondirectory Info-current-file) + "#" Info-current-node))) (org-store-link-props :type "info" :file Info-current-file :node Info-current-node :link link :desc desc) @@ -67,12 +68,76 @@ "Follow an Info file and node link specified by NAME." (if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name) (string-match "\\(.*\\)" name)) - (progn + (let ((filename (match-string 1 name)) + (nodename-or-index (or (match-string 2 name) "Top"))) (require 'info) - (if (match-string 2 name) ; If there isn't a node, choose "Top" - (Info-find-node (match-string 1 name) (match-string 2 name)) - (Info-find-node (match-string 1 name) "Top"))) - (message "Could not open: %s" name))) + ;; If nodename-or-index is invalid node name, then look it up + ;; in the index. + (condition-case nil + (Info-find-node filename nodename-or-index) + (user-error (Info-find-node filename "Top") + (condition-case nil + (Info-index nodename-or-index) + (user-error "Could not find '%s' node or index entry" + nodename-or-index))))) + (user-error "Could not open: %s" name))) + +(defconst org-info-emacs-documents + '("ada-mode" "auth" "autotype" "bovine" "calc" "ccmode" "cl" "dbus" "dired-x" + "ebrowse" "ede" "ediff" "edt" "efaq-w32" "efaq" "eieio" "eintr" "elisp" + "emacs-gnutls" "emacs-mime" "emacs" "epa" "erc" "ert" "eshell" "eudc" "eww" + "flymake" "forms" "gnus" "htmlfontify" "idlwave" "ido" "info" "mairix-el" + "message" "mh-e" "newsticker" "nxml-mode" "octave-mode" "org" "pcl-cvs" + "pgg" "rcirc" "reftex" "remember" "sasl" "sc" "semantic" "ses" "sieve" + "smtpmail" "speedbar" "srecode" "todo-mode" "tramp" "url" "vip" "viper" + "widget" "wisent" "woman") + "List of emacs documents available. +Taken from ") + +(defconst org-info-other-documents + '(("libc" . "http://www.gnu.org/software/libc/manual/html_mono/libc.html") + ("make" . "http://www.gnu.org/software/make/manual/make.html")) + "Alist of documents generated from Texinfo source. +When converting info links to HTML, links to any one of these manuals are +converted to use these URL.") + +(defun org-info-map-html-url (filename) + "Return URL or HTML file associated to Info FILENAME. +If FILENAME refers to an official GNU document, return a URL pointing to +the official page for that document, e.g., use \"gnu.org\" for all Emacs +related documents. Otherwise, append \".html\" extension to FILENAME. +See `org-info-emacs-documents' and `org-info-other-documents' for details." + (cond ((member filename org-info-emacs-documents) + (format "http://www.gnu.org/software/emacs/manual/html_mono/%s.html" + filename)) + ((cdr (assoc filename org-info-other-documents))) + (t (concat filename ".html")))) + +(defun org-info--expand-node-name (node) + "Expand Info NODE to HTML cross reference." + ;; See (info "(texinfo) HTML Xref Node Name Expansion") for the + ;; expansion rule. + (let ((node (replace-regexp-in-string + "\\([ \t\n\r]+\\)\\|\\([^a-zA-Z0-9]\\)" + (lambda (m) + (if (match-end 1) "-" (format "_%04x" (string-to-char m)))) + (org-trim node)))) + (cond ((string= node "") "") + ((string-match-p "\\`[0-9]" node) (concat "g_t" node)) + (t node)))) + +(defun org-info-export (path desc format) + "Export an info link. +See `org-link-parameters' for details about PATH, DESC and FORMAT." + (when (eq format 'html) + (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" path) + (string-match "\\(.*\\)" path)) + (let ((filename (match-string 1 path)) + (node (or (match-string 2 path) "Top"))) + (format "%s" + (org-info-map-html-url filename) + (org-info--expand-node-name node) + (or desc path))))) (provide 'org-info) diff --git a/lisp/org/org-inlinetask.el b/lisp/org/org-inlinetask.el index bf4ab205a4..2918d4061d 100644 --- a/lisp/org/org-inlinetask.el +++ b/lisp/org/org-inlinetask.el @@ -1,4 +1,4 @@ -;;; org-inlinetask.el --- Tasks independent of outline hierarchy +;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; @@ -26,7 +26,7 @@ ;; ;;; Commentary: ;; -;; This module implements inline tasks in Org-mode. Inline tasks are +;; This module implements inline tasks in Org mode. Inline tasks are ;; tasks that have all the properties of normal outline nodes, ;; including the ability to store meta data like scheduling dates, ;; TODO state, tags and properties. However, these nodes are treated @@ -108,7 +108,6 @@ When nil, the first star is not shown." (defvar org-odd-levels-only) (defvar org-keyword-time-regexp) -(defvar org-drawer-regexp) (defvar org-complex-heading-regexp) (defvar org-property-end-re) @@ -168,9 +167,9 @@ The number of levels is controlled by `org-inlinetask-min-level'." (stars-re (org-inlinetask-outline-regexp)) (task-beg-re (concat stars-re "\\(?:.*\\)")) (task-end-re (concat stars-re "END[ \t]*$"))) - (or (org-looking-at-p task-beg-re) + (or (looking-at-p task-beg-re) (and (re-search-forward "^\\*+[ \t]+" nil t) - (progn (beginning-of-line) (org-looking-at-p task-end-re))))))) + (progn (beginning-of-line) (looking-at-p task-end-re))))))) (defun org-inlinetask-goto-beginning () "Go to the beginning of the inline task at point." @@ -178,7 +177,7 @@ The number of levels is controlled by `org-inlinetask-min-level'." (let ((case-fold-search t) (inlinetask-re (org-inlinetask-outline-regexp))) (re-search-backward inlinetask-re nil t) - (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$")) + (when (looking-at-p (concat inlinetask-re "END[ \t]*$")) (re-search-backward inlinetask-re nil t)))) (defun org-inlinetask-goto-end () @@ -190,17 +189,16 @@ Return point." (inlinetask-re (org-inlinetask-outline-regexp)) (task-end-re (concat inlinetask-re "END[ \t]*$"))) (cond - ((looking-at task-end-re) (forward-line)) + ((looking-at task-end-re)) ((looking-at inlinetask-re) (forward-line) (cond - ((looking-at task-end-re) (forward-line)) + ((looking-at task-end-re)) ((looking-at inlinetask-re)) ((org-inlinetask-in-task-p) - (re-search-forward inlinetask-re nil t) - (forward-line)))) - (t (re-search-forward inlinetask-re nil t) - (forward-line))) + (re-search-forward inlinetask-re nil t)))) + (t (re-search-forward inlinetask-re nil t))) + (end-of-line) (point)))) (defun org-inlinetask-get-task-level () @@ -273,8 +271,7 @@ If the task has an end part, also demote it." (defvar org-indent-indentation-per-level) ; defined in org-indent.el -(defface org-inlinetask - (org-compatible-face 'shadow '((t (:bold t)))) +(defface org-inlinetask '((t :inherit shadow)) "Face for inlinetask headlines." :group 'org-faces) @@ -288,7 +285,7 @@ If the task has an end part, also demote it." ",\\}\\)\\(\\*\\* .*\\)")) ;; Virtual indentation will add the warning face on the first ;; star. Thus, in that case, only hide it. - (start-face (if (and (org-bound-and-true-p org-indent-mode) + (start-face (if (and (bound-and-true-p org-indent-mode) (> org-indent-indentation-per-level 1)) 'org-hide 'org-warning))) @@ -315,19 +312,36 @@ If the task has an end part, also demote it." ;; Nothing to show/hide. ((= end start)) ;; Inlinetask was folded: expand it. - ((get-char-property (1+ start) 'invisible) + ((eq (get-char-property (1+ start) 'invisible) 'outline) (outline-flag-region start end nil) (org-cycle-hide-drawers 'children)) (t (outline-flag-region start end t))))) +(defun org-inlinetask-hide-tasks (state) + "Hide inline tasks in buffer when STATE is `contents' or `children'. +This function is meant to be used in `org-cycle-hook'." + (pcase state + (`contents + (let ((regexp (org-inlinetask-outline-regexp))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (org-inlinetask-toggle-visibility) + (org-inlinetask-goto-end))))) + (`children + (save-excursion + (while (and (outline-next-heading) (org-inlinetask-at-task-p)) + (org-inlinetask-toggle-visibility) + (org-inlinetask-goto-end)))))) + (defun org-inlinetask-remove-END-maybe () "Remove an END line when present." (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" org-inlinetask-min-level)) (replace-match ""))) -(eval-after-load "org" - '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) +(add-hook 'org-font-lock-hook 'org-inlinetask-fontify) +(add-hook 'org-cycle-hook 'org-inlinetask-hide-tasks) (provide 'org-inlinetask) diff --git a/lisp/org/org-irc.el b/lisp/org/org-irc.el index 1243587beb..3a6a7f4db0 100644 --- a/lisp/org/org-irc.el +++ b/lisp/org/org-irc.el @@ -1,4 +1,4 @@ -;;; org-irc.el --- Store links to IRC sessions +;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; @@ -22,8 +22,8 @@ ;;; Commentary: -;; This file implements links to an IRC session from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to an IRC session from within Org mode. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;; ;; Please customize the variable `org-modules' to select @@ -59,8 +59,6 @@ (declare-function erc-server-buffer "erc" ()) (declare-function erc-get-server-nickname-list "erc" ()) (declare-function erc-cmd-JOIN "erc" (channel &optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) (defvar org-irc-client 'erc "The IRC client to act on.") @@ -73,9 +71,7 @@ ;; Generic functions/config (extend these for other clients) -(add-to-list 'org-store-link-functions 'org-irc-store-link) - -(org-add-link-type "irc" 'org-irc-visit nil) +(org-link-set-parameters "irc" :follow #'org-irc-visit :store #'org-irc-store-link) (defun org-irc-visit (link) "Parse LINK and dispatch to the correct function based on the client found." @@ -114,11 +110,9 @@ chars that the value AFTER with `...'" (cons "[ \t]*$" "") (cons (concat "^\\(.\\{" after "\\}\\).*") "\\1...")))) - (mapc (lambda (x) - (when (string-match (car x) string) - (setq string (replace-match (cdr x) nil nil string)))) - replace-map) - string)) + (dolist (x replace-map string) + (when (string-match (car x) string) + (setq string (replace-match (cdr x) nil nil string)))))) ;; ERC specific functions @@ -233,7 +227,7 @@ default." (throw 'found x)))))) (if chan-buf (progn - (org-pop-to-buffer-same-window chan-buf) + (pop-to-buffer-same-window chan-buf) ;; if we got a nick, and they're in the chan, ;; then start a chat with them (let ((nick (pop link))) @@ -244,9 +238,9 @@ default." (insert (concat nick ": "))) (error "%s not found in %s" nick chan-name))))) (progn - (org-pop-to-buffer-same-window server-buffer) + (pop-to-buffer-same-window server-buffer) (erc-cmd-JOIN chan-name)))) - (org-pop-to-buffer-same-window server-buffer))) + (pop-to-buffer-same-window server-buffer))) ;; no server match, make new connection (erc-select :server server :port port)))) diff --git a/lisp/org/org-lint.el b/lisp/org/org-lint.el new file mode 100644 index 0000000000..89aed4bbb1 --- /dev/null +++ b/lisp/org/org-lint.el @@ -0,0 +1,1225 @@ +;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2017 Free Software Foundation + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program 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. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; This library implements linting for Org syntax. The sole public +;; function is `org-lint', which see. + +;; Internally, the library defines a new structure: +;; `org-lint-checker', with the following slots: + +;; - NAME: Unique check identifier, as a non-nil symbol that doesn't +;; start with an hyphen. +;; +;; The check is done calling the function `org-lint-NAME' with one +;; mandatory argument, the parse tree describing the current Org +;; buffer. Such function calls are wrapped within +;; a `save-excursion' and point is always at `point-min'. Its +;; return value has to be an alist (POSITION MESSAGE) when +;; POSITION refer to the buffer position of the error, as an +;; integer, and MESSAGE is a string describing the error. + +;; - DESCRIPTION: Summary about the check, as a string. + +;; - CATEGORIES: Categories relative to the check, as a list of +;; symbol. They are used for filtering when calling `org-lint'. +;; Checkers not explicitly associated to a category are collected +;; in the `default' one. + +;; - TRUST: The trust level one can have in the check. It is either +;; `low' or `high', depending on the heuristics implemented and +;; the nature of the check. This has an indicative value only and +;; is displayed along reports. + +;; All checks have to be listed in `org-lint--checkers'. + +;; Results are displayed in a special "*Org Lint*" buffer with +;; a dedicated major mode, derived from `tabulated-list-mode'. +;; +;; In addition to the usual key-bindings inherited from it, "C-j" and +;; "TAB" display problematic line reported under point whereas "RET" +;; jumps to it. Also, "h" hides all reports similar to the current +;; one. Additionally, "i" removes them from subsequent reports. + +;; Checks currently implemented are: + +;; - duplicate CUSTOM_ID properties +;; - duplicate NAME values +;; - duplicate targets +;; - duplicate footnote definitions +;; - orphaned affiliated keywords +;; - obsolete affiliated keywords +;; - missing language in src blocks +;; - missing back-end in export blocks +;; - invalid Babel call blocks +;; - NAME values with a colon +;; - deprecated export block syntax +;; - deprecated Babel header properties +;; - wrong header arguments in src blocks +;; - misuse of CATEGORY keyword +;; - "coderef" links with unknown destination +;; - "custom-id" links with unknown destination +;; - "fuzzy" links with unknown destination +;; - "id" links with unknown destination +;; - links to non-existent local files +;; - SETUPFILE keywords with non-existent file parameter +;; - INCLUDE keywords with wrong link parameter +;; - obsolete markup in INCLUDE keyword +;; - unknown items in OPTIONS keyword +;; - spurious macro arguments or invalid macro templates +;; - special properties in properties drawer +;; - obsolete syntax for PROPERTIES drawers +;; - missing definition for footnote references +;; - missing reference for footnote definitions +;; - non-footnote definitions in footnote section +;; - probable invalid keywords +;; - invalid blocks +;; - misplaced planning info line +;; - incomplete drawers +;; - indented diary-sexps +;; - obsolete QUOTE section +;; - obsolete "file+application" link +;; - blank headlines with tags + + +;;; Code: + +(require 'cl-lib) +(require 'org-element) +(require 'org-macro) +(require 'ox) +(require 'ob) + + +;;; Checkers + +(cl-defstruct (org-lint-checker (:copier nil)) + (name 'missing-checker-name) + (description "") + (categories '(default)) + (trust 'high)) ; `low' or `high' + +(defun org-lint-missing-checker-name (_) + (error + "`A checker has no `:name' property. Please verify `org-lint--checkers'")) + +(defconst org-lint--checkers + (list + (make-org-lint-checker + :name 'duplicate-custom-id + :description "Report duplicates CUSTOM_ID properties" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-name + :description "Report duplicate NAME values" + :categories '(babel link)) + (make-org-lint-checker + :name 'duplicate-target + :description "Report duplicate targets" + :categories '(link)) + (make-org-lint-checker + :name 'duplicate-footnote-definition + :description "Report duplicate footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'orphaned-affiliated-keywords + :description "Report orphaned affiliated keywords" + :trust 'low) + (make-org-lint-checker + :name 'obsolete-affiliated-keywords + :description "Report obsolete affiliated keywords" + :categories '(obsolete)) + (make-org-lint-checker + :name 'deprecated-export-blocks + :description "Report deprecated export block syntax" + :categories '(obsolete export) + :trust 'low) + (make-org-lint-checker + :name 'deprecated-header-syntax + :description "Report deprecated Babel header syntax" + :categories '(obsolete babel) + :trust 'low) + (make-org-lint-checker + :name 'missing-language-in-src-block + :description "Report missing language in src blocks" + :categories '(babel)) + (make-org-lint-checker + :name 'missing-backend-in-export-block + :description "Report missing back-end in export blocks" + :categories '(export)) + (make-org-lint-checker + :name 'invalid-babel-call-block + :description "Report invalid Babel call blocks" + :categories '(babel)) + (make-org-lint-checker + :name 'colon-in-name + :description "Report NAME values with a colon" + :categories '(babel)) + (make-org-lint-checker + :name 'wrong-header-argument + :description "Report wrong babel headers" + :categories '(babel)) + (make-org-lint-checker + :name 'wrong-header-value + :description "Report invalid value in babel headers" + :categories '(babel) + :trust 'low) + (make-org-lint-checker + :name 'deprecated-category-setup + :description "Report misuse of CATEGORY keyword" + :categories '(obsolete)) + (make-org-lint-checker + :name 'invalid-coderef-link + :description "Report \"coderef\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-custom-id-link + :description "Report \"custom-id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-fuzzy-link + :description "Report \"fuzzy\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'invalid-id-link + :description "Report \"id\" links with unknown destination" + :categories '(link)) + (make-org-lint-checker + :name 'link-to-local-file + :description "Report links to non-existent local files" + :categories '(link) + :trust 'low) + (make-org-lint-checker + :name 'non-existent-setupfile-parameter + :description "Report SETUPFILE keywords with non-existent file parameter" + :trust 'low) + (make-org-lint-checker + :name 'wrong-include-link-parameter + :description "Report INCLUDE keywords with misleading link parameter" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'obsolete-include-markup + :description "Report obsolete markup in INCLUDE keyword" + :categories '(obsolete export) + :trust 'low) + (make-org-lint-checker + :name 'unknown-options-item + :description "Report unknown items in OPTIONS keyword" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'invalid-macro-argument-and-template + :description "Report spurious macro arguments or invalid macro templates" + :categories '(export) + :trust 'low) + (make-org-lint-checker + :name 'special-property-in-properties-drawer + :description "Report special properties in properties drawers" + :categories '(properties)) + (make-org-lint-checker + :name 'obsolete-properties-drawer + :description "Report obsolete syntax for properties drawers" + :categories '(obsolete properties)) + (make-org-lint-checker + :name 'undefined-footnote-reference + :description "Report missing definition for footnote references" + :categories '(footnote)) + (make-org-lint-checker + :name 'unreferenced-footnote-definition + :description "Report missing reference for footnote definitions" + :categories '(footnote)) + (make-org-lint-checker + :name 'extraneous-element-in-footnote-section + :description "Report non-footnote definitions in footnote section" + :categories '(footnote)) + (make-org-lint-checker + :name 'invalid-keyword-syntax + :description "Report probable invalid keywords" + :trust 'low) + (make-org-lint-checker + :name 'invalid-block + :description "Report invalid blocks" + :trust 'low) + (make-org-lint-checker + :name 'misplaced-planning-info + :description "Report misplaced planning info line" + :trust 'low) + (make-org-lint-checker + :name 'incomplete-drawer + :description "Report probable incomplete drawers" + :trust 'low) + (make-org-lint-checker + :name 'indented-diary-sexp + :description "Report probable indented diary-sexps" + :trust 'low) + (make-org-lint-checker + :name 'quote-section + :description "Report obsolete QUOTE section" + :categories '(obsolete) + :trust 'low) + (make-org-lint-checker + :name 'file-application + :description "Report obsolete \"file+application\" link" + :categories '(link obsolete)) + (make-org-lint-checker + :name 'empty-headline-with-tags + :description "Report ambiguous empty headlines with tags" + :categories '(headline) + :trust 'low)) + "List of all available checkers.") + +(defun org-lint--collect-duplicates + (ast type extract-key extract-position build-message) + "Helper function to collect duplicates in parse tree AST. + +EXTRACT-KEY is a function extracting key. It is called with +a single argument: the element or object. Comparison is done +with `equal'. + +EXTRACT-POSITION is a function returning position for the report. +It is called with two arguments, the object or element, and the +key. + +BUILD-MESSAGE is a function creating the report message. It is +called with one argument, the key used for comparison." + (let* (keys + originals + reports + (make-report + (lambda (position value) + (push (list position (funcall build-message value)) reports)))) + (org-element-map ast type + (lambda (datum) + (let ((key (funcall extract-key datum))) + (cond + ((not key)) + ((assoc key keys) (cl-pushnew (assoc key keys) originals) + (funcall make-report (funcall extract-position datum key) key)) + (t (push (cons key (funcall extract-position datum key)) keys)))))) + (dolist (e originals reports) (funcall make-report (cdr e) (car e))))) + +(defun org-lint-duplicate-custom-id (ast) + (org-lint--collect-duplicates + ast + 'node-property + (lambda (property) + (and (eq (compare-strings "CUSTOM_ID" nil nil + (org-element-property :key property) nil nil + t) + t) + (org-element-property :value property))) + (lambda (property _) (org-element-property :begin property)) + (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key)))) + +(defun org-lint-duplicate-name (ast) + (org-lint--collect-duplicates + ast + org-element-all-elements + (lambda (datum) (org-element-property :name datum)) + (lambda (datum name) + (goto-char (org-element-property :begin datum)) + (re-search-forward + (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name))) + (match-beginning 0)) + (lambda (key) (format "Duplicate NAME \"%s\"" key)))) + +(defun org-lint-duplicate-target (ast) + (org-lint--collect-duplicates + ast + 'target + (lambda (target) (org-split-string (org-element-property :value target))) + (lambda (target _) (org-element-property :begin target)) + (lambda (key) + (format "Duplicate target <<%s>>" (mapconcat #'identity key " "))))) + +(defun org-lint-duplicate-footnote-definition (ast) + (org-lint--collect-duplicates + ast + 'footnote-definition + (lambda (definition) (org-element-property :label definition)) + (lambda (definition _) (org-element-property :post-affiliated definition)) + (lambda (key) (format "Duplicate footnote definition \"%s\"" key)))) + +(defun org-lint-orphaned-affiliated-keywords (ast) + ;; Ignore orphan RESULTS keywords, which could be generated from + ;; a source block returning no value. + (let ((keywords (cl-set-difference org-element-affiliated-keywords + '("RESULT" "RESULTS") + :test #'equal))) + (org-element-map ast 'keyword + (lambda (k) + (let ((key (org-element-property :key k))) + (and (or (let ((case-fold-search t)) + (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key)) + (member key keywords)) + (list (org-element-property :post-affiliated k) + (format "Orphaned affiliated keyword: \"%s\"" key)))))))) + +(defun org-lint-obsolete-affiliated-keywords (_) + (let ((regexp (format "^[ \t]*#\\+%s:" + (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE" + "SRCNAME" "TBLNAME" "RESULT" "HEADERS") + t))) + reports) + (while (re-search-forward regexp nil t) + (let ((key (upcase (match-string-no-properties 1)))) + (when (< (point) + (org-element-property :post-affiliated (org-element-at-point))) + (push + (list (line-beginning-position) + (format + "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead" + key + (pcase key + ("HEADERS" "HEADER") + ("RESULT" "RESULTS") + (_ "NAME")))) + reports)))) + reports)) + +(defun org-lint-deprecated-export-blocks (ast) + (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" + "ODT" "ORG" "TEXINFO"))) + (org-element-map ast 'special-block + (lambda (b) + (let ((type (org-element-property :type b))) + (when (member-ignore-case type deprecated) + (list + (org-element-property :post-affiliated b) + (format + "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \ +instead" + type)))))))) + +(defun org-lint-deprecated-header-syntax (ast) + (let* ((deprecated-babel-properties + (mapcar (lambda (arg) (symbol-name (car arg))) + org-babel-common-header-args-w-values)) + (deprecated-re + (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t)))) + (org-element-map ast '(keyword node-property) + (lambda (datum) + (let ((key (org-element-property :key datum))) + (pcase (org-element-type datum) + (`keyword + (let ((value (org-element-property :value datum))) + (and (string= key "PROPERTY") + (string-match deprecated-re value) + (list (org-element-property :begin datum) + (format "Deprecated syntax for \"%s\". \ +Use header-args instead" + (match-string-no-properties 1 value)))))) + (`node-property + (and (member-ignore-case key deprecated-babel-properties) + (list + (org-element-property :begin datum) + (format "Deprecated syntax for \"%s\". \ +Use :header-args: instead" + key)))))))))) + +(defun org-lint-missing-language-in-src-block (ast) + (org-element-map ast 'src-block + (lambda (b) + (unless (org-element-property :language b) + (list (org-element-property :post-affiliated b) + "Missing language in source block"))))) + +(defun org-lint-missing-backend-in-export-block (ast) + (org-element-map ast 'export-block + (lambda (b) + (unless (org-element-property :type b) + (list (org-element-property :post-affiliated b) + "Missing back-end in export block"))))) + +(defun org-lint-invalid-babel-call-block (ast) + (org-element-map ast 'babel-call + (lambda (b) + (cond + ((not (org-element-property :call b)) + (list (org-element-property :post-affiliated b) + "Invalid syntax in babel call block")) + ((let ((h (org-element-property :end-header b))) + (and h (string-match-p "\\`\\[.*\\]\\'" h))) + (list + (org-element-property :post-affiliated b) + "Babel call's end header must not be wrapped within brackets")))))) + +(defun org-lint-deprecated-category-setup (ast) + (org-element-map ast 'keyword + (let (category-flag) + (lambda (k) + (cond + ((not (string= (org-element-property :key k) "CATEGORY")) nil) + (category-flag + (list (org-element-property :post-affiliated k) + "Spurious CATEGORY keyword. Set :CATEGORY: property instead")) + (t (setf category-flag t) nil)))))) + +(defun org-lint-invalid-coderef-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (let ((ref (org-element-property :path link))) + (and (equal (org-element-property :type link) "coderef") + (not (ignore-errors (org-export-resolve-coderef ref info))) + (list (org-element-property :begin link) + (format "Unknown coderef \"%s\"" ref)))))))) + +(defun org-lint-invalid-custom-id-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "custom-id") + (not (ignore-errors (org-export-resolve-id-link link info))) + (list (org-element-property :begin link) + (format "Unknown custom ID \"%s\"" + (org-element-property :path link)))))))) + +(defun org-lint-invalid-fuzzy-link (ast) + (let ((info (list :parse-tree ast))) + (org-element-map ast 'link + (lambda (link) + (and (equal (org-element-property :type link) "fuzzy") + (not (ignore-errors (org-export-resolve-fuzzy-link link info))) + (list (org-element-property :begin link) + (format "Unknown fuzzy location \"%s\"" + (let ((path (org-element-property :path link))) + (if (string-prefix-p "*" path) + (substring path 1) + path))))))))) + +(defun org-lint-invalid-id-link (ast) + (org-element-map ast 'link + (lambda (link) + (let ((id (org-element-property :path link))) + (and (equal (org-element-property :type link) "id") + (not (org-id-find id)) + (list (org-element-property :begin link) + (format "Unknown ID \"%s\"" id))))))) + +(defun org-lint-special-property-in-properties-drawer (ast) + (org-element-map ast 'node-property + (lambda (p) + (let ((key (org-element-property :key p))) + (and (member-ignore-case key org-special-properties) + (list (org-element-property :begin p) + (format + "Special property \"%s\" found in a properties drawer" + key))))))) + +(defun org-lint-obsolete-properties-drawer (ast) + (org-element-map ast 'drawer + (lambda (d) + (when (equal (org-element-property :drawer-name d) "PROPERTIES") + (let ((section (org-element-lineage d '(section)))) + (unless (org-element-map section 'property-drawer #'identity nil t) + (list (org-element-property :post-affiliated d) + (if (save-excursion + (goto-char (org-element-property :post-affiliated d)) + (forward-line -1) + (or (org-at-heading-p) (org-at-planning-p))) + "Incorrect contents for PROPERTIES drawer" + "Incorrect location for PROPERTIES drawer")))))))) + +(defun org-lint-link-to-local-file (ast) + (org-element-map ast 'link + (lambda (l) + (when (equal (org-element-property :type l) "file") + (let ((file (org-link-unescape (org-element-property :path l)))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin l) + (format (if (org-element-lineage l '(link)) + "Link to non-existent image file \"%s\"\ + in link description" + "Link to non-existent local file \"%s\"") + file)))))))) + +(defun org-lint-non-existent-setupfile-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "SETUPFILE") + (let ((file (org-unbracket-string + "\"" "\"" + (org-element-property :value k)))) + (and (not (file-remote-p file)) + (not (file-exists-p file)) + (list (org-element-property :begin k) + (format "Non-existent setup file \"%s\"" file)))))))) + +(defun org-lint-wrong-include-link-parameter (ast) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INCLUDE") + (let* ((value (org-element-property :value k)) + (path + (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value) + (save-match-data + (org-unbracket-string "\"" "\"" (match-string 1 value)))))) + (if (not path) + (list (org-element-property :post-affiliated k) + "Missing location argument in INCLUDE keyword") + (let* ((file (org-string-nw-p + (if (string-match "::\\(.*\\)\\'" path) + (substring path 0 (match-beginning 0)) + path))) + (search (and (not (equal file path)) + (org-string-nw-p (match-string 1 path))))) + (if (and file + (not (file-remote-p file)) + (not (file-exists-p file))) + (list (org-element-property :post-affiliated k) + "Non-existent file argument in INCLUDE keyword") + (let* ((visiting (if file (find-buffer-visiting file) + (current-buffer))) + (buffer (or visiting (find-file-noselect file)))) + (unwind-protect + (with-current-buffer buffer + (when (and search + (not + (ignore-errors + (let ((org-link-search-inhibit-query t)) + (org-link-search search nil t))))) + (list (org-element-property :post-affiliated k) + (format + "Invalid search part \"%s\" in INCLUDE keyword" + search)))) + (unless visiting (kill-buffer buffer)))))))))))) + +(defun org-lint-obsolete-include-markup (ast) + (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s" + (regexp-opt + '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD" + "ODT" "ORG" "TEXINFO") + t)))) + (org-element-map ast 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INCLUDE") + (let ((case-fold-search t) + (value (org-element-property :value k))) + (when (string-match regexp value) + (let ((markup (match-string-no-properties 1 value))) + (list (org-element-property :post-affiliated k) + (format "Obsolete markup \"%s\" in INCLUDE keyword. \ +Use \"export %s\" instead" + markup + markup)))))))))) + +(defun org-lint-unknown-options-item (ast) + (let ((allowed (delq nil + (append + (mapcar (lambda (o) (nth 2 o)) org-export-options-alist) + (cl-mapcan + (lambda (b) + (mapcar (lambda (o) (nth 2 o)) + (org-export-backend-options b))) + org-export-registered-backends)))) + reports) + (org-element-map ast 'keyword + (lambda (k) + (when (string= (org-element-property :key k) "OPTIONS") + (let ((value (org-element-property :value k)) + (start 0)) + (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*" + value + start) + (setf start (match-end 0)) + (let ((item (match-string 1 value))) + (unless (member item allowed) + (push (list (org-element-property :post-affiliated k) + (format "Unknown OPTIONS item \"%s\"" item)) + reports)))))))) + reports)) + +(defun org-lint-invalid-macro-argument-and-template (ast) + (let ((extract-placeholders + (lambda (template) + (let ((start 0) + args) + (while (string-match "\\$\\([1-9][0-9]*\\)" template start) + (setf start (match-end 0)) + (push (string-to-number (match-string 1 template)) args)) + (sort (org-uniquify args) #'<)))) + reports) + ;; Check arguments for macro templates. + (org-element-map ast 'keyword + (lambda (k) + (when (string= (org-element-property :key k) "MACRO") + (let* ((value (org-element-property :value k)) + (name (and (string-match "^\\S-+" value) + (match-string 0 value))) + (template (and name + (org-trim (substring value (match-end 0)))))) + (cond + ((not name) + (push (list (org-element-property :post-affiliated k) + "Missing name in MACRO keyword") + reports)) + ((not (org-string-nw-p template)) + (push (list (org-element-property :post-affiliated k) + "Missing template in macro \"%s\"" name) + reports)) + (t + (unless (let ((args (funcall extract-placeholders template))) + (equal (number-sequence 1 (or (org-last args) 0)) args)) + (push (list (org-element-property :post-affiliated k) + (format "Unused placeholders in macro \"%s\"" + name)) + reports)))))))) + ;; Check arguments for macros. + (org-macro-initialize-templates) + (let ((templates (append + (mapcar (lambda (m) (cons m "$1")) + '("author" "date" "email" "title" "results")) + org-macro-templates))) + (org-element-map ast 'macro + (lambda (macro) + (let* ((name (org-element-property :key macro)) + (template (cdr (assoc-string name templates t)))) + (if (not template) + (push (list (org-element-property :begin macro) + (format "Undefined macro \"%s\"" name)) + reports) + (let ((arg-numbers (funcall extract-placeholders template))) + (when arg-numbers + (let ((spurious-args + (nthcdr (apply #'max arg-numbers) + (org-element-property :args macro)))) + (when spurious-args + (push + (list (org-element-property :begin macro) + (format "Unused argument%s in macro \"%s\": %s" + (if (> (length spurious-args) 1) "s" "") + name + (mapconcat (lambda (a) (format "\"%s\"" a)) + spurious-args + ", "))) + reports)))))))))) + reports)) + +(defun org-lint-undefined-footnote-reference (ast) + (let ((definitions (org-element-map ast 'footnote-definition + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-reference + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label definitions)) + (list (org-element-property :begin f) + (format "Missing definition for footnote [%s]" + label)))))))) + +(defun org-lint-unreferenced-footnote-definition (ast) + (let ((references (org-element-map ast 'footnote-reference + (lambda (f) (org-element-property :label f))))) + (org-element-map ast 'footnote-definition + (lambda (f) + (let ((label (org-element-property :label f))) + (and label + (not (member label references)) + (list (org-element-property :post-affiliated f) + (format "No reference for footnote definition [%s]" + label)))))))) + +(defun org-lint-colon-in-name (ast) + (org-element-map ast org-element-all-elements + (lambda (e) + (let ((name (org-element-property :name e))) + (and name + (string-match-p ":" name) + (list (progn + (goto-char (org-element-property :begin e)) + (re-search-forward + (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name))) + (match-beginning 0)) + (format + "Name \"%s\" contains a colon; Babel cannot use it as input" + name))))))) + +(defun org-lint-misplaced-planning-info (_) + (let ((case-fold-search t) + reports) + (while (re-search-forward org-planning-line-re nil t) + (unless (memq (org-element-type (org-element-at-point)) + '(comment-block example-block export-block planning + src-block verse-block)) + (push (list (line-beginning-position) "Misplaced planning info line") + reports))) + reports)) + +(defun org-lint-incomplete-drawer (_) + (let (reports) + (while (re-search-forward org-drawer-regexp nil t) + (let ((name (org-trim (match-string-no-properties 0))) + (element (org-element-at-point))) + (pcase (org-element-type element) + ((or `drawer `property-drawer) + (goto-char (org-element-property :end element)) + nil) + ((or `comment-block `example-block `export-block `src-block + `verse-block) + nil) + (_ + (push (list (line-beginning-position) + (format "Possible incomplete drawer \"%s\"" name)) + reports))))) + reports)) + +(defun org-lint-indented-diary-sexp (_) + (let (reports) + (while (re-search-forward "^[ \t]+%%(" nil t) + (unless (memq (org-element-type (org-element-at-point)) + '(comment-block diary-sexp example-block export-block + src-block verse-block)) + (push (list (line-beginning-position) "Possible indented diary-sexp") + reports))) + reports)) + +(defun org-lint-invalid-block (_) + (let ((case-fold-search t) + (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*") + reports) + (while (re-search-forward regexp nil t) + (let ((name (org-trim (buffer-substring-no-properties + (line-beginning-position) (line-end-position))))) + (cond + ((and (string-prefix-p "END" (match-string 1) t) + (not (eolp))) + (push (list (line-beginning-position) + (format "Invalid block closing line \"%s\"" name)) + reports)) + ((not (memq (org-element-type (org-element-at-point)) + '(center-block comment-block dynamic-block example-block + export-block quote-block special-block + src-block verse-block))) + (push (list (line-beginning-position) + (format "Possible incomplete block \"%s\"" + name)) + reports))))) + reports)) + +(defun org-lint-invalid-keyword-syntax (_) + (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)") + (exception-re + (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)" + (regexp-opt org-element-dual-keywords))) + reports) + (while (re-search-forward regexp nil t) + (let ((name (match-string-no-properties 1))) + (unless (or (string-prefix-p "BEGIN" name t) + (string-prefix-p "END" name t) + (save-excursion + (beginning-of-line) + (let ((case-fold-search t)) (looking-at exception-re)))) + (push (list (match-beginning 0) + (format "Possible missing colon in keyword \"%s\"" name)) + reports)))) + reports)) + +(defun org-lint-extraneous-element-in-footnote-section (ast) + (org-element-map ast 'headline + (lambda (h) + (and (org-element-property :footnote-section-p h) + (org-element-map (org-element-contents h) + (cl-remove-if + (lambda (e) + (memq e '(comment comment-block footnote-definition + property-drawer section))) + org-element-all-elements) + (lambda (e) + (not (and (eq (org-element-type e) 'headline) + (org-element-property :commentedp e)))) + nil t '(footnote-definition property-drawer)) + (list (org-element-property :begin h) + "Extraneous elements in footnote section are not exported"))))) + +(defun org-lint-quote-section (ast) + (org-element-map ast '(headline inlinetask) + (lambda (h) + (let ((title (org-element-property :raw-value h))) + (and (or (string-prefix-p "QUOTE " title) + (string-prefix-p (concat org-comment-string " QUOTE ") title)) + (list (org-element-property :begin h) + "Deprecated QUOTE section")))))) + +(defun org-lint-file-application (ast) + (org-element-map ast 'link + (lambda (l) + (let ((app (org-element-property :application l))) + (and app + (list (org-element-property :begin l) + (format "Deprecated \"file+%s\" link type" app))))))) + +(defun org-lint-wrong-header-argument (ast) + (let* ((reports) + (verify + (lambda (datum language headers) + (let ((allowed + ;; If LANGUAGE is specified, restrict allowed + ;; headers to both LANGUAGE-specific and default + ;; ones. Otherwise, accept headers from any loaded + ;; language. + (append + org-babel-header-arg-names + (cl-mapcan + (lambda (l) + (let ((v (intern (format "org-babel-header-args:%s" l)))) + (and (boundp v) (mapcar #'car (symbol-value v))))) + (if language (list language) + (mapcar #'car org-babel-load-languages)))))) + (dolist (header headers) + (let ((h (symbol-name (car header))) + (p (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)))) + (cond + ((not (string-prefix-p ":" h)) + (push + (list p + (format "Missing colon in header argument \"%s\"" h)) + reports)) + ((assoc-string (substring h 1) allowed)) + (t (push (list p (format "Unknown header argument \"%s\"" h)) + reports))))))))) + (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword + node-property src-block) + (lambda (datum) + (pcase (org-element-type datum) + ((or `babel-call `inline-babel-call) + (funcall verify + datum + nil + (cl-mapcan #'org-babel-parse-header-arguments + (list + (org-element-property :inside-header datum) + (org-element-property :end-header datum))))) + (`inline-src-block + (funcall verify + datum + (org-element-property :language datum) + (org-babel-parse-header-arguments + (org-element-property :parameters datum)))) + (`keyword + (when (string= (org-element-property :key datum) "PROPERTY") + (let ((value (org-element-property :value datum))) + (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *" + value) + (funcall verify + datum + (match-string 1 value) + (org-babel-parse-header-arguments + (substring value (match-end 0)))))))) + (`node-property + (let ((key (org-element-property :key datum))) + (when (let ((case-fold-search t)) + (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?" + key)) + (funcall verify + datum + (match-string 1 key) + (org-babel-parse-header-arguments + (org-element-property :value datum)))))) + (`src-block + (funcall verify + datum + (org-element-property :language datum) + (cl-mapcan #'org-babel-parse-header-arguments + (cons (org-element-property :parameters datum) + (org-element-property :header datum)))))))) + reports)) + +(defun org-lint-wrong-header-value (ast) + (let (reports) + (org-element-map ast + '(babel-call inline-babel-call inline-src-block src-block) + (lambda (datum) + (let* ((type (org-element-type datum)) + (language (org-element-property :language datum)) + (allowed-header-values + (append (and language + (let ((v (intern (concat "org-babel-header-args:" + language)))) + (and (boundp v) (symbol-value v)))) + org-babel-common-header-args-w-values)) + (datum-header-values + (org-babel-parse-header-arguments + (org-trim + (pcase type + (`src-block + (mapconcat + #'identity + (cons (org-element-property :parameters datum) + (org-element-property :header datum)) + " ")) + (`inline-src-block + (or (org-element-property :parameters datum) "")) + (_ + (concat + (org-element-property :inside-header datum) + " " + (org-element-property :end-header datum)))))))) + (dolist (header datum-header-values) + (let ((allowed-values + (cdr (assoc-string (substring (symbol-name (car header)) 1) + allowed-header-values)))) + (unless (memq allowed-values '(:any nil)) + (let ((values (cdr header)) + groups-alist) + (dolist (v (if (stringp values) (org-split-string values) + (list values))) + (let ((valid-value nil)) + (catch 'exit + (dolist (group allowed-values) + (cond + ((not (funcall + (if (stringp v) #'assoc-string #'assoc) + v group)) + (when (memq :any group) + (setf valid-value t) + (push (cons group v) groups-alist))) + ((assq group groups-alist) + (push + (list + (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)) + (format + "Forbidden combination in header \"%s\": %s, %s" + (car header) + (cdr (assq group groups-alist)) + v)) + reports) + (throw 'exit nil)) + (t (push (cons group v) groups-alist) + (setf valid-value t)))) + (unless valid-value + (push + (list + (or (org-element-property :post-affiliated datum) + (org-element-property :begin datum)) + (format "Unknown value \"%s\" for header \"%s\"" + v + (car header))) + reports)))))))))))) + reports)) + +(defun org-lint-empty-headline-with-tags (ast) + (org-element-map ast '(headline inlinetask) + (lambda (h) + (let ((title (org-element-property :raw-value h))) + (and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title) + (list (org-element-property :begin h) + (format "Headline containing only tags is ambiguous: %S" + title))))))) + + +;;; Reports UI + +(defvar org-lint--report-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map tabulated-list-mode-map) + (define-key map (kbd "RET") 'org-lint--jump-to-source) + (define-key map (kbd "TAB") 'org-lint--show-source) + (define-key map (kbd "C-j") 'org-lint--show-source) + (define-key map (kbd "h") 'org-lint--hide-checker) + (define-key map (kbd "i") 'org-lint--ignore-checker) + map) + "Local keymap for `org-lint--report-mode' buffers.") + +(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint" + "Major mode used to display reports emitted during linting. +\\{org-lint--report-mode-map}" + (setf tabulated-list-format + `[("Line" 6 + (lambda (a b) + (< (string-to-number (aref (cadr a) 0)) + (string-to-number (aref (cadr b) 0)))) + :right-align t) + ("Trust" 5 t) + ("Warning" 0 t)]) + (tabulated-list-init-header)) + +(defun org-lint--generate-reports (buffer checkers) + "Generate linting report for BUFFER. + +CHECKERS is the list of checkers used. + +Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable +for `tabulated-list-printer'." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + (let ((ast (org-element-parse-buffer)) + (id 0) + (last-line 1) + (last-pos 1)) + ;; Insert unique ID for each report. Replace buffer positions + ;; with line numbers. + (mapcar + (lambda (report) + (list + (cl-incf id) + (apply #'vector + (cons + (progn + (goto-char (car report)) + (beginning-of-line) + (prog1 (number-to-string + (cl-incf last-line + (count-lines last-pos (point)))) + (setf last-pos (point)))) + (cdr report))))) + ;; Insert trust level in generated reports. Also sort them + ;; by buffer position in order to optimize lines computation. + (sort (cl-mapcan + (lambda (c) + (let ((trust (symbol-name (org-lint-checker-trust c)))) + (mapcar + (lambda (report) + (list (car report) trust (nth 1 report) c)) + (save-excursion + (funcall + (intern (format "org-lint-%s" + (org-lint-checker-name c))) + ast))))) + checkers) + #'car-less-than-car)))))) + +(defvar-local org-lint--source-buffer nil + "Source buffer associated to current report buffer.") + +(defvar-local org-lint--local-checkers nil + "List of checkers used to build current report.") + +(defun org-lint--refresh-reports () + (setq tabulated-list-entries + (org-lint--generate-reports org-lint--source-buffer + org-lint--local-checkers)) + (tabulated-list-print)) + +(defun org-lint--current-line () + "Return current report line, as a number." + (string-to-number (aref (tabulated-list-get-entry) 0))) + +(defun org-lint--current-checker (&optional entry) + "Return current report checker. +When optional argument ENTRY is non-nil, use this entry instead +of current one." + (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3)) + +(defun org-lint--display-reports (source checkers) + "Display linting reports for buffer SOURCE. +CHECKERS is the list of checkers used." + (let ((buffer (get-buffer-create "*Org Lint*"))) + (with-current-buffer buffer + (org-lint--report-mode) + (setf org-lint--source-buffer source) + (setf org-lint--local-checkers checkers) + (org-lint--refresh-reports) + (tabulated-list-print) + (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t)) + (pop-to-buffer buffer))) + +(defun org-lint--jump-to-source () + "Move to source line that generated the report at point." + (interactive) + (let ((l (org-lint--current-line))) + (switch-to-buffer-other-window org-lint--source-buffer) + (org-goto-line l) + (org-show-set-visibility 'local) + (recenter))) + +(defun org-lint--show-source () + "Show source line that generated the report at point." + (interactive) + (let ((buffer (current-buffer))) + (org-lint--jump-to-source) + (switch-to-buffer-other-window buffer))) + +(defun org-lint--hide-checker () + "Hide all reports from checker that generated the report at point." + (interactive) + (let ((c (org-lint--current-checker))) + (setf tabulated-list-entries + (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e))) + tabulated-list-entries)) + (tabulated-list-print))) + +(defun org-lint--ignore-checker () + "Ignore all reports from checker that generated the report at point. +Checker will also be ignored in all subsequent reports." + (interactive) + (setf org-lint--local-checkers + (remove (org-lint--current-checker) org-lint--local-checkers)) + (org-lint--hide-checker)) + + +;;; Public function + +;;;###autoload +(defun org-lint (&optional arg) + "Check current Org buffer for syntax mistakes. + +By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \ +select one +category of checkers only. With a `\\[universal-argument] \ +\\[universal-argument]' prefix, run one precise +checker by its name. + +ARG can also be a list of checker names, as symbols, to run." + (interactive "P") + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer")) + (when (called-interactively-p 'any) + (message "Org linting process starting...")) + (let ((checkers + (pcase arg + (`nil org-lint--checkers) + (`(4) + (let ((category + (completing-read + "Checker category: " + (mapcar #'org-lint-checker-categories org-lint--checkers) + nil t))) + (cl-remove-if-not + (lambda (c) + (assoc-string (org-lint-checker-categories c) category)) + org-lint--checkers))) + (`(16) + (list + (let ((name (completing-read + "Checker name: " + (mapcar #'org-lint-checker-name org-lint--checkers) + nil t))) + (catch 'exit + (dolist (c org-lint--checkers) + (when (string= (org-lint-checker-name c) name) + (throw 'exit c))))))) + ((pred consp) + (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg)) + org-lint--checkers)) + (_ (user-error "Invalid argument `%S' for `org-lint'" arg))))) + (if (not (called-interactively-p 'any)) + (org-lint--generate-reports (current-buffer) checkers) + (org-lint--display-reports (current-buffer) checkers) + (message "Org linting process completed")))) + + +(provide 'org-lint) +;;; org-lint.el ends here diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index a24c496d72..a3e26256f9 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -1,4 +1,4 @@ -;;; org-list.el --- Plain lists for Org-mode +;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; @@ -25,7 +25,7 @@ ;; ;;; Commentary: -;; This file contains the code dealing with plain lists in Org-mode. +;; This file contains the code dealing with plain lists in Org mode. ;; The core concept behind lists is their structure. A structure is ;; a snapshot of the list, in the shape of a data tree (see @@ -76,8 +76,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org-macs) (require 'org-compat) @@ -88,59 +87,84 @@ (defvar org-closed-string) (defvar org-deadline-string) (defvar org-description-max-indent) -(defvar org-drawers) +(defvar org-done-keywords) +(defvar org-drawer-regexp) +(defvar org-element-all-objects) +(defvar org-inhibit-startup) (defvar org-odd-levels-only) +(defvar org-outline-regexp-bol) (defvar org-scheduled-string) +(defvar org-todo-line-regexp) (defvar org-ts-regexp) (defvar org-ts-regexp-both) -(declare-function outline-invisible-p "outline" (&optional pos)) -(declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-next-heading "outline" ()) -(declare-function outline-previous-heading "outline" ()) - -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-before-first-heading-p "org" ()) +(declare-function org-at-heading-p "org" (&optional invisible-ok)) (declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-before-first-heading-p "org" ()) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-count "org" (cl-item cl-seq)) (declare-function org-current-level "org" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function + org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-macro-interpreter "org-element" (macro ##)) +(declare-function + org-element-map "org-element" + (data types fun &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-normalize-string "org-element" (s)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" + (element property value)) +(declare-function org-element-set-element "org-element" (old new)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-update-syntax "org-element" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) +(declare-function org-export-create-backend "ox" (&rest rest) t) +(declare-function org-export-data-with-backend "ox" (data backend info)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" + (&optional backend subtreep ext-plist)) +(declare-function org-export-get-next-element "ox" + (blob info &optional n)) +(declare-function org-export-with-backend "ox" + (backend data &optional contents info)) (declare-function org-fix-tags-on-the-fly "org" ()) (declare-function org-get-indentation "org" (&optional line)) -(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-get-todo-state "org" ()) (declare-function org-in-block-p "org" (names)) (declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-at-heading-p "org" (&optional invisible-ok)) -(declare-function org-previous-line-empty-p "org" (&optional next)) -(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-outline-level "org" ()) +(declare-function org-previous-line-empty-p "org" ()) (declare-function org-reduced-level "org" (L)) +(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-show-subtree "org" ()) (declare-function org-sort-remove-invisible "org" (S)) (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-timer-item "org-timer" (&optional arg)) -(declare-function org-trim "org" (s)) +(declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-uniquify "org" (list)) - -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) - -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) - +(declare-function org-invisible-p "org" (&optional pos)) +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) ;;; Configuration variables (defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." + "Options concerning plain lists in Org mode." :tag "Org Plain lists" :group 'org-structure) @@ -211,14 +235,20 @@ into (defcustom org-plain-list-ordered-item-terminator t "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t." +Valid values are ?. and ?\). To get both terminators, use t. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code after updating it: + + `\\[org-element-update-syntax]'" :group 'org-plain-lists :type '(choice (const :tag "dot like in \"2.\"" ?.) (const :tag "paren like in \"2)\"" ?\)) - (const :tag "both" t))) + (const :tag "both" t)) + :set (lambda (var val) (set var val) + (when (featurep 'org-element) (org-element-update-syntax)))) -(define-obsolete-variable-alias 'org-alphabetical-lists - 'org-list-allow-alphabetical "24.4") ; Since 8.0 (defcustom org-list-allow-alphabetical nil "Non-nil means single character alphabetical bullets are allowed. @@ -230,13 +260,12 @@ This variable needs to be set before org.el is loaded. If you need to make a change while Emacs is running, use the customize interface or run the following code after updating it: - (when (featurep \\='org-element) (load \"org-element\" t t))" + `\\[org-element-update-syntax]'" :group 'org-plain-lists :version "24.1" :type 'boolean - :set (lambda (var val) - (when (featurep 'org-element) (load "org-element" t t)) - (set var val))) + :set (lambda (var val) (set var val) + (when (featurep 'org-element) (org-element-update-syntax)))) (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. @@ -250,23 +279,22 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) -(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists - 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 -(defcustom org-list-empty-line-terminates-plain-lists nil - "Non-nil means an empty line ends all plain list levels. -Otherwise, two of them will be necessary." - :group 'org-plain-lists - :type 'boolean) - (defcustom org-list-automatic-rules '((checkbox . t) (indent . t)) "Non-nil means apply set of rules when acting on lists. +\\ By default, automatic actions are taken when using - \\[org-meta-return], \\[org-metaright], \\[org-metaleft], - \\[org-shiftmetaright], \\[org-shiftmetaleft], - \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or - \\[org-insert-todo-heading]. You can disable individually these - rules by setting them to nil. Valid rules are: + `\\[org-meta-return]', + `\\[org-metaright]', + `\\[org-metaleft]', + `\\[org-shiftmetaright]', + `\\[org-shiftmetaleft]', + `\\[org-ctrl-c-minus]', + `\\[org-toggle-checkbox]', + `\\[org-insert-todo-heading]'. + +You can disable individually these rules by setting them to nil. +Valid rules are: checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. @@ -286,13 +314,15 @@ indent when non-nil, indenting or outdenting list top-item (defcustom org-list-use-circular-motion nil "Non-nil means commands implying motion in lists should be cyclic. - +\\ In that case, the item following the last item is the first one, and the item preceding the first item is the last one. -This affects the behavior of \\[org-move-item-up], - \\[org-move-item-down], \\[org-next-item] and - \\[org-previous-item]." +This affects the behavior of + `\\[org-move-item-up]', + `\\[org-move-item-down]', + `\\[org-next-item]', + `\\[org-previous-item]'." :group 'org-plain-lists :version "24.1" :type 'boolean) @@ -304,8 +334,6 @@ This hook runs even if checkbox rule in implement alternative ways of collecting statistics information.") -(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics - 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 (defcustom org-checkbox-hierarchical-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. @@ -314,8 +342,6 @@ with the word \"recursive\" in the value." :group 'org-plain-lists :type 'boolean) -(org-defvaralias 'org-description-max-indent - 'org-list-description-max-indent) ;; Since 8.0 (defcustom org-list-description-max-indent 20 "Maximum indentation for the second line of a description list. When the indentation would be larger than this, it will become @@ -358,8 +384,7 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" - "html" "latex" "odt") +(defvar org-list-forbidden-blocks '("example" "verse" "src" "export") "Names of blocks where lists are not allowed. Names must be in lower case.") @@ -374,10 +399,8 @@ specifically, type `block' is determined by the variable ;;; Predicates and regexps -(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" - "^[ \t]*\n[ \t]*\n") - "Regex corresponding to the end of a list. -It depends on `org-list-empty-line-terminates-plain-lists'.") +(defconst org-list-end-re "^[ \t]*\n[ \t]*\n" + "Regex matching the end of a plain list.") (defconst org-list-full-item-re (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" @@ -430,9 +453,6 @@ group 4: description tag") (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat #'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (item-re (org-item-re)) @@ -476,7 +496,7 @@ group 4: description tag") ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -547,11 +567,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) ;; Is point inside a drawer? (let ((end-re "^[ \t]*:END:") - ;; Can't use org-drawers-regexp as this function might - ;; be called in buffers not in Org mode. - (beg-re (concat "^[ \t]*:\\(" - (mapconcat #'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) + (beg-re org-drawer-regexp)) (when (save-excursion (and (not (looking-at beg-re)) (not (looking-at end-re)) @@ -635,9 +651,6 @@ Assume point is at an item." (lim-down (nth 1 context)) (text-min-ind 10000) (item-re (org-item-re)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat #'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (beg-cell (cons (point) (org-get-indentation))) @@ -654,7 +667,7 @@ Assume point is at an item." (match-string-no-properties 2) ; counter (match-string-no-properties 3) ; checkbox ;; Description tag. - (and (save-match-data (string-match "[-+*]" bullet)) + (and (string-match-p "[-+*]" bullet) (match-string-no-properties 4))))))) (end-before-blank (function @@ -700,7 +713,7 @@ Assume point is at an item." ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -766,7 +779,7 @@ Assume point is at an item." (cond ((and (looking-at "^[ \t]*#\\+begin_") (re-search-forward "^[ \t]*#\\+end_" lim-down t))) - ((and (looking-at drawers-re) + ((and (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:" lim-down t)))) (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) @@ -1021,7 +1034,7 @@ Possible types are `descriptive', `ordered' and `unordered'. The type is determined by the first item of the list." (let ((first (org-list-get-list-begin item struct prevs))) (cond - ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + ((string-match-p "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) ((org-list-get-tag first struct) 'descriptive) (t 'unordered)))) @@ -1043,7 +1056,7 @@ that value." (let ((seq 0) (pos item) counter) (while (and (not (setq counter (org-list-get-counter pos struct))) (setq pos (org-list-get-prev-item pos struct prevs))) - (incf seq)) + (cl-incf seq)) (if (not counter) (1+ seq) (cond ((string-match "[A-Za-z]" counter) @@ -1137,13 +1150,20 @@ This function modifies STRUCT." ;; Store overlays responsible for visibility status. We ;; also need to store their boundaries as they will be ;; removed from buffer. - (overlays (cons - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-A end-A)) - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-B end-B))))) + (overlays + (cons + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-A) + (<= (overlay-end o) end-A) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-A end-A))) + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-B) + (<= (overlay-end o) end-B) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-B end-B)))))) ;; 1. Move effectively items in buffer. (goto-char beg-A) (delete-region beg-A end-B-no-blank) @@ -1154,42 +1174,39 @@ This function modifies STRUCT." ;; as empty spaces are not moved there. In others words, ;; item BEG-A will end with whitespaces that were at the end ;; of BEG-B and the same applies to BEG-B. - (mapc (lambda (e) - (let ((pos (car e))) - (cond - ((< pos beg-A)) - ((memq pos sub-A) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 6 e) - (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) - ((memq pos sub-B) - (let ((end-e (nth 6 e))) - (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) - (when (= end-e end-B) - (setcar (nthcdr 6 e) - (+ beg-A size-B (- end-A end-A-no-blank)))))) - ((< pos beg-B) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) - struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + (dolist (e struct) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + (setq struct (sort struct #'car-less-than-car)) ;; Restore visibility status, by moving overlays to their new ;; position. - (mapc (lambda (ov) - (move-overlay - (car ov) - (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) - (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) - (car overlays)) - (mapc (lambda (ov) - (move-overlay (car ov) - (+ (nth 1 ov) (- beg-A beg-B)) - (+ (nth 2 ov) (- beg-A beg-B)))) - (cdr overlays)) + (dolist (ov (car overlays)) + (move-overlay + (car ov) + (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) + (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) + (dolist (ov (cdr overlays)) + (move-overlay (car ov) + (+ (nth 1 ov) (- beg-A beg-B)) + (+ (nth 2 ov) (- beg-A beg-B)))) ;; Return structure. struct))) @@ -1219,7 +1236,7 @@ some heuristics to guess the result." (point)))))))) (cond ;; Trivial cases where there should be none. - ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) + ((not insert-blank-p) 0) ;; When `org-blank-before-new-entry' says so, it is 1. ((eq insert-blank-p t) 1) ;; `plain-list-item' is 'auto. Count blank lines separating @@ -1272,12 +1289,16 @@ This function modifies STRUCT." (beforep (progn (looking-at org-list-full-item-re) - ;; Do not count tag in a non-descriptive list. - (<= pos (if (and (match-beginning 4) - (save-match-data - (string-match "[.)]" (match-string 1)))) - (match-beginning 4) - (match-end 0))))) + (<= pos + (cond + ((not (match-beginning 4)) (match-end 0)) + ;; Ignore tag in a non-descriptive list. + ((save-match-data (string-match "[.)]" (match-string 1))) + (match-beginning 4)) + (t (save-excursion + (goto-char (match-end 4)) + (skip-chars-forward " \t") + (point))))))) (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number pos struct prevs)) @@ -1317,7 +1338,7 @@ This function modifies STRUCT." (size-offset (- item-size (length text-cut)))) ;; 4. Insert effectively item into buffer. (goto-char item) - (org-indent-to-column ind) + (indent-to-column ind) (insert body item-sep) ;; 5. Add new item to STRUCT. (mapc (lambda (e) @@ -1459,7 +1480,7 @@ This function returns, destructively, the new list structure." (save-excursion (goto-char (org-list-get-last-item item struct prevs)) (point-at-eol))) - ((string-match "\\`[0-9]+\\'" dest) + ((string-match-p "\\`[0-9]+\\'" dest) (let* ((all (org-list-get-all-items item struct prevs)) (len (length all)) (index (mod (string-to-number dest) len))) @@ -1473,8 +1494,10 @@ This function returns, destructively, the new list structure." (point-at-eol))))) (t dest))) (org-M-RET-may-split-line nil) - ;; Store visibility. - (visibility (overlays-in item item-end))) + ;; Store inner overlays (to preserve visibility). + (overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item) + (> (overlay-end o) item))) + (overlays-in item item-end)))) (cond ((eq dest 'delete) (org-list-delete-item item struct)) ((eq dest 'kill) @@ -1509,13 +1532,12 @@ This function returns, destructively, the new list structure." new-end (+ end shift))))))) moved-items)) - (lambda (e1 e2) (< (car e1) (car e2)))))) - ;; 2. Restore visibility. - (mapc (lambda (ov) - (move-overlay ov - (+ (overlay-start ov) (- (point) item)) - (+ (overlay-end ov) (- (point) item)))) - visibility) + #'car-less-than-car))) + ;; 2. Restore inner overlays. + (dolist (o overlays) + (move-overlay o + (+ (overlay-start o) (- (point) item)) + (+ (overlay-end o) (- (point) item)))) ;; 3. Eventually delete extra copy of the item and clean marker. (prog1 (org-list-delete-item (marker-position item) struct) (move-marker item nil))) @@ -1632,7 +1654,7 @@ as returned by `org-list-prevs-alist'." (while item (let ((count (org-list-get-counter item struct))) ;; Virtually determine current bullet - (if (and count (string-match "[a-zA-Z]" count)) + (if (and count (string-match-p "[a-zA-Z]" count)) ;; Counters are not case-sensitive. (setq ascii (string-to-char (upcase count))) (setq ascii (1+ ascii))) @@ -1861,10 +1883,9 @@ Initial position of cursor is restored after the changes." (item-re (org-item-re)) (shift-body-ind (function - ;; Shift the indentation between END and BEG by DELTA. If - ;; MAX-IND is non-nil, ensure that no line will be indented - ;; more than that number. Start from the line before END. - (lambda (end beg delta max-ind) + ;; Shift the indentation between END and BEG by DELTA. + ;; Start from the line before END. + (lambda (end beg delta) (goto-char end) (skip-chars-backward " \r\t\n") (beginning-of-line) @@ -1876,10 +1897,8 @@ Initial position of cursor is restored after the changes." ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning)) ;; Shift only non-empty lines. - ((org-looking-at-p "^[ \t]*\\S-") - (let ((i (org-get-indentation))) - (org-indent-line-to - (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) + ((looking-at-p "^[ \t]*\\S-") + (indent-line-to (+ (org-get-indentation) delta)))) (forward-line -1))))) (modify-item (function @@ -1934,37 +1953,53 @@ Initial position of cursor is restored after the changes." ;; belongs to: it is the last item (ITEM-UP), whose ;; ending is further than the position we're ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) + (let ((item-up (assoc-default end-pos acc-end #'>))) (push (cons end-pos item-up) end-list))) (push (cons end-pos pos) acc-end))) ;; 2. Slice the items into parts that should be shifted by the ;; same amount of indentation. Each slice follow the pattern - ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in - ;; reverse order. + ;; (END BEG DELTA). Slices are returned in reverse order. (setq all-ends (sort (append (mapcar #'car itm-shift) (org-uniquify (mapcar #'car end-list))) - '<)) + #'<) + acc-end (nreverse acc-end)) (while (cdr all-ends) (let* ((up (pop all-ends)) (down (car all-ends)) (itemp (assq up struct)) - (item (if itemp up (cdr (assq up end-list)))) - (ind (cdr (assq item itm-shift))) - ;; If we're not at an item, there's a child of the item - ;; point belongs to above. Make sure this slice isn't - ;; moved within that child by specifying a maximum - ;; indentation. - (max-ind (and (not itemp) - (+ (org-list-get-ind item struct) - (length (org-list-get-bullet item struct)) - org-list-indent-offset)))) - (push (list down up ind max-ind) sliced-struct))) + (delta + (if itemp (cdr (assq up itm-shift)) + ;; If we're not at an item, there's a child of the + ;; item point belongs to above. Make sure the less + ;; indented line in this slice has the same column + ;; as that child. + (let* ((child (cdr (assq up acc-end))) + (ind (org-list-get-ind child struct)) + (min-ind most-positive-fixnum)) + (save-excursion + (goto-char up) + (while (< (point) down) + ;; Ignore empty lines. Also ignore blocks and + ;; drawers contents. + (unless (looking-at-p "[ \t]*$") + (setq min-ind (min (org-get-indentation) min-ind)) + (cond + ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") + (re-search-forward + (format "^[ \t]*#\\+END%s[ \t]*$" + (match-string 1)) + down t))) + ((and (looking-at org-drawer-regexp) + (re-search-forward "^[ \t]*:END:[ \t]*$" + down t))))) + (forward-line))) + (- ind min-ind))))) + (push (list down up delta) sliced-struct))) ;; 3. Shift each slice in buffer, provided delta isn't 0, from ;; end to beginning. Take a special action when beginning is ;; at item bullet. (dolist (e sliced-struct) - (unless (and (zerop (nth 2 e)) (not (nth 3 e))) - (apply shift-body-ind e)) + (unless (zerop (nth 2 e)) (apply shift-body-ind e)) (let* ((beg (nth 1 e)) (cell (assq beg struct))) (unless (or (not cell) (equal cell (assq beg old-struct))) @@ -2060,16 +2095,27 @@ Possible values are: `folded', `children' or `subtree'. See (defun org-list-item-body-column (item) "Return column at which body of ITEM should start." - (let (bpos bcol tpos tcol) - (save-excursion - (goto-char item) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column))) - (when (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5)))) - tcol)) + (save-excursion + (goto-char item) + (if (save-excursion + (end-of-line) + (re-search-backward + "[ \t]::\\([ \t]\\|$\\)" (line-beginning-position) t)) + ;; Descriptive list item. Body starts after item's tag, if + ;; possible. + (let ((start (1+ (- (match-beginning 1) (line-beginning-position)))) + (ind (org-get-indentation))) + (if (> start (+ ind org-list-description-max-indent)) + (+ ind 5) + start)) + ;; Regular item. Body starts after bullet. + (looking-at "[ \t]*\\(\\S-+\\)") + (+ (progn (goto-char (match-end 1)) (current-column)) + (if (and org-list-two-spaces-after-bullet-regexp + (string-match-p org-list-two-spaces-after-bullet-regexp + (match-string 1))) + 2 + 1))))) @@ -2210,7 +2256,7 @@ item is invisible." (unless (or (not itemp) (save-excursion (goto-char itemp) - (outline-invisible-p))) + (org-invisible-p))) (if (save-excursion (goto-char itemp) (org-at-item-timer-p)) @@ -2325,9 +2371,6 @@ in subtree, ignoring drawers." block-item lim-up lim-down - (drawer-re (concat "^[ \t]*:\\(" - (mapconcat #'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string @@ -2349,7 +2392,8 @@ in subtree, ignoring drawers." ;; time-stamps (scheduled, etc.). (let ((limit (save-excursion (outline-next-heading) (point)))) (forward-line 1) - (while (or (looking-at drawer-re) (looking-at keyword-re)) + (while (or (looking-at org-drawer-regexp) + (looking-at keyword-re)) (if (looking-at keyword-re) (forward-line 1) (re-search-forward "^[ \t]*:END:" limit nil))) @@ -2388,7 +2432,7 @@ in subtree, ignoring drawers." (parents (org-list-parents-alist struct)) (prevs (org-list-prevs-alist struct)) (bottom (copy-marker (org-list-get-bottom-point struct))) - (items-to-toggle (org-remove-if + (items-to-toggle (cl-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) (mapcar #'car struct)))) (mapc (lambda (e) (org-list-set-checkbox @@ -2439,130 +2483,129 @@ in subtree, ignoring drawers." (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. + This will find all statistic cookies like [57%] and [6/12] and update them with the current numbers. With optional prefix argument ALL, do this for the whole buffer." (interactive "P") - (save-excursion - (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (org-with-wide-buffer + (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\ +\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") (recursivep (or (not org-checkbox-hierarchical-statistics) (string-match "\\" (or (org-entry-get nil "COOKIE_DATA") "")))) - (bounds (if all - (cons (point-min) (point-max)) - (cons (or (ignore-errors (org-back-to-heading t) (point)) - (point-min)) - (save-excursion (outline-next-heading) (point))))) + (within-inlinetask (and (not all) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (end (cond (all (point-max)) + (within-inlinetask + (save-excursion (outline-next-heading) (point))) + (t (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point))))) (count-boxes - (function - ;; Return number of checked boxes and boxes of all types - ;; in all structures in STRUCTS. If RECURSIVEP is - ;; non-nil, also count boxes in sub-lists. If ITEM is - ;; nil, count across the whole structure, else count only - ;; across subtree whose ancestor is ITEM. - (lambda (item structs recursivep) - (let ((c-on 0) (c-all 0)) - (mapc - (lambda (s) - (let* ((pre (org-list-prevs-alist s)) - (par (org-list-parents-alist s)) - (items - (cond - ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar #'car s)) - (item (org-list-get-children item s par)) - (t (org-list-get-all-items - (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (setq c-all (+ (length cookies) c-all) - c-on (+ (org-count "[X]" cookies) c-on)))) - structs) - (cons c-on c-all))))) - (backup-end 1) - cookies-list structs-bak) - (goto-char (car bounds)) - ;; 1. Build an alist for each cookie found within BOUNDS. The - ;; key will be position at beginning of cookie and values - ;; ending position, format of cookie, and a cell whose car is - ;; number of checked boxes to report, and cdr total number of - ;; boxes. - (while (re-search-forward cookie-re (cdr bounds) t) - (catch 'skip - (save-excursion - (push - (list - (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-string 2) ; percent? - (cond ; boxes count - ;; Cookie is at an heading, but specifically for todo, - ;; not for checkboxes: skip it. - ((and (org-at-heading-p) - (string-match "\\" - (downcase - (or (org-entry-get nil "COOKIE_DATA") "")))) - (throw 'skip nil)) - ;; Cookie is at an heading, but all lists before next - ;; heading already have been read. Use data collected - ;; in STRUCTS-BAK. This should only happen when - ;; heading has more than one cookie on it. - ((and (org-at-heading-p) - (<= (save-excursion (outline-next-heading) (point)) - backup-end)) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at a fresh heading. Grab structure of - ;; every list containing a checkbox between point and - ;; next headline, and save them in STRUCTS-BAK. - ((org-at-heading-p) - (setq backup-end (save-excursion - (outline-next-heading) (point)) - structs-bak nil) - (while (org-list-search-forward box-re backup-end 'move) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (push struct structs-bak) - (goto-char bottom))) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at an item, and we already have list - ;; structure stored in STRUCTS-BAK. - ((and (org-at-item-p) - (< (point-at-bol) backup-end) - ;; Only lists in no special context are stored. - (not (nth 2 (org-list-context)))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Cookie is at an item, but we need to compute list - ;; structure. - ((org-at-item-p) - (let ((struct (org-list-struct))) - (setq backup-end (org-list-get-bottom-point struct) - structs-bak (list struct))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Else, cookie found is at a wrong place. Skip it. - (t (throw 'skip nil)))) - cookies-list)))) - ;; 2. Apply alist to buffer, in reverse order so positions stay - ;; unchanged after cookie modifications. - (mapc (lambda (cookie) - (let* ((beg (car cookie)) - (end (nth 1 cookie)) - (percentp (nth 2 cookie)) - (checked (car (nth 3 cookie))) - (total (cdr (nth 3 cookie))) - (new (if percentp - (format "[%d%%]" (floor (* 100.0 checked) - (max 1 total))) - (format "[%d/%d]" checked total)))) - (goto-char beg) - (insert new) - (delete-region (point) (+ (point) (- end beg))) - (when org-auto-align-tags (org-fix-tags-on-the-fly)))) + (lambda (item structs recursivep) + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is + ;; non-nil, also count boxes in sub-lists. If ITEM is + ;; nil, count across the whole structure, else count only + ;; across subtree whose ancestor is ITEM. + (let ((c-on 0) (c-all 0)) + (dolist (s structs (list c-on c-all)) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar #'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (cl-incf c-all (length cookies)) + (cl-incf c-on (cl-count "[X]" cookies :test #'equal))))))) + cookies-list cache) + ;; Move to start. + (cond (all (goto-char (point-min))) + (within-inlinetask (org-back-to-heading t)) + (t (org-with-limited-levels (outline-previous-heading)))) + ;; Build an alist for each cookie found. The key is the position + ;; at beginning of cookie and values ending position, format of + ;; cookie, number of checked boxes to report and total number of + ;; boxes. + (while (re-search-forward cookie-re end t) + (let ((context (save-excursion (backward-char) + (save-match-data (org-element-context))))) + (when (eq (org-element-type context) 'statistics-cookie) + (push + (append + (list (match-beginning 1) (match-end 1) (match-end 2)) + (let* ((container + (org-element-lineage + context + '(drawer center-block dynamic-block inlinetask item + quote-block special-block verse-block))) + (beg (if container + (org-element-property :contents-begin container) + (save-excursion + (org-with-limited-levels + (outline-previous-heading)) + (point))))) + (or (cdr (assq beg cache)) + (save-excursion + (goto-char beg) + (let ((end + (if container + (org-element-property :contents-end container) + (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point)))) + structs) + (while (re-search-forward box-re end t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'item) + (push (org-element-property :structure element) + structs) + ;; Skip whole list since we have its + ;; structure anyway. + (while (setq element (org-element-lineage + element '(plain-list))) + (goto-char + (min (org-element-property :end element) + end)))))) + ;; Cache count for cookies applying to the same + ;; area. Then return it. + (let ((count + (funcall count-boxes + (and (eq (org-element-type container) + 'item) + (org-element-property + :begin container)) + structs + recursivep))) + (push (cons beg count) cache) + count)))))) cookies-list)))) + ;; Apply alist to buffer. + (dolist (cookie cookies-list) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percent (nth 2 cookie)) + (checked (nth 3 cookie)) + (total (nth 4 cookie))) + (goto-char beg) + (insert + (if percent (format "[%d%%]" (floor (* 100.0 checked) + (max 1 total))) + (format "[%d/%d]" checked total))) + (delete-region (point) (+ (point) (- end beg))) + (when org-auto-align-tags (org-fix-tags-on-the-fly))))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. @@ -2664,7 +2707,7 @@ Return t if successful." ;; of the subtree mustn't have a child. (let ((last-item (caar (reverse - (org-remove-if + (cl-remove-if (lambda (e) (>= (car e) end)) struct))))) (org-list-has-child-p last-item struct)))) @@ -2781,7 +2824,7 @@ Return t at each successful move." ((and (= ind (car org-tab-ind-state)) (ignore-errors (org-list-indent-item-generic 1 t struct)))) (t (delete-region (point-at-bol) (point-at-eol)) - (org-indent-to-column (car org-tab-ind-state)) + (indent-to-column (car org-tab-ind-state)) (insert (cdr org-tab-ind-state) " ") ;; Break cycle (setq this-command 'identity))) @@ -2794,7 +2837,8 @@ Return t at each successful move." (t (user-error "Cannot move item")))) t)))) -(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) +(defun org-sort-list + (&optional with-case sorting-type getkey-func compare-func interactive?) "Sort list items. The cursor may be at any item of the list that should be sorted. Sublists are not sorted. Checkboxes, if any, are ignored. @@ -2820,13 +2864,15 @@ Capital letters will reverse the sort order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the -record. It must return either a string or a number that should -serve as the sorting key for that record. It will then use -COMPARE-FUNC to compare entries. +record. It must return a value that is compatible with COMPARE-FUNC, +the function used to compare entries. Sorting is done against the visible part of the headlines, it -ignores hidden links." - (interactive "P") +ignores hidden links. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil t)) (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) @@ -2838,23 +2884,31 @@ ignores hidden links." (message "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") (read-char-exclusive)))) + (dcst (downcase sorting-type)) (getkey-func - (or getkey-func - (and (= (downcase sorting-type) ?f) - (intern (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)))))) + (and (= dcst ?f) + (or getkey-func + (and interactive? + (org-read-function "Function for extracting keys: ")) + (error "Missing key extractor")))) + (sort-func + (cond + ((= dcst ?a) #'string<) + ((= dcst ?f) + (or compare-func + (and interactive? + (org-read-function + (concat "Function for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty)))) + ((= dcst ?t) #'<) + ((= dcst ?x) #'string<)))) (message "Sorting items...") (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (let* ((dcst (downcase sorting-type)) - (case-fold-search nil) + (let* ((case-fold-search nil) (now (current-time)) - (sort-func (cond - ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) - ((= dcst ?t) '<) - ((= dcst ?x) 'string<))) (next-record (lambda () (skip-chars-forward " \r\t\n") (or (eobp) (beginning-of-line)))) @@ -2908,128 +2962,249 @@ ignores hidden links." (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) +(defun org-toggle-item (arg) + "Convert headings or normal lines to items, items to normal lines. +If there is no active region, only the current line is considered. + +If the first non blank line in the region is a headline, convert +all headlines to items, shifting text accordingly. + +If it is an item, convert all items to normal lines. + +If it is normal text, change region into a list of items. +With a prefix argument ARG, change the region in a single item." + (interactive "P") + (let ((shift-text + (lambda (ind end) + ;; Shift text in current section to IND, from point to END. + ;; The function leaves point to END line. + (let ((min-i 1000) (end (copy-marker end))) + ;; First determine the minimum indentation (MIN-I) of + ;; the text. + (save-excursion + (catch 'exit + (while (< (point) end) + (let ((i (org-get-indentation))) + (cond + ;; Skip blank lines and inline tasks. + ((looking-at "^[ \t]*$")) + ((looking-at org-outline-regexp-bol)) + ;; We can't find less than 0 indentation. + ((zerop i) (throw 'exit (setq min-i 0))) + ((< i min-i) (setq min-i i)))) + (forward-line)))) + ;; Then indent each line so that a line indented to + ;; MIN-I becomes indented to IND. Ignore blank lines + ;; and inline tasks in the process. + (let ((delta (- ind min-i))) + (while (< (point) end) + (unless (or (looking-at "^[ \t]*$") + (looking-at org-outline-regexp-bol)) + (indent-line-to (+ (org-get-indentation) delta))) + (forward-line)))))) + (skip-blanks + (lambda (pos) + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (save-excursion + (goto-char pos) + (skip-chars-forward " \r\t\n") + (point-at-bol)))) + beg end) + ;; Determine boundaries of changes. + (if (org-region-active-p) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (region-end))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Depending on the starting line, choose an action on the text + ;; between BEG and END. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Start at an item: de-itemize. Note that it only + ;; happens when a region is active: `org-ctrl-c-minus' + ;; would call `org-cycle-list-bullet' otherwise. + ((org-at-item-p) + (while (< (point) end) + (when (org-at-item-p) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) + (forward-line))) + ;; Case 2. Start at an heading: convert to items. + ((org-at-heading-p) + (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + ;; Indentation of the first heading. It should be + ;; relative to the indentation of its parent, if any. + (start-ind (save-excursion + (cond + ((not org-adapt-indentation) 0) + ((not (outline-previous-heading)) 0) + (t (length (match-string 0)))))) + ;; Level of first heading. Further headings will be + ;; compared to it to determine hierarchy in the list. + (ref-level (org-reduced-level (org-outline-level)))) + (while (< (point) end) + (let* ((level (org-reduced-level (org-outline-level))) + (delta (max 0 (- level ref-level))) + (todo-state (org-get-todo-state))) + ;; If current headline is less indented than the first + ;; one, set it as reference, in order to preserve + ;; subtrees. + (when (< level ref-level) (setq ref-level level)) + ;; Remove stars and TODO keyword. + (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) + (delete-region (point) (or (match-beginning 3) + (line-end-position))) + (insert bul) + (indent-line-to (+ start-ind (* delta bul-len))) + ;; Turn TODO keyword into a check box. + (when todo-state + (let* ((struct (org-list-struct)) + (old (copy-tree struct))) + (org-list-set-checkbox + (line-beginning-position) + struct + (if (member todo-state org-done-keywords) + "[X]" + "[ ]")) + (org-list-write-struct struct + (org-list-parents-alist struct) + old))) + ;; Ensure all text down to END (or SECTION-END) belongs + ;; to the newly created item. + (let ((section-end (save-excursion + (or (outline-next-heading) (point))))) + (forward-line) + (funcall shift-text + (+ start-ind (* (1+ delta) bul-len)) + (min end section-end))))))) + ;; Case 3. Normal line with ARG: make the first line of region + ;; an item, and shift indentation of others lines to + ;; set them as item's body. + (arg (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) + (skip-chars-forward " \t") + (insert bul) + (forward-line) + (while (< (point) end) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (funcall shift-text + (+ ref-ind bul-len) + (min end (save-excursion (or (outline-next-heading) + (point))))) + (forward-line)))) + ;; Case 4. Normal line without ARG: turn each non-item line + ;; into an item. + (t + (while (< (point) end) + (unless (or (org-at-heading-p) (org-at-item-p)) + (when (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line)))))))) ;;; Send and receive lists -(defun org-list-parse-list (&optional delete) +(defun org-list-to-lisp (&optional delete) "Parse the list at point and maybe DELETE it. Return a list whose car is a symbol of list type, among `ordered', `unordered' and `descriptive'. Then, each item is -a list whose car is counter, and cdr are strings and other -sub-lists. Inside strings, check-boxes are replaced by -\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". +a list of strings and other sub-lists. For example, the following list: -1. first item - + sub-item one - + [X] sub-item two - more text in first item -2. [@3] last item + 1. first item + + sub-item one + + [X] sub-item two + more text in first item + 2. [@3] last item -will be parsed as: +is parsed as (ordered - (nil \"first item\" - (unordered - (nil \"sub-item one\") - (nil \"[CBON] sub-item two\")) - \"more text in first item\") - (3 \"last item\")) - -Point is left at list end." - (defvar parse-item) ;FIXME: Or use `cl-labels' or `letrec'. - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (parents (org-list-parents-alist struct)) - (top (org-list-get-top-point struct)) - (bottom (org-list-get-bottom-point struct)) - out - (get-text - (function - ;; Return text between BEG and END, trimmed, with - ;; checkboxes replaced. - (lambda (beg end) - (let ((text (org-trim (buffer-substring beg end)))) - (if (string-match "\\`\\[\\([-X ]\\)\\]" text) - (replace-match - (let ((box (match-string 1 text))) - (cond - ((equal box " ") "CBOFF") - ((equal box "-") "CBTRANS") - (t "CBON"))) - t nil text 1) - text))))) - (parse-sublist - (function - ;; Return a list whose car is list type and cdr a list of - ;; items' body. - (lambda (e) - (cons (org-list-get-list-type (car e) struct prevs) - (mapcar parse-item e))))) - (parse-item - (function - ;; Return a list containing counter of item, if any, text - ;; and any sublist inside it. - (lambda (e) - (let ((start (save-excursion - (goto-char e) - (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") - (match-end 0))) - ;; Get counter number. For alphabetic counter, get - ;; its position in the alphabet. - (counter (let ((c (org-list-get-counter e struct))) - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c)))))) - (childp (org-list-has-child-p e struct)) - (end (org-list-get-item-end e struct))) - ;; If item has a child, store text between bullet and - ;; next child, then recursively parse all sublists. At - ;; the end of each sublist, check for the presence of - ;; text belonging to the original item. - (if childp - (let* ((children (org-list-get-children e struct parents)) - (body (list (funcall get-text start childp)))) - (while children - (let* ((first (car children)) - (sub (org-list-get-all-items first struct prevs)) - (last-c (car (last sub))) - (last-end (org-list-get-item-end last-c struct))) - (push (funcall parse-sublist sub) body) - ;; Remove children from the list just parsed. - (setq children (cdr (member last-c children))) - ;; There is a chunk of text belonging to the - ;; item if last child doesn't end where next - ;; child starts or where item ends. - (unless (= (or (car children) end) last-end) - (push (funcall get-text - last-end (or (car children) end)) - body)))) - (cons counter (nreverse body))) - (list counter (funcall get-text start end)))))))) + (\"first item\" + (unordered + (\"sub-item one\") + (\"[X] sub-item two\")) + \"more text in first item\") + (\"[@3] last item\")) + +Point is left at list's end." + (letrec ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + (trim + (lambda (text) + ;; Remove indentation and final newline from TEXT. + (org-remove-indentation + (if (string-match-p "\n\\'" text) + (substring text 0 -1) + text)))) + (parse-sublist + (lambda (e) + ;; Return a list whose car is list type and cdr a list + ;; of items' body. + (cons (org-list-get-list-type (car e) struct prevs) + (mapcar parse-item e)))) + (parse-item + (lambda (e) + ;; Return a list containing counter of item, if any, + ;; text and any sublist inside it. + (let* ((end (org-list-get-item-end e struct)) + (children (org-list-get-children e struct parents)) + (body + (save-excursion + (goto-char e) + (looking-at "[ \t]*\\S-+[ \t]*") + (list + (funcall + trim + (concat + (make-string (string-width (match-string 0)) ?\s) + (buffer-substring-no-properties + (match-end 0) (or (car children) end)))))))) + (while children + (let* ((child (car children)) + (sub (org-list-get-all-items child struct prevs)) + (last-in-sub (car (last sub)))) + (push (funcall parse-sublist sub) body) + ;; Remove whole sub-list from children. + (setq children (cdr (memq last-in-sub children))) + ;; There is a chunk of text belonging to the item + ;; if last child doesn't end where next child + ;; starts or where item ends. + (let ((sub-end (org-list-get-item-end last-in-sub struct)) + (next (or (car children) end))) + (when (/= sub-end next) + (push (funcall + trim + (buffer-substring-no-properties sub-end next)) + body))))) + (nreverse body))))) ;; Store output, take care of cursor position and deletion of ;; list, then return output. - (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) - (goto-char top) - (when delete - (delete-region top bottom) - (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) - (replace-match ""))) - out)) + (prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs)) + (goto-char top) + (when delete + (delete-region top bottom) + (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) + (replace-match "")))))) (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) (if (not (ignore-errors (goto-char (org-in-item-p)))) (error "Not in a list") - (let ((list (save-excursion (org-list-parse-list t)))) + (let ((list (save-excursion (org-list-to-lisp t)))) (insert (org-list-to-subtree list))))) (defun org-list-insert-radio-list () @@ -3055,11 +3230,13 @@ for this list." (catch 'exit (unless (org-at-item-p) (error "Not at a list item")) (save-excursion - (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") - (if maybe (throw 'exit nil) - (error "Don't know how to transform this list")))) - (let* ((name (match-string 1)) + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*#\\+ORGLST:" nil t) + (unless (looking-at + "[ \t]*#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\([^ \t\n]+\\)") + (if maybe (throw 'exit nil) + (error "Don't know how to transform this list"))))) + (let* ((name (regexp-quote (match-string 1))) (transform (intern (match-string 2))) (bottom-point (save-excursion @@ -3071,220 +3248,342 @@ for this list." (re-search-backward "#\\+ORGLST" nil t) (re-search-forward (org-item-beginning-re) bottom-point t) (match-beginning 0))) - (plain-list (buffer-substring-no-properties top-point bottom-point)) - beg) + (plain-list (save-excursion + (goto-char top-point) + (org-list-to-lisp)))) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform plain-list))) - ;; Find the insertion place + ;; Find the insertion(s) place(s). (save-excursion (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" - name - "\\([ \t]\\|$\\)") - nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (delete-region beg (point-at-bol)) - (goto-char beg) - (insert txt "\n"))) - (message "List converted and installed at receiver location")))) - -(defsubst org-list-item-trim-br (item) - "Trim line breaks in a list ITEM." - (setq item (replace-regexp-in-string "\n +" " " item))) + (let ((receiver-count 0) + (begin-re (format "BEGIN +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)" + name)) + (end-re (format "END +RECEIVE +ORGLST +%s\\([ \t]\\|$\\)" + name))) + (while (re-search-forward begin-re nil t) + (cl-incf receiver-count) + (let ((beg (line-beginning-position 2))) + (unless (re-search-forward end-re nil t) + (user-error "Cannot find end of receiver location at %d" beg)) + (beginning-of-line) + (delete-region beg (point)) + (insert txt "\n"))) + (cond + ((> receiver-count 1) + (message "List converted and installed at receiver locations")) + ((= receiver-count 1) + (message "List converted and installed at receiver location")) + (t (user-error "No valid receiver location found"))))))))) (defun org-list-to-generic (list params) - "Convert a LIST parsed through `org-list-parse-list' to other formats. -Valid parameters PARAMS are: - -:ustart String to start an unordered list -:uend String to end an unordered list - -:ostart String to start an ordered list -:oend String to end an ordered list - -:dstart String to start a descriptive list -:dend String to end a descriptive list -:dtstart String to start a descriptive term -:dtend String to end a descriptive term -:ddstart String to start a description -:ddend String to end a description - -:splice When set to t, return only list body lines, don't wrap - them into :[u/o]start and :[u/o]end. Default is nil. - -:istart String to start a list item. -:icount String to start an item with a counter. -:iend String to end a list item -:isep String to separate items -:lsep String to separate sublists -:csep String to separate text from a sub-list - -:cboff String to insert for an unchecked check-box -:cbon String to insert for a checked check-box -:cbtrans String to insert for a check-box in transitional state - -:nobr Non-nil means remove line breaks in lists items. - -Alternatively, each parameter can also be a form returning -a string. These sexp can use keywords `counter' and `depth', -representing respectively counter associated to the current -item, and depth of the current sub-list, starting at 0. -Obviously, `counter' is only available for parameters applying to -items." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (icount (plist-get p :icount)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (csep (plist-get p :csep)) - (cbon (plist-get p :cbon)) - (cboff (plist-get p :cboff)) - (cbtrans (plist-get p :cbtrans)) - (nobr (plist-get p :nobr)) - export-sublist ; for byte-compiler - (export-item - (function - ;; Export an item ITEM of type TYPE, at DEPTH. First - ;; string in item is treated in a special way as it can - ;; bring extra information that needs to be processed. - (lambda (item type depth) - (let* ((counter (pop item)) - (fmt (concat - (cond - ((eq type 'descriptive) - ;; Stick DTSTART to ISTART by - ;; left-trimming the latter. - (concat (let ((s (eval istart))) - (or (and (string-match "[ \t\n\r]+\\'" s) - (replace-match "" t t s)) - istart)) - "%s" (eval ddend))) - ((and counter (eq type 'ordered)) - (concat (eval icount) "%s")) - (t (concat (eval istart) "%s"))) - (eval iend))) - (first (car item))) - ;; Replace checkbox if any is found. - (cond - ((string-match "\\[CBON\\]" first) - (setq first (replace-match cbon t t first))) - ((string-match "\\[CBOFF\\]" first) - (setq first (replace-match cboff t t first))) - ((string-match "\\[CBTRANS\\]" first) - (setq first (replace-match cbtrans t t first)))) - ;; Replace line breaks if required - (when nobr (setq first (org-list-item-trim-br first))) - ;; Insert descriptive term if TYPE is `descriptive'. - (when (eq type 'descriptive) - (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first)) - (term (if complete - (save-match-data - (org-trim (match-string 1 first))) - "???")) - (desc (if complete - (org-trim (substring first (match-end 0))) - first))) - (setq first (concat (eval dtstart) term (eval dtend) - (eval ddstart) desc)))) - (setcar item first) - (format fmt - (mapconcat (lambda (e) - (if (stringp e) e - (funcall export-sublist e (1+ depth)))) - item (or (eval csep) ""))))))) - (export-sublist - (function - ;; Export sublist SUB at DEPTH. - (lambda (sub depth) - (let* ((type (car sub)) - (items (cdr sub)) - (fmt (concat (cond - (splicep "%s") - ((eq type 'ordered) - (concat (eval ostart) "%s" (eval oend))) - ((eq type 'descriptive) - (concat (eval dstart) "%s" (eval dend))) - (t (concat (eval ustart) "%s" (eval uend)))) - (eval lsep)))) - (format fmt (mapconcat (lambda (e) - (funcall export-item e type depth)) - items (or (eval isep) "")))))))) - (concat (funcall export-sublist list 0) "\n"))) - -(defun org-list-to-latex (list &optional _params) + "Convert a LIST parsed through `org-list-to-lisp' to a custom format. + +LIST is a list as returned by `org-list-to-lisp', which see. +PARAMS is a property list of parameters used to tweak the output +format. + +Valid parameters are: + +:backend, :raw + + Export back-end used as a basis to transcode elements of the + list, when no specific parameter applies to it. It is also + used to translate its contents. You can prevent this by + setting :raw property to a non-nil value. + +:splice + + When non-nil, only export the contents of the top most plain + list, effectively ignoring its opening and closing lines. + +:ustart, :uend + + Strings to start and end an unordered list. They can also be + set to a function returning a string or nil, which will be + called with the depth of the list, counting from 1. + +:ostart, :oend + + Strings to start and end an ordered list. They can also be set + to a function returning a string or nil, which will be called + with the depth of the list, counting from 1. + +:dstart, :dend + + Strings to start and end a descriptive list. They can also be + set to a function returning a string or nil, which will be + called with the depth of the list, counting from 1. + +:dtstart, :dtend, :ddstart, :ddend + + Strings to start and end a descriptive term. + +:istart, :iend + + Strings to start or end a list item, and to start a list item + with a counter. They can also be set to a function returning + a string or nil, which will be called with the depth of the + item, counting from 1. + +:icount + + Strings to start a list item with a counter. It can also be + set to a function returning a string or nil, which will be + called with two arguments: the depth of the item, counting from + 1, and the counter. Its value, when non-nil, has precedence + over `:istart'. + +:isep + + String used to separate items. It can also be set to + a function returning a string or nil, which will be called with + the depth of the items, counting from 1. It always start on + a new line. + +:cbon, :cboff, :cbtrans + + String to insert, respectively, an un-checked check-box, + a checked check-box and a check-box in transitional state." + (require 'ox) + (let* ((backend (plist-get params :backend)) + (custom-backend + (org-export-create-backend + :parent (or backend 'org) + :transcoders + `((plain-list . ,(org-list--to-generic-plain-list params)) + (item . ,(org-list--to-generic-item params)) + (macro . (lambda (m c i) (org-element-macro-interpreter m nil)))))) + data info) + ;; Write LIST back into Org syntax and parse it. + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (letrec ((insert-list + (lambda (l) + (dolist (i (cdr l)) + (funcall insert-item i (car l))))) + (insert-item + (lambda (i type) + (let ((start (point))) + (insert (if (eq type 'ordered) "1. " "- ")) + (dolist (e i) + (if (consp e) (funcall insert-list e) + (insert e) + (insert "\n"))) + (beginning-of-line) + (save-excursion + (let ((ind (if (eq type 'ordered) 3 2))) + (while (> (point) start) + (unless (looking-at-p "[ \t]*$") + (indent-to ind)) + (forward-line -1)))))))) + (funcall insert-list list)) + (setf data + (org-element-map (org-element-parse-buffer) 'plain-list + #'identity nil t)) + (setf info (org-export-get-environment backend nil params))) + (when (and backend (symbolp backend) (not (org-export-get-backend backend))) + (user-error "Unknown :backend value")) + (unless backend (require 'ox-org)) + ;; When`:raw' property has a non-nil value, turn all objects back + ;; into Org syntax. + (when (and backend (plist-get params :raw)) + (org-element-map data org-element-all-objects + (lambda (object) + (org-element-set-element + object (org-element-interpret-data object))))) + ;; We use a low-level mechanism to export DATA so as to skip all + ;; usual pre-processing and post-processing, i.e., hooks, filters, + ;; Babel code evaluation, include keywords and macro expansion, + ;; and filters. + (let ((output (org-export-data-with-backend data custom-backend info))) + ;; Remove final newline. + (if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) + +(defun org-list--depth (element) + "Return the level of ELEMENT within current plain list. +ELEMENT is either an item or a plain list." + (cl-count-if (lambda (ancestor) (eq (org-element-type ancestor) 'plain-list)) + (org-element-lineage element nil t))) + +(defun org-list--trailing-newlines (string) + "Return the number of trailing newlines in STRING." + (with-temp-buffer + (insert string) + (skip-chars-backward " \t\n") + (count-lines (line-beginning-position 2) (point-max)))) + +(defun org-list--generic-eval (value &rest args) + "Evaluate VALUE according to its type. +VALUE is either nil, a string or a function. In the latter case, +it is called with arguments ARGS." + (cond ((null value) nil) + ((stringp value) value) + ((functionp value) (apply value args)) + (t (error "Wrong value: %s" value)))) + +(defun org-list--to-generic-plain-list (params) + "Return a transcoder for `plain-list' elements. +PARAMS is a plist used to tweak the behavior of the transcoder." + (let ((ustart (plist-get params :ustart)) + (uend (plist-get params :uend)) + (ostart (plist-get params :ostart)) + (oend (plist-get params :oend)) + (dstart (plist-get params :dstart)) + (dend (plist-get params :dend)) + (splice (plist-get params :splice)) + (backend (plist-get params :backend))) + (lambda (plain-list contents info) + (let* ((type (org-element-property :type plain-list)) + (depth (org-list--depth plain-list)) + (start (and (not splice) + (org-list--generic-eval + (pcase type + (`ordered ostart) + (`unordered ustart) + (_ dstart)) + depth))) + (end (and (not splice) + (org-list--generic-eval + (pcase type + (`ordered oend) + (`unordered uend) + (_ dend)) + depth)))) + ;; Make sure trailing newlines in END appear in the output by + ;; setting `:post-blank' property to their number. + (when end + (org-element-put-property + plain-list :post-blank (org-list--trailing-newlines end))) + ;; Build output. + (concat (and start (concat start "\n")) + (if (or start end splice (not backend)) + contents + (org-export-with-backend backend plain-list contents info)) + end))))) + +(defun org-list--to-generic-item (params) + "Return a transcoder for `item' elements. +PARAMS is a plist used to tweak the behavior of the transcoder." + (let ((backend (plist-get params :backend)) + (istart (plist-get params :istart)) + (iend (plist-get params :iend)) + (isep (plist-get params :isep)) + (icount (plist-get params :icount)) + (cboff (plist-get params :cboff)) + (cbon (plist-get params :cbon)) + (cbtrans (plist-get params :cbtrans)) + (dtstart (plist-get params :dtstart)) + (dtend (plist-get params :dtend)) + (ddstart (plist-get params :ddstart)) + (ddend (plist-get params :ddend))) + (lambda (item contents info) + (let* ((type + (org-element-property :type (org-element-property :parent item))) + (tag (org-element-property :tag item)) + (depth (org-list--depth item)) + (separator (and (org-export-get-next-element item info) + (org-list--generic-eval isep depth))) + (closing (pcase (org-list--generic-eval iend depth) + ((or `nil `"") "\n") + ((and (guard separator) s) + (if (equal (substring s -1) "\n") s (concat s "\n"))) + (s s)))) + ;; When a closing line or a separator is provided, make sure + ;; its trailing newlines are taken into account when building + ;; output. This is done by setting `:post-blank' property to + ;; the number of such lines in the last line to be added. + (let ((last-string (or separator closing))) + (when last-string + (org-element-put-property + item + :post-blank + (max (1- (org-list--trailing-newlines last-string)) 0)))) + ;; Build output. + (concat + (let ((c (org-element-property :counter item))) + (if c (org-list--generic-eval icount depth c) + (org-list--generic-eval istart depth))) + (let ((body + (if (or istart iend icount cbon cboff cbtrans (not backend) + (and (eq type 'descriptive) + (or dtstart dtend ddstart ddend))) + (concat + (pcase (org-element-property :checkbox item) + (`on cbon) + (`off cboff) + (`trans cbtrans)) + (and tag + (concat dtstart + (if backend + (org-export-data-with-backend + tag backend info) + (org-element-interpret-data tag)) + dtend)) + (and tag ddstart) + (if (= (length contents) 0) "" (substring contents 0 -1)) + (and tag ddend)) + (org-export-with-backend backend item contents info)))) + ;; Remove final newline. + (if (equal body "") "" + (substring (org-element-normalize-string body) 0 -1))) + closing + separator))))) + +(defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-latex) - (org-export-string-as list 'latex t)) + (org-list-to-generic list (org-combine-plists '(:backend latex) params))) -(defun org-list-to-html (list) +(defun org-list-to-html (list &optional params) "Convert LIST into a HTML list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-html) - (org-export-string-as list 'html t)) + (org-list-to-generic list (org-combine-plists '(:backend html) params))) -(defun org-list-to-texinfo (list &optional _params) +(defun org-list-to-texinfo (list &optional params) "Convert LIST into a Texinfo list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." +LIST is a parsed plain list, as returned by `org-list-to-lisp'. +PARAMS is a property list with overruling parameters for +`org-list-to-generic'. Return converted list as a string." (require 'ox-texinfo) - (org-export-string-as list 'texinfo t)) + (org-list-to-generic list (org-combine-plists '(:backend texinfo) params))) (defun org-list-to-subtree (list &optional params) "Convert LIST into an Org subtree. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (defvar get-stars) (defvar org--blankp) - (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) +LIST is as returned by `org-list-to-lisp'. PARAMS is a property +list with overruling parameters for `org-list-to-generic'." + (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry)) + (`t t) + (`auto (save-excursion + (org-with-limited-levels (outline-previous-heading)) + (org-previous-line-empty-p))))) (level (org-reduced-level (or (org-current-level) 0))) - (org--blankp (or (eq rule t) - (and (eq rule 'auto) - (save-excursion - (outline-previous-heading) - (org-previous-line-empty-p))))) - (get-stars ;FIXME: Can't rename without renaming it in org.el as well! - (function - ;; Return the string for the heading, depending on depth D - ;; of current sub-list. - (lambda (d) - (let ((oddeven-level (+ level d 1))) - (concat (make-string (if org-odd-levels-only - (1- (* 2 oddeven-level)) - oddeven-level) - ?*) - " ")))))) + (make-stars + (lambda (depth) + ;; Return the string for the heading, depending on DEPTH + ;; of current sub-list. + (let ((oddeven-level (+ level depth))) + (concat (make-string (if org-odd-levels-only + (1- (* 2 oddeven-level)) + oddeven-level) + ?*) + " "))))) (org-list-to-generic list (org-combine-plists - '(:splice t - :dtstart " " :dtend " " - :istart (funcall get-stars depth) - :icount (funcall get-stars depth) - :isep (if org--blankp "\n\n" "\n") - :csep (if org--blankp "\n\n" "\n") - :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + (list :splice t + :istart make-stars + :icount make-stars + :dtstart " " :dtend " " + :isep (if blank "\n\n" "\n") + :cbon "DONE " :cboff "TODO " :cbtrans "TODO ") params)))) (provide 'org-list) diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el index f4919d1385..3dc9c5450e 100644 --- a/lisp/org/org-macro.el +++ b/lisp/org/org-macro.el @@ -1,4 +1,4 @@ -;;; org-macro.el --- Macro Replacement Code for Org Mode +;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2013-2017 Free Software Foundation, Inc. @@ -30,6 +30,10 @@ ;; `org-macro-initialize-templates', which recursively calls ;; `org-macro--collect-macros' in order to read setup files. +;; Argument in macros are separated with commas. Proper escaping rules +;; are implemented in `org-macro-escape-arguments' and arguments can +;; be extracted from a string with `org-macro-extract-arguments'. + ;; Along with macros defined through #+MACRO: keyword, default ;; templates include the following hard-coded macros: ;; {{{time(format-string)}}}, {{{property(node-property)}}}, @@ -39,19 +43,25 @@ ;; {{{email}}} and {{{title}}} macros. ;;; Code: +(require 'cl-lib) (require 'org-macs) +(require 'org-compat) -(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-macro-parser "org-element" ()) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) -(declare-function org-remove-double-quotes "org" (s)) -(declare-function org-mode "org" ()) (declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) +(declare-function org-mode "org" ()) +(declare-function vc-backend "vc-hooks" (f)) +(declare-function vc-call "vc-hooks" (fun file &rest args) t) +(declare-function vc-exec-after "vc-dispatcher" (code)) ;;; Variables -(defvar org-macro-templates nil +(defvar-local org-macro-templates nil "Alist containing all macro templates in current buffer. Associations are in the shape of (NAME . TEMPLATE) where NAME stands for macro's name and template for its replacement value, @@ -59,48 +69,48 @@ both as strings. This is an internal variable. Do not set it directly, use instead: #+MACRO: name template") -(make-variable-buffer-local 'org-macro-templates) - ;;; Functions (defun org-macro--collect-macros () "Collect macro definitions in current buffer and setup files. Return an alist containing all macro templates found." - (let* (collect-macros ; For byte-compiler. - (collect-macros - (lambda (files templates) - ;; Return an alist of macro templates. FILES is a list of - ;; setup files names read so far, used to avoid circular - ;; dependencies. TEMPLATES is the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "MACRO") - ;; Install macro in TEMPLATES. - (when (string-match - "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) - (let* ((name (match-string 1 val)) - (template (or (match-string 2 val) "")) - (old-cell (assoc name templates))) - (if old-cell (setcdr old-cell template) - (push (cons name template) templates)))) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (org-mode) - (insert (org-file-contents file 'noerror)) - (setq templates - (funcall collect-macros (cons file files) - templates))))))))))) - templates)))) + (letrec ((collect-macros + (lambda (files templates) + ;; Return an alist of macro templates. FILES is a list + ;; of setup files names read so far, used to avoid + ;; circular dependencies. TEMPLATES is the alist + ;; collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "MACRO") + ;; Install macro in TEMPLATES. + (when (string-match + "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))) + ;; Enter setup file. + (let ((file (expand-file-name + (org-unbracket-string "\"" "\"" val)))) + (unless (member file files) + (with-temp-buffer + (setq default-directory + (file-name-directory file)) + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (funcall collect-macros (cons file files) + templates))))))))))) + templates)))) (funcall collect-macros nil nil))) (defun org-macro-initialize-templates () @@ -117,15 +127,26 @@ function installs the following ones: \"property\", (if old-template (setcdr old-template (cdr cell)) (push cell templates)))))) ;; Install hard-coded macros. - (mapc (lambda (cell) (funcall update-templates cell)) - (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") + (mapc update-templates + (list (cons "property" + "(eval (save-excursion + (let ((l \"$2\")) + (when (org-string-nw-p l) + (condition-case _ + (let ((org-link-search-must-match-exact-headline t)) + (org-link-search l nil t)) + (error + (error \"Macro property failed: cannot find location %s\" + l))))) + (org-entry-get nil \"$1\" 'selective)))") (cons "time" "(eval (format-time-string \"$1\"))"))) (let ((visited-file (buffer-file-name (buffer-base-buffer)))) (when (and visited-file (file-exists-p visited-file)) - (mapc (lambda (cell) (funcall update-templates cell)) + (mapc update-templates (list (cons "input-file" (file-name-nondirectory visited-file)) (cons "modification-time" - (format "(eval (format-time-string \"$1\" '%s))" + (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))" + (prin1-to-string visited-file) (prin1-to-string (nth 5 (file-attributes visited-file))))))))) (setq org-macro-templates templates))) @@ -154,38 +175,132 @@ default value. Return nil if no template was found." ;; Return string. (format "%s" (or value "")))))) -(defun org-macro-replace-all (templates) +(defun org-macro-replace-all (templates &optional finalize keywords) "Replace all macros in current buffer by their expansion. + TEMPLATES is an alist of templates used for expansion. See -`org-macro-templates' for a buffer-local default value." +`org-macro-templates' for a buffer-local default value. + +If optional arg FINALIZE is non-nil, raise an error if a macro is +found in the buffer with no definition in TEMPLATES. + +Optional argument KEYWORDS, when non-nil is a list of keywords, +as strings, where macro expansion is allowed." (save-excursion (goto-char (point-min)) - (let (record) + (let ((properties-regexp + (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) + record) (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (let ((object (org-element-context))) - (when (eq (org-element-type object) 'macro) - (let* ((value (org-macro-expand object templates)) - (begin (org-element-property :begin object)) - (signature (list begin - object - (org-element-property :args object)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the same - ;; position twice. - (if (member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key object)) - (when value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end object)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of recursive - ;; expansions. - (save-excursion (insert value))))))))))) + (unless (save-match-data (org-in-commented-heading-p)) + (let* ((datum (save-match-data (org-element-context))) + (type (org-element-type datum)) + (macro + (cond + ((eq type 'macro) datum) + ;; In parsed keywords and associated node + ;; properties, force macro recognition. + ((or (and (eq type 'keyword) + (member (org-element-property :key datum) + keywords)) + (and (eq type 'node-property) + (string-match-p properties-regexp + (org-element-property :key + datum)))) + (save-excursion + (goto-char (match-beginning 0)) + (org-element-macro-parser)))))) + (when macro + (let* ((value (org-macro-expand macro templates)) + (begin (org-element-property :begin macro)) + (signature (list begin + macro + (org-element-property :args macro)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the + ;; same position twice. + (cond ((member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key macro))) + (value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end macro)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of + ;; recursive expansions. + (save-excursion (insert value))) + (finalize + (error "Undefined Org macro: %s; aborting" + (org-element-property :key macro)))))))))))) + +(defun org-macro-escape-arguments (&rest args) + "Build macro's arguments string from ARGS. +ARGS are strings. Return value is a string with arguments +properly escaped and separated with commas. This is the opposite +of `org-macro-extract-arguments'." + (let ((s "")) + (dolist (arg (reverse args) (substring s 1)) + (setq s + (concat + "," + (replace-regexp-in-string + "\\(\\\\*\\)," + (lambda (m) + (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\) + ",")) + ;; If a non-terminal argument ends on backslashes, make + ;; sure to also escape them as they will be followed by + ;; a comma. + (concat arg (and (not (equal s "")) + (string-match "\\\\+\\'" arg) + (match-string 0 arg))) + nil t) + s))))) + +(defun org-macro-extract-arguments (s) + "Extract macro arguments from string S. +S is a string containing comma separated values properly escaped. +Return a list of arguments, as strings. This is the opposite of +`org-macro-escape-arguments'." + ;; Do not use `org-split-string' since empty strings are + ;; meaningful here. + (split-string + (replace-regexp-in-string + "\\(\\\\*\\)," + (lambda (str) + (let ((len (length (match-string 1 str)))) + (concat (make-string (/ len 2) ?\\) + (if (zerop (mod len 2)) "\000" ",")))) + s nil t) + "\000")) + +(defun org-macro--vc-modified-time (file) + (save-window-excursion + (when (vc-backend file) + (let ((buf (get-buffer-create " *org-vc*")) + (case-fold-search t) + date) + (unwind-protect + (progn + (vc-call print-log file buf nil nil 1) + (with-current-buffer buf + (vc-exec-after + (lambda () + (goto-char (point-min)) + (when (re-search-forward "Date:?[ \t]*" nil t) + (let ((time (parse-time-string + (buffer-substring + (point) (line-end-position))))) + (when (cl-some #'identity time) + (setq date (apply #'encode-time time)))))))) + (let ((proc (get-buffer-process buf))) + (while (and proc (accept-process-output proc .5 nil t))))) + (kill-buffer buf)) + date)))) (provide 'org-macro) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index 64e28cee04..ca47e5a5a3 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -1,4 +1,4 @@ -;;; org-macs.el --- Top-level definitions for Org-mode +;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -25,29 +25,12 @@ ;;; Commentary: ;; This file contains macro definitions, defsubst definitions, other -;; stuff needed for compilation and top-level forms in Org-mode, as well -;; lots of small functions that are not org-mode specific but simply -;; generally useful stuff. +;; stuff needed for compilation and top-level forms in Org mode, as +;; well lots of small functions that are not Org mode specific but +;; simply generally useful stuff. ;;; Code: -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional _arglist _fileonly) - `(autoload ',fn ,file))) - - (if (>= emacs-major-version 23) - (defsubst org-char-to-string(c) - "Defsubst to decode UTF-8 character values in emacs 23 and beyond." - (char-to-string c)) - (defsubst org-char-to-string (c) - "Defsubst to decode UTF-8 character values in emacs 22." - (string (decode-char 'ucs c))))) - -(declare-function org-add-props "org-compat" (string plist &rest props)) -(declare-function org-string-match-p "org-compat" - (regexp string &optional start)) - (defmacro org-with-gensyms (symbols &rest body) (declare (debug (sexp body)) (indent 1)) `(let ,(mapcar (lambda (s) @@ -55,26 +38,11 @@ symbols) ,@body)) -(defmacro org-called-interactively-p (&optional kind) - (declare (debug (&optional ("quote" symbolp)))) ;Why not just t? - (if (featurep 'xemacs) - `(interactive-p) - (if (or (> emacs-major-version 23) - (and (>= emacs-major-version 23) - (>= emacs-minor-version 2))) - ;; defined with no argument in <=23.1 - `(with-no-warnings (called-interactively-p ,kind)) - `(interactive-p)))) - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - (declare (debug (symbolp))) - `(and (boundp (quote ,var)) ,var)) - (defun org-string-nw-p (s) - "Is S a string with a non-white character?" + "Return S if S is a string containing a non-blank character. +Otherwise, return nil." (and (stringp s) - (org-string-match-p "\\S-" s) + (string-match-p "[^ \r\t\n]" s) s)) (defun org-not-nil (v) @@ -82,25 +50,6 @@ Otherwise return nil." (and v (not (equal v "nil")) v)) -(defun org-substitute-posix-classes (re) - "Substitute posix classes in regular expression RE." - (let ((ss re)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:word:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - (while (string-match "\\[:punct:\\]" ss) - (setq ss (replace-match "\001-@[-`{-~" t t ss))) - ss))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (declare (debug (form))) - (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s)) - (defmacro org-preserve-lc (&rest body) (declare (debug (body))) (org-with-gensyms (line col) @@ -136,19 +85,6 @@ Otherwise return nil." (partial-completion-mode 1)) ,@body)) -;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 -(defmacro org-maybe-intangible (props) - "Add (intangible t) to PROPS if Emacs version is earlier than Emacs 22. -In Emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - (defmacro org-with-point-at (pom &rest body) "Move to buffer and point of point-or-marker POM for the duration of BODY." (declare (debug (form body)) (indent 1)) @@ -160,10 +96,6 @@ We use a macro so that the test can happen at compilation time." (goto-char (or ,mpom (point))) ,@body))))) -(defmacro org-no-warnings (&rest body) - (declare (debug (body))) - (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) - (defmacro org-with-remote-undo (buffer &rest body) "Execute BODY while recording undo information in two buffers." (declare (debug (form body)) (indent 1)) @@ -199,22 +131,12 @@ We use a macro so that the test can happen at compilation time." org-emphasis t) "Properties to remove when a string without properties is wanted.") -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (and s (remove-text-properties 0 (length s) org-rm-props s)) - s) - (match-string-no-properties num string))) - (defsubst org-no-properties (s &optional restricted) "Remove all text properties from string S. When RESTRICTED is non-nil, only remove the properties listed in `org-rm-props'." - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (if restricted - (remove-text-properties 0 (length s) org-rm-props s) - (set-text-properties 0 (length s) nil s))) + (if restricted (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s)) s) (defsubst org-get-alist-option (option key) @@ -236,16 +158,6 @@ program is needed for, so that the error message can be more informative." (error "Can't find `%s'%s" cmd (if use (format " (%s)" use) ""))))) -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-local-variable var) value)) - (defsubst org-last (list) "Return the last element of LIST." (car (last list))) @@ -282,11 +194,11 @@ we turn off invisibility temporarily. Use this in a `let' form." (<= (match-beginning n) pos) (>= (match-end n) pos))) -(defun org-match-line (re) - "Looking-at at the beginning of the current line." +(defun org-match-line (regexp) + "Match REGEXP at the beginning of the current line." (save-excursion - (goto-char (point-at-bol)) - (looking-at re))) + (beginning-of-line) + (looking-at regexp))) (defun org-plist-delete (plist property) "Delete PROPERTY from PLIST. @@ -298,13 +210,6 @@ This is in contrast to merely setting it to 0." (setq plist (cddr plist))) p)) -(defun org-replace-match-keep-properties (newtext &optional fixedcase - literal string) - "Like `replace-match', but add the text properties found original text." - (setq newtext (org-add-props newtext (text-properties-at - (match-beginning 0) string))) - (replace-match newtext fixedcase literal string)) - (defmacro org-save-outline-visibility (use-markers &rest body) "Save and restore outline visibility around BODY. If USE-MARKERS is non-nil, use markers for the positions. @@ -313,19 +218,15 @@ but it also means that the buffer should stay alive during the operation, because otherwise all these markers will point nowhere." (declare (debug (form body)) (indent 1)) - (org-with-gensyms (data rtn) - `(let ((,data (org-outline-overlay-data ,use-markers)) - ,rtn) + (org-with-gensyms (data) + `(let ((,data (org-outline-overlay-data ,use-markers))) (unwind-protect - (progn - (setq ,rtn (progn ,@body)) + (prog1 (progn ,@body) (org-set-outline-overlay-data ,data)) (when ,use-markers - (mapc (lambda (c) - (and (markerp (car c)) (move-marker (car c) nil)) - (and (markerp (cdr c)) (move-marker (cdr c) nil))) - ,data))) - ,rtn))) + (dolist (c ,data) + (when (markerp (car c)) (move-marker (car c) nil)) + (when (markerp (cdr c)) (move-marker (cdr c) nil)))))))) (defmacro org-with-wide-buffer (&rest body) "Execute body while temporarily widening the buffer." @@ -355,17 +256,16 @@ point nowhere." (defun org-get-limited-outline-regexp () "Return outline-regexp with limited number of levels. The number of levels is controlled by `org-inlinetask-min-level'" - (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask))) - org-outline-regexp - (let* ((limit-level (1- org-inlinetask-min-level)) - (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) - (format "\\*\\{1,%d\\} " nstars)))) - -(defun org-format-seconds (string seconds) - "Compatibility function replacing format-seconds." - (if (fboundp 'format-seconds) - (format-seconds string seconds) - (format-time-string string (seconds-to-time seconds)))) + (cond ((not (derived-mode-p 'org-mode)) + outline-regexp) + ((not (featurep 'org-inlinetask)) + org-outline-regexp) + (t + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only + (1- (* limit-level 2)) + limit-level))) + (format "\\*\\{1,%d\\} " nstars))))) (defmacro org-eval-in-environment (environment form) (declare (debug (form form)) (indent 1)) @@ -382,10 +282,27 @@ the value in cdr." ;;;###autoload (defmacro org-load-noerror-mustsuffix (file) - "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." - (if (featurep 'xemacs) - `(load ,file 'noerror) - `(load ,file 'noerror nil nil 'mustsuffix))) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX." + `(load ,file 'noerror nil nil 'mustsuffix)) + +(defun org-unbracket-string (pre post string) + "Remove PRE/POST from the beginning/end of STRING. +Both PRE and POST must be pre-/suffixes of STRING, or neither is +removed." + (if (and (string-prefix-p pre string) + (string-suffix-p post string)) + (substring string (length pre) (- (length post))) + string)) + +(defun org-read-function (prompt &optional allow-empty?) + "Prompt for a function. +If ALLOW-EMPTY? is non-nil, return nil rather than raising an +error when the user input is empty." + (let ((func (completing-read prompt obarray #'fboundp t))) + (cond ((not (string= func "")) + (intern func)) + (allow-empty? nil) + (t (user-error "Empty input is not valid"))))) (provide 'org-macs) diff --git a/lisp/org/org-mhe.el b/lisp/org/org-mhe.el index d1067cd57e..4142ae45b2 100644 --- a/lisp/org/org-mhe.el +++ b/lisp/org/org-mhe.el @@ -1,4 +1,4 @@ -;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode +;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,8 +24,8 @@ ;; ;;; Commentary: -;; This file implements links to MH-E messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, +;; This file implements links to MH-E messages from within Org. +;; Org mode loads this module by default - if this is not what you want, ;; configure the variable `org-modules'. ;;; Code: @@ -74,34 +74,25 @@ supported by MH-E." (defvar mh-search-regexp-builder) ;; Install the link type -(org-add-link-type "mhe" 'org-mhe-open) -(add-hook 'org-store-link-functions 'org-mhe-store-link) +(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link) ;; Implementation (defun org-mhe-store-link () "Store a link to an MH-E folder or message." - (when (or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) + (when (or (eq major-mode 'mh-folder-mode) + (eq major-mode 'mh-show-mode)) (save-window-excursion (let* ((from (org-mhe-get-header "From:")) (to (org-mhe-get-header "To:")) (message-id (org-mhe-get-header "Message-Id:")) (subject (org-mhe-get-header "Subject:")) (date (org-mhe-get-header "Date:")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) link desc) - (org-store-link-props :type "mh" :from from :to to + (org-store-link-props :type "mh" :from from :to to :date date :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) (setq desc (org-email-link-description)) (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) + (org-unbracket-string "<" ">" message-id))) (org-add-link-props :link link :description desc) link)))) @@ -120,7 +111,7 @@ supported by MH-E." So if you use sequences, it will now work." (save-excursion (let* ((folder - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) mh-current-folder ;; Refer to the show buffer mh-show-folder-buffer)) @@ -132,7 +123,7 @@ So if you use sequences, it will now work." ;; mh-index-data is always nil in a show buffer. (if (and (boundp 'mh-index-folder) (string= mh-index-folder (substring folder 0 end-index))) - (if (equal major-mode 'mh-show-mode) + (if (eq major-mode 'mh-show-mode) (save-window-excursion (let (pop-up-frames) (when (buffer-live-p (get-buffer folder)) @@ -158,7 +149,7 @@ So if you use sequences, it will now work." "Return the name of the current message folder. Be careful if you use sequences." (save-excursion - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) mh-current-folder ;; Refer to the show buffer mh-show-folder-buffer))) @@ -167,7 +158,7 @@ Be careful if you use sequences." "Return the number of the current message. Be careful if you use sequences." (save-excursion - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-get-msg-num nil) ;; Refer to the show buffer (mh-show-buffer-message-number)))) @@ -182,12 +173,12 @@ you have a better idea of how to do this then please let us know." (header-field)) (with-current-buffer buffer (mh-display-msg num folder) - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-header-display) (mh-show-header-display)) (set-buffer buffer) (setq header-field (mh-get-header-field header)) - (if (equal major-mode 'mh-folder-mode) + (if (eq major-mode 'mh-folder-mode) (mh-show) (mh-show-show)) (org-trim header-field)))) @@ -206,13 +197,13 @@ folders." (if (not article) (mh-visit-folder (mh-normalize-folder-name folder)) (mh-search-choose) - (if (equal mh-searcher 'pick) + (if (eq mh-searcher 'pick) (progn (setq article (org-add-angle-brackets article)) (mh-search folder (list "--message-id" article)) (when (and org-mhe-search-all-folders (not (org-mhe-get-message-real-folder))) - (kill-current-buffer) + (kill-buffer) (mh-search "+" (list "--message-id" article)))) (if mh-search-regexp-builder (mh-search "+" (funcall mh-search-regexp-builder @@ -220,7 +211,7 @@ folders." (mh-search "+" article))) (if (org-mhe-get-message-real-folder) (mh-show-msg 1) - (kill-current-buffer) + (kill-buffer) (error "Message not found")))) (provide 'org-mhe) diff --git a/lisp/org/org-mobile.el b/lisp/org/org-mobile.el index 34e6af10d8..12e6c84b3c 100644 --- a/lisp/org/org-mobile.el +++ b/lisp/org/org-mobile.el @@ -1,4 +1,4 @@ -;;; org-mobile.el --- Code for asymmetric sync with a mobile device +;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*- ;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik @@ -24,21 +24,20 @@ ;; ;;; Commentary: ;; -;; This file contains the code to interact with Richard Moreland's iPhone -;; application MobileOrg, as well as with the Android version by Matthew Jones. -;; This code is documented in Appendix B of the Org-mode manual. The code is -;; not specific for the iPhone and Android - any external -;; viewer/flagging/editing application that uses the same conventions could -;; be used. +;; This file contains the code to interact with Richard Moreland's +;; iPhone application MobileOrg, as well as with the Android version +;; by Matthew Jones. This code is documented in Appendix B of the Org +;; manual. The code is not specific for the iPhone and Android - any +;; external viewer/flagging/editing application that uses the same +;; conventions could be used. (require 'org) (require 'org-agenda) -;;; Code: +(require 'cl-lib) -(eval-when-compile (require 'cl)) +(defvar org-agenda-keep-restricted-file-list) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) +;;; Code: (defgroup org-mobile nil "Options concerning support for a viewer/editor on a mobile device." @@ -192,27 +191,6 @@ the editing types for which the mobile version should always dominate." (const heading) (const body)))) -(defcustom org-mobile-action-alist - '(("edit" . (org-mobile-edit data old new))) - "Alist with flags and actions for mobile sync. -When flagging an entry, MobileOrg will create entries that look like - - * F(action:data) [[id:entry-id][entry title]] - -This alist defines that the ACTION in the parentheses of F() should mean, -i.e. what action should be taken. The :data part in the parenthesis is -optional. If present, the string after the colon will be passed to the -action form as the `data' variable. -The car of each elements of the alist is an actions string. The cdr is -an Emacs Lisp form that will be evaluated with the cursor on the headline -of that entry. - -For now, it is not recommended to change this variable." - :group 'org-mobile - :type '(repeat - (cons (string :tag "Action flag") - (sexp :tag "Action form")))) - (defcustom org-mobile-checksum-binary (or (executable-find "shasum") (executable-find "sha1sum") (executable-find "md5sum") @@ -249,6 +227,23 @@ by the mobile device, this hook should be used to copy the emptied capture file `mobileorg.org' back to the WebDAV directory, for example using `rsync' or `scp'.") +(defconst org-mobile-action-alist '(("edit" . org-mobile-edit)) + "Alist with flags and actions for mobile sync. +When flagging an entry, MobileOrg will create entries that look like + + * F(action:data) [[id:entry-id][entry title]] + +This alist defines that the ACTION in the parentheses of F() +should mean, i.e. what action should be taken. The :data part in +the parenthesis is optional. If present, the string after the +colon will be passed to the action function as the first argument +variable. + +The car of each elements of the alist is an actions string. The +cdr is a function that is called with the cursor on the headline +of that entry. It should accept three arguments, the :data part, +the old and new values for the entry.") + (defvar org-mobile-last-flagged-files nil "List of files containing entries flagged in the latest pull.") @@ -313,40 +308,29 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." This will create the index file, copy all agenda files there, and also create all custom agenda views, for upload to the mobile phone." (interactive) - (let ((a-buffer (get-buffer org-agenda-buffer-name))) - (let ((org-agenda-curbuf-name org-agenda-buffer-name) - (org-agenda-buffer-name "*SUMO*") - (org-agenda-tag-filter org-agenda-tag-filter) - (org-agenda-redo-command org-agenda-redo-command)) - (save-excursion - (save-restriction - (save-window-excursion - (run-hooks 'org-mobile-pre-push-hook) - (org-mobile-check-setup) - (org-mobile-prepare-file-lists) - (message "Creating agendas...") - (let ((inhibit-redisplay t) - (org-agenda-files (mapcar 'car org-mobile-files-alist))) - (org-mobile-create-sumo-agenda)) - (message "Creating agendas...done") - (org-save-all-org-buffers) ; to save any IDs created by this process - (message "Copying files...") - (org-mobile-copy-agenda-files) - (message "Writing index file...") - (org-mobile-create-index-file) - (message "Writing checksums...") - (org-mobile-write-checksums) - (run-hooks 'org-mobile-post-push-hook)))) - (setq org-agenda-buffer-name org-agenda-curbuf-name - org-agenda-this-buffer-name org-agenda-curbuf-name)) - (redraw-display) - (when (buffer-live-p a-buffer) - (if (not (get-buffer-window a-buffer)) - (kill-buffer a-buffer) - (let ((cw (selected-window))) - (select-window (get-buffer-window a-buffer)) - (org-agenda-redo) - (select-window cw))))) + (let ((org-agenda-buffer-name "*SUMO*") + (org-agenda-tag-filter org-agenda-tag-filter) + (org-agenda-redo-command org-agenda-redo-command)) + (save-excursion + (save-restriction + (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-check-setup) + (org-mobile-prepare-file-lists) + (message "Creating agendas...") + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) + (message "Creating agendas...done") + (org-save-all-org-buffers) ; to save any IDs created by this process + (message "Copying files...") + (org-mobile-copy-agenda-files) + (message "Writing index file...") + (org-mobile-create-index-file) + (message "Writing checksums...") + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook))))) + (org-agenda-maybe-redo) (message "Files for mobile viewer staged")) (defvar org-mobile-before-process-capture-hook nil @@ -422,10 +406,10 @@ agenda view showing the flagged items." (let ((files-alist (sort (copy-sequence org-mobile-files-alist) (lambda (a b) (string< (cdr a) (cdr b))))) (def-todo (default-value 'org-todo-keywords)) - (def-tags (default-value 'org-tag-alist)) + (def-tags org-tag-alist) (target-file (expand-file-name org-mobile-index-file org-mobile-directory)) - file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) + todo-kwds done-kwds tags) (when (stringp (car def-todo)) (setq def-todo (list (cons 'sequence def-todo)))) (org-agenda-prepare-buffers (mapcar 'car files-alist)) @@ -433,52 +417,36 @@ agenda view showing the flagged items." (setq todo-kwds (org-delete-all done-kwds (org-uniquify org-todo-keywords-for-agenda))) - (setq drawers (org-uniquify org-drawers-for-agenda)) (setq tags (mapcar 'car (org-global-tags-completion-table (mapcar 'car files-alist)))) - (with-temp-file - (if org-mobile-use-encryption - org-mobile-encryption-tempfile - target-file) - (while (setq entry (pop def-todo)) - (insert "#+READONLY\n") - (setq kwds (mapcar (lambda (x) (if (string-match "(" x) - (substring x 0 (match-beginning 0)) - x)) - (cdr entry))) - (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n") - (setq dwds (member "|" kwds) - twds (org-delete-all dwds kwds) - todo-kwds (org-delete-all twds todo-kwds) - done-kwds (org-delete-all dwds done-kwds))) + (with-temp-file (if org-mobile-use-encryption org-mobile-encryption-tempfile + target-file) + (insert "#+READONLY\n") + (dolist (entry def-todo) + (let ((kwds (mapcar (lambda (x) + (if (string-match "(" x) + (substring x 0 (match-beginning 0)) + x)) + (cdr entry)))) + (insert "#+TODO: " (mapconcat #'identity kwds " ") "\n") + (let* ((dwds (or (member "|" kwds) (last kwds))) + (twds (org-delete-all dwds kwds))) + (setq todo-kwds (org-delete-all twds todo-kwds)) + (setq done-kwds (org-delete-all dwds done-kwds))))) (when (or todo-kwds done-kwds) (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | " (mapconcat 'identity done-kwds " ") "\n")) - (setq def-tags (mapcar - (lambda (x) - (cond ((null x) nil) - ((stringp x) x) - ((eq (car x) :startgroup) "{") - ((eq (car x) :endgroup) "}") - ((eq (car x) :grouptags) nil) - ((eq (car x) :newline) nil) - ((listp x) (car x)))) - def-tags)) - (setq def-tags (delq nil def-tags)) + (setq def-tags (split-string (org-tag-alist-to-string def-tags t))) (setq tags (org-delete-all def-tags tags)) (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) (setq tags (append def-tags tags nil)) (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") - (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") (when (file-exists-p (expand-file-name org-mobile-directory "agendas.org")) (insert "* [[file:agendas.org][Agenda Views]]\n")) - (while (setq entry (pop files-alist)) - (setq file (car entry) - link-name (cdr entry)) - (insert (format "* [[file:%s][%s]]\n" - link-name link-name))) + (pcase-dolist (`(,_ . ,link-name) files-alist) + (insert (format "* [[file:%s][%s]]\n" link-name link-name))) (push (cons org-mobile-index-file (md5 (buffer-string))) org-mobile-checksum-files)) (when org-mobile-use-encryption @@ -501,7 +469,8 @@ agenda view showing the flagged items." (org-mobile-encrypt-and-move file target-path) (copy-file file target-path 'ok-if-exists)) (setq check (shell-command-to-string - (concat org-mobile-checksum-binary " " + (concat (shell-quote-argument org-mobile-checksum-binary) + " " (shell-quote-argument (expand-file-name file))))) (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) (push (cons link-name (match-string 0 check)) @@ -663,7 +632,7 @@ The table of checksums is written to the file mobile-checksums." m 10 " " 'planning) "\n") (when (setq id - (if (org-bound-and-true-p + (if (bound-and-true-p org-mobile-force-id-on-agenda-items) (org-id-get m 'create) (or (org-entry-get m "ID") @@ -679,7 +648,7 @@ The table of checksums is written to the file mobile-checksums." (org-with-point-at pom (concat "olp:" (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) - "/" + ":" (mapconcat 'org-mobile-escape-olp (org-get-outline-path) "/") @@ -823,14 +792,14 @@ If BEG and END are given, only do this in that region." (cnt-flag 0) (cnt-error 0) buf-list - id-pos org-mobile-error) + org-mobile-error) ;; Count the new captures (goto-char beg) (while (re-search-forward "^\\* \\(.*\\)" end t) (and (>= (- (match-end 1) (match-beginning 1)) 2) (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) - (incf cnt-new))) + (cl-incf cnt-new))) ;; Find and apply the edits (goto-char beg) @@ -842,19 +811,21 @@ If BEG and END are given, only do this in that region." (id-pos (condition-case msg (org-mobile-locate-entry (match-string 4)) (error (nth 1 msg)))) - (bos (point-at-bol)) + (bos (line-beginning-position)) (eos (save-excursion (org-end-of-subtree t t))) (cmd (if (equal action "") - '(progn - (incf cnt-flag) - (org-toggle-tag "FLAGGED" 'on) - (and note - (org-entry-put nil "THEFLAGGINGNOTE" note))) - (incf cnt-edit) + (let ((note (buffer-substring-no-properties + (line-beginning-position 2) eos))) + (lambda (_data _old _new) + (cl-incf cnt-flag) + (org-toggle-tag "FLAGGED" 'on) + (org-entry-put + nil "THEFLAGGINGNOTE" + (replace-regexp-in-string "\n" "\\\\n" note)))) + (cl-incf cnt-edit) (cdr (assoc action org-mobile-action-alist)))) - (note (and (equal action "") - (buffer-substring (1+ (point-at-eol)) eos))) - (org-inhibit-logging 'note) ;; Do not take notes interactively + ;; Do not take notes interactively. + (org-inhibit-logging 'note) old new) (goto-char bos) @@ -867,11 +838,11 @@ If BEG and END are given, only do this in that region." (if (stringp id-pos) (insert id-pos " ") (insert "BAD REFERENCE ")) - (incf cnt-error) + (cl-incf cnt-error) (throw 'next t)) (unless cmd (insert "BAD FLAG ") - (incf cnt-error) + (cl-incf cnt-error) (throw 'next t)) (move-marker bos-marker (point)) (if (re-search-forward "^** Old value[ \t]*$" eos t) @@ -884,34 +855,28 @@ If BEG and END are given, only do this in that region." (progn (outline-next-heading) (if (eobp) (org-back-over-empty-lines)) (point))))) - (setq old (and old (if (string-match "\\S-" old) old nil))) - (setq new (and new (if (string-match "\\S-" new) new nil))) - (if (and note (> (length note) 0)) - ;; Make Note into a single line, to fit into a property - (setq note (mapconcat 'identity - (org-split-string (org-trim note) "\n") - "\\n"))) + (setq old (org-string-nw-p old)) + (setq new (org-string-nw-p new)) (unless (equal data "body") - (setq new (and new (org-trim new)) - old (and old (org-trim old)))) + (setq new (and new (org-trim new))) + (setq old (and old (org-trim old)))) (goto-char (+ 2 bos-marker)) ;; Remember this place so that we can return (move-marker marker (point)) (setq org-mobile-error nil) - (save-excursion - (condition-case msg - (org-with-point-at id-pos - (progn - (eval cmd) - (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) - (if (member "FLAGGED" (org-get-tags)) - (add-to-list 'org-mobile-last-flagged-files - (buffer-file-name (current-buffer))))))) - (error (setq org-mobile-error msg)))) + (condition-case msg + (org-with-point-at id-pos + (funcall cmd data old new) + (unless (member data '("delete" "archive" "archive-sibling" + "addheading")) + (when (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name))))) + (error (setq org-mobile-error msg))) (when org-mobile-error - (org-pop-to-buffer-same-window (marker-buffer marker)) + (pop-to-buffer-same-window (marker-buffer marker)) (goto-char marker) - (incf cnt-error) + (cl-incf cnt-error) (insert (if (stringp (nth 1 org-mobile-error)) (nth 1 org-mobile-error) "EXECUTION FAILED") @@ -924,8 +889,8 @@ If BEG and END are given, only do this in that region." (save-buffer) (move-marker marker nil) (move-marker end nil) - (message "%d new, %d edits, %d flags, %d errors" cnt-new - cnt-edit cnt-flag cnt-error) + (message "%d new, %d edits, %d flags, %d errors" + cnt-new cnt-edit cnt-flag cnt-error) (sit-for 1))) (defun org-mobile-timestamp-buffer (buf) @@ -1020,7 +985,7 @@ be returned that indicates what went wrong." ((equal new "DONEARCHIVE") (org-todo 'done) (org-archive-subtree-default)) - ((equal new current) t) ; nothing needs to be done + ((equal new current) t) ; nothing needs to be done ((or (equal current old) (eq org-mobile-force-mobile-change t) (memq 'todo org-mobile-force-mobile-change)) @@ -1042,33 +1007,35 @@ be returned that indicates what went wrong." (or old "") (or current ""))))) ((eq what 'priority) - (when (looking-at org-complex-heading-regexp) - (setq current (and (match-end 3) (substring (match-string 3) 2 3))) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'tags org-mobile-force-mobile-change)) - (org-priority (and new (string-to-char new)))) - (t (error "Priority was expected to be %s, but is %s" - old current))))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let ((current (and (match-end 3) (substring (match-string 3) 2 3)))) + (cond + ((equal current new) t) ;no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'tags org-mobile-force-mobile-change)) + (org-priority (and new (string-to-char new)))) + (t (error "Priority was expected to be %s, but is %s" + old current))))))) ((eq what 'heading) - (when (looking-at org-complex-heading-regexp) - (setq current (match-string 4)) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'heading org-mobile-force-mobile-change)) - (goto-char (match-beginning 4)) - (insert new) - (delete-region (point) (+ (point) (length current))) - (org-set-tags nil 'align)) - (t (error "Heading changed in MobileOrg and on the computer"))))) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let ((current (match-string 4))) + (cond + ((equal current new) t) ;no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'heading org-mobile-force-mobile-change)) + (goto-char (match-beginning 4)) + (insert new) + (delete-region (point) (+ (point) (length current))) + (org-set-tags nil 'align)) + (t (error "Heading changed in MobileOrg and on the computer"))))))) ((eq what 'addheading) - (if (org-at-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn ;; Workaround a `org-insert-heading-respect-content' bug ;; which prevents correct insertion when point is invisible @@ -1083,7 +1050,7 @@ be returned that indicates what went wrong." ((eq what 'refile) (org-copy-subtree) (org-with-point-at (org-mobile-locate-entry new) - (if (org-at-heading-p) ; if false we are in top-level of file + (if (org-at-heading-p) ; if false we are in top-level of file (progn (setq level (org-get-valid-level (funcall outline-level) 1)) (org-end-of-subtree t t) diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 7eef5c6b8b..d6a472787e 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -1,4 +1,4 @@ -;;; org-mouse.el --- Better mouse support for org-mode +;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2017 Free Software Foundation, Inc. @@ -26,8 +26,8 @@ ;; ;; http://orgmode.org ;; -;; Org-mouse implements the following features: -;; * following links with the left mouse button (in Emacs 22) +;; Org mouse implements the following features: +;; * following links with the left mouse button ;; * subtree expansion/collapse (org-cycle) with the left mouse button ;; * several context menus on the right mouse button: ;; + general text @@ -66,12 +66,12 @@ ;; History: ;; -;; Since version 5.10: Changes are listed in the general org-mode docs. +;; Since version 5.10: Changes are listed in the general Org docs. ;; -;; Version 5.09;; + Version number synchronization with Org-mode. +;; Version 5.09;; + Version number synchronization with Org mode. ;; ;; Version 0.25 -;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) +;; + made compatible with Org 4.70 (thanks to Carsten for the patch) ;; ;; Version 0.24 ;; + minor changes to the table menu @@ -81,7 +81,7 @@ ;; + context menu support for org-agenda-undo & org-sort-entries ;; ;; Version 0.22 -;; + handles undo support for the agenda buffer (requires org-mode >=4.58) +;; + handles undo support for the agenda buffer (requires Org >=4.58) ;; ;; Version 0.21 ;; + selected text activates its context menu @@ -105,7 +105,7 @@ ;; + added support for checkboxes ;; ;; Version 0.15 -;; + org-mode now works with the Agenda buffer as well +;; + Org now works with the Agenda buffer as well ;; ;; Version 0.14 ;; + added a menu option that converts plain list items to outline items @@ -125,7 +125,7 @@ ;; ;; Version 0.10 ;; + added a menu option to remove highlights -;; + compatible with org-mode 4.21 now +;; + compatible with Org 4.21 now ;; ;; Version 0.08: ;; + trees can be moved/promoted/demoted by dragging with the right @@ -136,8 +136,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'org) +(require 'cl-lib) (defvar org-agenda-allow-remote-undo) (defvar org-agenda-undo-list) @@ -149,6 +149,8 @@ (declare-function org-agenda-earlier "org-agenda" (arg)) (declare-function org-agenda-later "org-agenda" (arg)) +(defvar org-mouse-main-buffer nil + "Active buffer for mouse operations.") (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") (defvar org-mouse-direct t @@ -191,15 +193,14 @@ Changing this variable requires a restart of Emacs to get activated." (interactive) (end-of-line) (skip-chars-backward "\t ") - (when (org-looking-back ":[A-Za-z]+:" (line-beginning-position)) + (when (looking-back ":[A-Za-z]+:" (line-beginning-position)) (skip-chars-backward ":A-Za-z") (skip-chars-backward "\t "))) -(defvar org-mouse-context-menu-function nil +(defvar-local org-mouse-context-menu-function nil "Function to create the context menu. The value of this variable is the function invoked by `org-mouse-context-menu' as the context menu.") -(make-variable-buffer-local 'org-mouse-context-menu-function) (defun org-mouse-show-context-menu (event prefix) "Invoke the context menu. @@ -215,13 +216,12 @@ this function is called. Otherwise, the current major mode menu is used." (when (not (org-mouse-mark-active)) (goto-char (posn-point (event-start event))) (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) - (let ((redisplay-dont-pause t)) - (sit-for 0))) + (sit-for 0)) (if (functionp org-mouse-context-menu-function) (funcall org-mouse-context-menu-function event) (if (fboundp 'mouse-menu-major-mode-map) (popup-menu (mouse-menu-major-mode-map) event prefix) - (org-no-warnings ; don't warn about fallback, obsolete since 23.1 + (with-no-warnings ; don't warn about fallback, obsolete since 23.1 (mouse-major-mode-menu event prefix))))) (setq this-command 'mouse-save-then-kill) (mouse-save-then-kill event))) @@ -258,7 +258,7 @@ If the point is at the :beginning (`org-mouse-line-position') of the line, insert the new heading before the current line. Otherwise, insert it after the current heading." (interactive) - (case (org-mouse-line-position) + (cl-case (org-mouse-line-position) (:beginning (beginning-of-line) (org-insert-heading)) (t (org-mouse-next-heading) @@ -314,10 +314,10 @@ nor a function, elements of KEYWORDS are used directly." (just-one-space)) (defvar org-mouse-rest) -(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase - literal string subexp) +(defun org-mouse-replace-match-and-surround + (_newtext &optional _fixedcase _literal _string subexp) "The same as `replace-match', but surrounds the replacement with spaces." - (apply 'replace-match org-mouse-rest) + (apply #'replace-match org-mouse-rest) (save-excursion (goto-char (match-beginning (or subexp 0))) (just-one-space) @@ -407,8 +407,8 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (> (match-end 0) point)))))) (defun org-mouse-priority-list () - (loop for priority from ?A to org-lowest-priority - collect (char-to-string priority))) + (cl-loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) (defun org-mouse-todo-menu (state) "Create the menu with TODO keywords." @@ -460,33 +460,33 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (insert " [ ] ")))) (defun org-mouse-agenda-type (type) - (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") - (t "Agenda command ???"))) + (pcase type + (`tags "Tags: ") + (`todo "TODO: ") + (`tags-tree "Tags tree: ") + (`todo-tree "TODO tree: ") + (`occur-tree "Occur tree: ") + (_ "Agenda command ???"))) (defun org-mouse-list-options-menu (alloptions &optional function) (let ((options (save-match-data (split-string (match-string-no-properties 1))))) (print options) - (loop for name in alloptions - collect - (vector name - `(progn - (replace-match - (mapconcat 'identity - (sort (if (member ',name ',options) - (delete ',name ',options) - (cons ',name ',options)) - 'string-lessp) - " ") - nil nil nil 1) - (when (functionp ',function) (funcall ',function))) - :style 'toggle - :selected (and (member name options) t))))) + (cl-loop for name in alloptions + collect + (vector name + `(progn + (replace-match + (mapconcat 'identity + (sort (if (member ',name ',options) + (delete ',name ',options) + (cons ',name ',options)) + 'string-lessp) + " ") + nil nil nil 1) + (when (functionp ',function) (funcall ',function))) + :style 'toggle + :selected (and (member name options) t))))) (defun org-mouse-clip-text (text maxlength) (if (> (length text) maxlength) @@ -498,7 +498,7 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" `("Main Menu" ["Show Overview" org-mouse-show-overview t] ["Show Headlines" org-mouse-show-headlines t] - ["Show All" show-all t] + ["Show All" outline-show-all t] ["Remove Highlights" org-remove-occur-highlights :visible org-occur-highlights] "--" @@ -556,12 +556,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (let ((contextdata (assq context contextlist))) (when contextdata (save-excursion - (goto-char (second contextdata)) - (re-search-forward ".*" (third contextdata)))))) + (goto-char (nth 1 contextdata)) + (re-search-forward ".*" (nth 2 contextdata)))))) (defun org-mouse-for-each-item (funct) - ;; Functions called by `org-apply-on-list' need an argument - (let ((wrap-fun (lambda (c) (funcall funct)))) + ;; Functions called by `org-apply-on-list' need an argument. + (let ((wrap-fun (lambda (_) (funcall funct)))) (when (ignore-errors (goto-char (org-in-item-p))) (save-excursion (org-apply-on-list wrap-fun nil))))) @@ -572,14 +572,14 @@ This means, between the beginning of line and the point." (skip-chars-backward " \t*") (bolp))) (defun org-mouse-insert-item (text) - (case (org-mouse-line-position) - (:beginning ; insert before + (cl-case (org-mouse-line-position) + (:beginning ; insert before (beginning-of-line) (looking-at "[ \t]*") (open-line 1) - (org-indent-to-column (- (match-end 0) (match-beginning 0))) + (indent-to-column (- (match-end 0) (match-beginning 0))) (insert "+ ")) - (:middle ; insert after + (:middle ; insert after (end-of-line) (newline t) (indent-relative) @@ -587,7 +587,7 @@ This means, between the beginning of line and the point." (:end ; insert text here (skip-chars-backward " \t") (kill-region (point) (point-at-eol)) - (unless (org-looking-back org-mouse-punctuation) + (unless (looking-back org-mouse-punctuation (line-beginning-position)) (insert (concat org-mouse-punctuation " "))))) (insert text) (beginning-of-line)) @@ -638,14 +638,15 @@ This means, between the beginning of line and the point." (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) (save-excursion (goto-char (region-end)) (insert "]]")))] ["Insert Link Here" (org-mouse-yank-link ',event)])))) - ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) + ((save-excursion (beginning-of-line) (looking-at "[ \t]*#\\+STARTUP: \\(.*\\)")) (popup-menu `(nil ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) 'org-mode-restart)))) ((or (eolp) (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t" (- (point) 2)))) + (looking-back " \\|\t" (- (point) 2) + (line-beginning-position)))) (org-mouse-popup-global-menu)) ((funcall get-context :checkbox) (popup-menu @@ -737,13 +738,13 @@ This means, between the beginning of line and the point." ["- 1 Month" (org-timestamp-change -1 'month)]))) ((funcall get-context :table-special) (let ((mdata (match-data))) - (incf (car mdata) 2) + (cl-incf (car mdata) 2) (store-match-data mdata)) (message "match: %S" (match-string 0)) (popup-menu `(nil ,@(org-mouse-keyword-replace-menu '(" " "!" "^" "_" "$" "#" "*" "'") 0 (lambda (mark) - (case (string-to-char mark) + (cl-case (string-to-char mark) (? "( ) Nothing Special") (?! "(!) Column Names") (?^ "(^) Field Names Above") @@ -914,7 +915,7 @@ This means, between the beginning of line and the point." ((org-footnote-at-reference-p) nil) (t ad-do-it)))))) -(defun org-mouse-move-tree-start (event) +(defun org-mouse-move-tree-start (_event) (interactive "e") (message "Same line: promote/demote, (***):move before, (text): make a child")) @@ -993,7 +994,7 @@ This means, between the beginning of line and the point." (defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. (defun org-mouse-do-remotely (command) - ; (org-agenda-check-no-diary) + ;; (org-agenda-check-no-diary) (when (get-text-property (point) 'org-marker) (let* ((anticol (- (point-at-eol) (point))) (marker (get-text-property (point) 'org-marker)) @@ -1031,7 +1032,7 @@ This means, between the beginning of line and the point." (org-agenda-change-all-lines newhead hdmarker 'fixface)))) t)))) -(defun org-mouse-agenda-context-menu (&optional event) +(defun org-mouse-agenda-context-menu (&optional _event) (or (org-mouse-do-remotely 'org-mouse-context-menu) (popup-menu '("Agenda" @@ -1093,17 +1094,17 @@ This means, between the beginning of line and the point." ; (setq org-agenda-mode-hook nil) (defvar org-agenda-mode-map) (add-hook 'org-agenda-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) - (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) - (org-defkey org-agenda-mode-map [drag-mouse-3] - #'(lambda (event) (interactive "e") - (case (org-mouse-get-gesture event) - (:left (org-agenda-earlier 1)) - (:right (org-agenda-later 1))))))) + (lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] + (lambda (event) (interactive "e") + (cl-case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) (provide 'org-mouse) diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index 034c20e307..61ec5fad4c 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -1,4 +1,4 @@ -;;; org-pcomplete.el --- In-buffer completion code +;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; @@ -27,21 +27,17 @@ ;;;; Require other packages -(eval-when-compile - (require 'cl)) - (require 'org-macs) (require 'org-compat) (require 'pcomplete) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-make-org-heading-search-string "org" - (&optional string)) +(declare-function org-make-org-heading-search-string "org" (&optional string)) (declare-function org-get-buffer-tags "org" ()) (declare-function org-get-tags "org" ()) (declare-function org-buffer-property-keys "org" - (&optional include-specials include-defaults include-columns)) -(declare-function org-entry-properties "org" (&optional pom which specific)) + (&optional specials defaults columns ignore-malformed)) +(declare-function org-entry-properties "org" (&optional pom which)) +(declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) ;;;; Customization variables @@ -52,12 +48,13 @@ (defvar org-drawer-regexp) (defvar org-property-re) +(defvar org-current-tag-alist) (defun org-thing-at-point () "Examine the thing at point and let the caller know what it is. The return value is a string naming the thing at point." (let ((beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]-_@")) + (skip-chars-backward "[:alnum:]-_@") (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9-_:$") @@ -93,8 +90,10 @@ The return value is a string naming the thing at point." (skip-chars-backward "[ \t\n]") ;; org-drawer-regexp matches a whole line but while ;; looking-back, we just ignore trailing whitespaces - (or (org-looking-back (substring org-drawer-regexp 0 -1)) - (org-looking-back org-property-re)))) + (or (looking-back (substring org-drawer-regexp 0 -1) + (line-beginning-position)) + (looking-back org-property-re + (line-beginning-position))))) (cons "prop" nil)) ((and (equal (char-before beg1) ?:) (not (equal (char-after (point-at-bol)) ?*))) @@ -140,7 +139,6 @@ When completing for #+STARTUP, for example, this function returns pcomplete-default-completion-function)))) (defvar org-options-keywords) ; From org.el -(defvar org-element-block-name-alist) ; From org-element.el (defvar org-element-affiliated-keywords) ; From org-element.el (declare-function org-get-export-keywords "org" ()) (defun pcomplete/org-mode/file-option () @@ -153,16 +151,19 @@ When completing for #+STARTUP, for example, this function returns (mapcar (lambda (keyword) (concat keyword ": ")) org-element-affiliated-keywords) (let (block-names) - (dolist (block-info org-element-block-name-alist block-names) - (let ((name (car block-info))) - (push (format "END_%s" name) block-names) - (push (concat "BEGIN_" - name - ;; Since language is compulsory in - ;; source blocks, add a space. - (and (equal name "SRC") " ")) - block-names) - (push (format "ATTR_%s: " name) block-names)))) + (dolist (name + '("CENTER" "COMMENT" "EXAMPLE" "EXPORT" "QUOTE" "SRC" + "VERSE") + block-names) + (push (format "END_%s" name) block-names) + (push (concat "BEGIN_" + name + ;; Since language is compulsory in + ;; export blocks source blocks, add + ;; a space. + (and (member name '("EXPORT" "SRC")) " ")) + block-names) + (push (format "ATTR_%s: " name) block-names))) (mapcar (lambda (keyword) (concat keyword ": ")) (org-get-export-keywords)))) (substring pcomplete-stub 2))) @@ -233,20 +234,10 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) -(defvar org-tag-alist) (defun pcomplete/org-mode/file-option/tags () "Complete arguments for the #+TAGS file option." (pcomplete-here - (list - (mapconcat (lambda (x) - (cond - ((eq :startgroup (car x)) "{") - ((eq :endgroup (car x)) "}") - ((eq :grouptags (car x)) ":") - ((eq :newline (car x)) "\\n") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - org-tag-alist " ")))) + (list (org-tag-alist-to-string org-current-tag-alist)))) (defun pcomplete/org-mode/file-option/title () "Complete arguments for the #+TITLE file option." @@ -271,8 +262,8 @@ When completing for #+STARTUP, for example, this function returns "|:" "tags:" "tasks:" "<:" "todo:") ;; OPTION items from registered back-ends. (let (items) - (dolist (backend (org-bound-and-true-p - org-export--registered-backends)) + (dolist (backend (bound-and-true-p + org-export-registered-backends)) (dolist (option (org-export-backend-options backend)) (let ((item (nth 2 option))) (when item (push (concat item ":") items))))) @@ -283,7 +274,7 @@ When completing for #+STARTUP, for example, this function returns (while (pcomplete-here (pcomplete-uniqify-list (mapcar (lambda (item) (format "%s:" (car item))) - (org-bound-and-true-p org-html-infojs-opts-table)))))) + (bound-and-true-p org-html-infojs-opts-table)))))) (defun pcomplete/org-mode/file-option/bind () "Complete arguments for the #+BIND file option, which are variable names." @@ -324,26 +315,24 @@ This needs more work, to handle headings with lots of spaces in them." (save-excursion (goto-char (point-min)) (let (tbl) - (while (re-search-forward org-todo-line-regexp nil t) - (push (org-make-org-heading-search-string - (match-string-no-properties 3)) - tbl)) + (let ((case-fold-search nil)) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3)) + tbl))) (pcomplete-uniqify-list tbl))) (substring pcomplete-stub 1)))) -(defvar org-tag-alist) (defun pcomplete/org-mode/tag () "Complete a tag name. Omit tags already set." (while (pcomplete-here - (mapcar (lambda (x) - (concat x ":")) + (mapcar (lambda (x) (concat x ":")) (let ((lst (pcomplete-uniqify-list - (or (remove + (or (remq nil - (mapcar (lambda (x) - (and (stringp (car x)) (car x))) - org-tag-alist)) - (mapcar 'car (org-get-buffer-tags)))))) + (mapcar (lambda (x) (org-string-nw-p (car x))) + org-current-tag-alist)) + (mapcar #'car (org-get-buffer-tags)))))) (dolist (tag (org-get-tags)) (setq lst (delete tag lst))) lst)) @@ -357,31 +346,12 @@ This needs more work, to handle headings with lots of spaces in them." (concat x ": ")) (let ((lst (pcomplete-uniqify-list (copy-sequence - (org-buffer-property-keys nil t t))))) + (org-buffer-property-keys nil t t t))))) (dolist (prop (org-entry-properties)) (setq lst (delete (car prop) lst))) lst)) (substring pcomplete-stub 1))) -(defvar org-drawers) - -(defun pcomplete/org-mode/drawer () - "Complete a drawer name." - (let ((spc (save-excursion - (move-beginning-of-line 1) - (looking-at "^\\([ \t]*\\):") - (match-string 1))) - (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) - (pcomplete-here cpllist - (substring pcomplete-stub 1) - (unless (or (not (delq - nil - (mapcar (lambda(x) - (string-match (substring pcomplete-stub 1) x)) - cpllist))) - (looking-at "[ \t]*\n.*:END:")) - (save-excursion (insert "\n" spc ":END:")))))) - (defun pcomplete/org-mode/block-option/src () "Complete the arguments of a begin_src block. Complete a language in the first field, the header arguments and switches." diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index 5ccfbb1e66..449143a47a 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -1,4 +1,4 @@ -;;; org-plot.el --- Support for plotting from Org-mode +;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; @@ -25,14 +25,14 @@ ;; Borrows ideas and a couple of lines of code from org-exp.el. -;; Thanks to the org-mode mailing list for testing and implementation -;; and feature suggestions +;; Thanks to the Org mailing list for testing and implementation and +;; feature suggestions ;;; Code: + +(require 'cl-lib) (require 'org) (require 'org-table) -(eval-when-compile - (require 'cl)) (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg)) (declare-function gnuplot-mode "ext:gnuplot" ()) @@ -49,41 +49,39 @@ (defun org-plot/add-options-to-plist (p options) "Parse an OPTIONS line and set values in the property list P. Returns the resulting property list." - (let (o) - (when options - (let ((op '(("type" . :plot-type) - ("script" . :script) - ("line" . :line) - ("set" . :set) - ("title" . :title) - ("ind" . :ind) - ("deps" . :deps) - ("with" . :with) - ("file" . :file) - ("labels" . :labels) - ("map" . :map) - ("timeind" . :timeind) - ("timefmt" . :timefmt))) - (multiples '("set" "line")) - (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") - (start 0) - o) - (while (setq o (pop op)) - (if (member (car o) multiples) ;; keys with multiple values - (while (string-match - (concat (regexp-quote (car o)) regexp) - options start) - (setq start (match-end 0)) - (setq p (plist-put p (cdr o) - (cons (car (read-from-string - (match-string 1 options))) - (plist-get p (cdr o))))) - p) - (if (string-match (concat (regexp-quote (car o)) regexp) - options) - (setq p (plist-put p (cdr o) - (car (read-from-string - (match-string 1 options))))))))))) + (when options + (let ((op '(("type" . :plot-type) + ("script" . :script) + ("line" . :line) + ("set" . :set) + ("title" . :title) + ("ind" . :ind) + ("deps" . :deps) + ("with" . :with) + ("file" . :file) + ("labels" . :labels) + ("map" . :map) + ("timeind" . :timeind) + ("timefmt" . :timefmt))) + (multiples '("set" "line")) + (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") + (start 0)) + (dolist (o op) + (if (member (car o) multiples) ;; keys with multiple values + (while (string-match + (concat (regexp-quote (car o)) regexp) + options start) + (setq start (match-end 0)) + (setq p (plist-put p (cdr o) + (cons (car (read-from-string + (match-string 1 options))) + (plist-get p (cdr o))))) + p) + (if (string-match (concat (regexp-quote (car o)) regexp) + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options)))))))))) p) (defun org-plot/goto-nearest-table () @@ -119,10 +117,9 @@ will be added. Returns the resulting property list." Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." (with-temp-file data-file - (make-local-variable 'org-plot-timestamp-fmt) - (setq org-plot-timestamp-fmt (or - (plist-get params :timefmt) - "%Y-%m-%d-%H:%M:%S")) + (setq-local org-plot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) (insert (orgtbl-to-generic table (org-combine-plists @@ -140,7 +137,7 @@ and dependant variables." (deps (if (plist-member params :deps) (mapcar (lambda (val) (- val 1)) (plist-get params :deps)) (let (collector) - (dotimes (col (length (first table))) + (dotimes (col (length (nth 0 table))) (setf collector (cons col collector))) collector))) (counter 0) @@ -158,7 +155,7 @@ and dependant variables." table))) ;; write table to gnuplot grid datafile format (with-temp-file data-file - (let ((num-rows (length table)) (num-cols (length (first table))) + (let ((num-rows (length table)) (num-cols (length (nth 0 table))) (gnuplot-row (lambda (col row value) (setf col (+ 1 col)) (setf row (+ 1 row)) (format "%f %f %f\n%f %f %f\n" @@ -187,9 +184,7 @@ NUM-COLS controls the number of columns plotted in a 2-d plot. Optional argument PREFACE returns only option parameters in a manner suitable for prepending to a user-specified script." (let* ((type (plist-get params :plot-type)) - (with (if (equal type 'grid) - 'pm3d - (plist-get params :with))) + (with (if (eq type 'grid) 'pm3d (plist-get params :with))) (sets (plist-get params :set)) (lines (plist-get params :line)) (map (plist-get params :map)) @@ -204,68 +199,72 @@ manner suitable for prepending to a user-specified script." (x-labels (plist-get params :xlabels)) (y-labels (plist-get params :ylabels)) (plot-str "'%s' using %s%d%s with %s title '%s'") - (plot-cmd (case type - ('2d "plot") - ('3d "splot") - ('grid "splot"))) + (plot-cmd (pcase type + (`2d "plot") + (`3d "splot") + (`grid "splot"))) (script "reset") - ; ats = add-to-script - (ats (lambda (line) (setf script (format "%s\n%s" script line)))) + ;; ats = add-to-script + (ats (lambda (line) (setf script (concat script "\n" line)))) plot-lines) - (when file ;; output file + (when file ; output file (funcall ats (format "set term %s" (file-name-extension file))) (funcall ats (format "set output '%s'" file))) - (case type ;; type - ('2d ()) - ('3d (if map (funcall ats "set map"))) - ('grid (if map (funcall ats "set pm3d map") - (funcall ats "set pm3d")))) - (when title (funcall ats (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line - (when sets ;; set - (mapc (lambda (el) (funcall ats (format "set %s" el))) sets)) - (when x-labels ;; x labels (xtics) + (pcase type ; type + (`2d ()) + (`3d (when map (funcall ats "set map"))) + (`grid (funcall ats (if map "set pm3d map" "set pm3d")))) + (when title (funcall ats (format "set title '%s'" title))) ; title + (mapc ats lines) ; line + (dolist (el sets) (funcall ats (format "set %s" el))) ; set + ;; Unless specified otherwise, values are TAB separated. + (unless (string-match-p "^set datafile separator" script) + (funcall ats "set datafile separator \"\\t\"")) + (when x-labels ; x labels (xtics) (funcall ats (format "set xtics (%s)" (mapconcat (lambda (pair) (format "\"%s\" %d" (cdr pair) (car pair))) x-labels ", ")))) - (when y-labels ;; y labels (ytics) + (when y-labels ; y labels (ytics) (funcall ats (format "set ytics (%s)" (mapconcat (lambda (pair) (format "\"%s\" %d" (cdr pair) (car pair))) y-labels ", ")))) - (when time-ind ;; timestamp index + (when time-ind ; timestamp index (funcall ats "set xdata time") (funcall ats (concat "set timefmt \"" - (or timefmt ;; timefmt passed to gnuplot + (or timefmt ; timefmt passed to gnuplot "%Y-%m-%d-%H:%M:%S") "\""))) (unless preface - (case type ;; plot command - ('2d (dotimes (col num-cols) - (unless (and (equal type '2d) - (or (and ind (equal (+ 1 col) ind)) - (and deps (not (member (+ 1 col) deps))))) + (pcase type ; plot command + (`2d (dotimes (col num-cols) + (unless (and (eq type '2d) + (or (and ind (equal (1+ col) ind)) + (and deps (not (member (1+ col) deps))))) (setf plot-lines (cons (format plot-str data-file (or (and ind (> ind 0) - (not text-ind) - (format "%d:" ind)) "") - (+ 1 col) + (not text-ind) + (format "%d:" ind)) "") + (1+ col) (if text-ind (format ":xticlabel(%d)" ind) "") with - (or (nth col col-labels) (format "%d" (+ 1 col)))) + (or (nth col col-labels) + (format "%d" (1+ col)))) plot-lines))))) - ('3d + (`3d (setq plot-lines (list (format "'%s' matrix with %s title ''" data-file with)))) - ('grid + (`grid (setq plot-lines (list (format "'%s' with %s title ''" data-file with))))) (funcall ats - (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) + (concat plot-cmd " " (mapconcat #'identity + (reverse plot-lines) + ",\\\n ")))) script)) ;;----------------------------------------------------------------------------- @@ -279,59 +278,59 @@ line directly before or after the table." (require 'gnuplot) (save-window-excursion (delete-other-windows) - (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running + (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running (with-current-buffer "*gnuplot*" - (goto-char (point-max)) - (gnuplot-delchar-or-maybe-eof nil))) + (goto-char (point-max)))) (org-plot/goto-nearest-table) - ;; set default options - (mapc - (lambda (pair) - (unless (plist-member params (car pair)) - (setf params (plist-put params (car pair) (cdr pair))))) - org-plot/gnuplot-default-options) + ;; Set default options. + (dolist (pair org-plot/gnuplot-default-options) + (unless (plist-member params (car pair)) + (setf params (plist-put params (car pair) (cdr pair))))) ;; collect table and table information (let* ((data-file (make-temp-file "org-plot")) (table (org-table-to-lisp)) - (num-cols (length (if (eq (first table) 'hline) (second table) - (first table))))) - (while (equal 'hline (first table)) (setf table (cdr table))) - (when (equal (second table) 'hline) - (setf params (plist-put params :labels (first table))) ;; headers to labels - (setf table (delq 'hline (cdr table)))) ;; clean non-data from table - ;; collect options + (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table) + (nth 0 table))))) + (run-with-idle-timer 0.1 nil #'delete-file data-file) + (while (eq 'hline (car table)) (setf table (cdr table))) + (when (eq (cadr table) 'hline) + (setf params + (plist-put params :labels (nth 0 table))) ; headers to labels + (setf table (delq 'hline (cdr table)))) ; clean non-data from table + ;; Collect options. (save-excursion (while (and (equal 0 (forward-line -1)) (looking-at "[[:space:]]*#\\+")) (setf params (org-plot/collect-options params)))) - ;; dump table to datafile (very different for grid) - (case (plist-get params :plot-type) - ('2d (org-plot/gnuplot-to-data table data-file params)) - ('3d (org-plot/gnuplot-to-data table data-file params)) - ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data + ;; Dump table to datafile (very different for grid). + (pcase (plist-get params :plot-type) + (`2d (org-plot/gnuplot-to-data table data-file params)) + (`3d (org-plot/gnuplot-to-data table data-file params)) + (`grid (let ((y-labels (org-plot/gnuplot-to-grid-data table data-file params))) (when y-labels (plist-put params :ylabels y-labels))))) - ;; check for timestamp ind column - (let ((ind (- (plist-get params :ind) 1))) - (when (and (>= ind 0) (equal '2d (plist-get params :plot-type))) + ;; Check for timestamp ind column. + (let ((ind (1- (plist-get params :ind)))) + (when (and (>= ind 0) (eq '2d (plist-get params :plot-type))) (if (= (length (delq 0 (mapcar (lambda (el) - (if (string-match org-ts-regexp3 el) - 0 1)) - (mapcar (lambda (row) (nth ind row)) table)))) 0) + (if (string-match org-ts-regexp3 el) 0 1)) + (mapcar (lambda (row) (nth ind row)) table)))) + 0) (plist-put params :timeind t) - ;; check for text ind column + ;; Check for text ind column. (if (or (string= (plist-get params :with) "hist") (> (length (delq 0 (mapcar (lambda (el) (if (string-match org-table-number-regexp el) 0 1)) - (mapcar (lambda (row) (nth ind row)) table)))) 0)) + (mapcar (lambda (row) (nth ind row)) table)))) + 0)) (plist-put params :textind t))))) - ;; write script + ;; Write script. (with-temp-buffer - (if (plist-get params :script) ;; user script + (if (plist-get params :script) ; user script (progn (insert (org-plot/gnuplot-script data-file num-cols params t)) (insert "\n") @@ -339,14 +338,12 @@ line directly before or after the table." (goto-char (point-min)) (while (re-search-forward "$datafile" nil t) (replace-match data-file nil nil))) - (insert - (org-plot/gnuplot-script data-file num-cols params))) - ;; graph table + (insert (org-plot/gnuplot-script data-file num-cols params))) + ;; Graph table. (gnuplot-mode) (gnuplot-send-buffer-to-gnuplot)) - ;; cleanup - (bury-buffer (get-buffer "*gnuplot*")) - (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file)))))) + ;; Cleanup. + (bury-buffer (get-buffer "*gnuplot*"))))) (provide 'org-plot) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 4bd83bea48..8254356745 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -1,4 +1,4 @@ -;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. +;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; @@ -49,7 +49,7 @@ ;; 4.) Try this from the command line (adjust the URL as needed): ;; ;; $ emacsclient \ -;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title +;; org-protocol://store-link?url=http:%2F%2Flocalhost%2Findex.html&title=The%20title ;; ;; 5.) Optionally add custom sub-protocols and handlers: ;; @@ -60,7 +60,7 @@ ;; ;; A "sub-protocol" will be found in URLs like this: ;; -;; org-protocol://sub-protocol://data +;; org-protocol://sub-protocol?key=val&key2=val2 ;; ;; If it works, you can now setup other applications for using this feature. ;; @@ -81,12 +81,12 @@ ;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps ;; URLs to local filenames defined in `org-protocol-project-alist'. ;; -;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and +;; * `org-protocol-store-link' stores an Org link (if Org is present) and ;; pushes the browsers URL to the `kill-ring' for yanking. This handler is ;; triggered through the sub-protocol \"store-link\". ;; ;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If -;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; Org is loaded, Emacs will pop-up a capture buffer and fill the ;; template with the data provided. I.e. the browser's URL is inserted as an ;; Org-link of which the page title will be the description part. If text ;; was select in the browser, that text will be the body of the entry. @@ -94,20 +94,20 @@ ;; You may use the same bookmark URL for all those standard handlers and just ;; adjust the sub-protocol used: ;; -;; location.href='org-protocol://sub-protocol://'+ -;; encodeURIComponent(location.href)+'/'+ -;; encodeURIComponent(document.title)+'/'+ +;; location.href='org-protocol://sub-protocol?url='+ +;; encodeURIComponent(location.href)+'&title='+ +;; encodeURIComponent(document.title)+'&body='+ ;; encodeURIComponent(window.getSelection()) ;; ;; The handler for the sub-protocol \"capture\" detects an optional template ;; char that, if present, triggers the use of a special template. ;; Example: ;; -;; location.href='org-protocol://sub-protocol://x/'+ ... +;; location.href='org-protocol://capture?template=x'+ ... ;; -;; use template ?x. +;; uses template ?x. ;; -;; Note, that using double slashes is optional from org-protocol.el's point of +;; Note that using double slashes is optional from org-protocol.el's point of ;; view because emacsclient squashes the slashes to one. ;; ;; @@ -116,25 +116,12 @@ ;;; Code: (require 'org) -(eval-when-compile - (require 'cl)) (declare-function org-publish-get-project-from-filename "ox-publish" (filename &optional up)) (declare-function server-edit "server" (&optional arg)) -(define-obsolete-function-alias - 'org-protocol-unhex-compound 'org-link-unescape-compound - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-string 'org-link-unescape - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-single-byte-sequence - 'org-link-unescape-single-byte-sequence - "2011-02-17") +(defvar org-capture-link-is-already-stored) (defgroup org-protocol nil "Intercept calls from emacsclient to trigger custom actions. @@ -225,27 +212,36 @@ Each element of this list must be of the form: (module-name :protocol protocol :function func :kill-client nil) -protocol - protocol to detect in a filename without trailing colon and slashes. - See rfc1738 section 2.1 for more on this. - If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' - will search filenames for \"org-protocol:/my-protocol:/\" - and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and triple slashes are compressed - to one by emacsclient. - -function - function that handles requests with protocol and takes exactly one - argument: the filename with all protocols stripped. If the function - returns nil, emacsclient and -server do nothing. Any non-nil return - value is considered a valid filename and thus passed to the server. - - `org-protocol.el provides some support for handling those filenames, - if you stay with the conventions used for the standard handlers in - `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. +protocol - protocol to detect in a filename without trailing + colon and slashes. See rfc1738 section 2.1 for more + on this. If you define a protocol \"my-protocol\", + `org-protocol-check-filename-for-protocol' will search + filenames for \"org-protocol:/my-protocol\" and + trigger your action for every match. `org-protocol' + is defined in `org-protocol-the-protocol'. Double and + triple slashes are compressed to one by emacsclient. + +function - function that handles requests with protocol and takes + one argument. If a new-style link (key=val&key2=val2) + is given, the argument will be a property list with + the values from the link. If an old-style link is + given (val1/val2), the argument will be the filename + with all protocols stripped. + + If the function returns nil, emacsclient and -server + do nothing. Any non-nil return value is considered a + valid filename and thus passed to the server. + + `org-protocol.el' provides some support for handling + old-style filenames, if you follow the conventions + used for the standard handlers in + `org-protocol-protocol-alist-default'. See + `org-protocol-parse-parameters'. kill-client - If t, kill the client immediately, once the sub-protocol is detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangling emacsclients. Note, that all other command - line arguments but the this one will be discarded, greedy handlers + `C-g' to avoid dangling emacsclients. Note that all other command + line arguments but the this one will be discarded. Greedy handlers still receive the whole list of arguments though. Here is an example: @@ -269,7 +265,7 @@ string with two characters." (defcustom org-protocol-data-separator "/+\\|\\?" "The default data separator to use. - This should be a single regexp string." +This should be a single regexp string." :group 'org-protocol :version "24.4" :package-version '(Org . "8.0") @@ -278,21 +274,20 @@ string with two characters." ;;; Helper functions: (defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and triple slashes. -Slashes are sanitized to double slashes here." + "Sanitize slashes to double-slashes in URI. +Emacsclient compresses double and triple slashes." (when (string-match "^\\([a-z]+\\):/" uri) (let* ((splitparts (split-string uri "/+"))) (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) uri) (defun org-protocol-split-data (data &optional unhexify separator) - "Split what an org-protocol handler function gets as only argument. -DATA is that one argument. DATA is split at each occurrence of -SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is -nil, assume \"/+\". The results of that splitting are returned -as a list. If UNHEXIFY is non-nil, hex-decode each split part. -If UNHEXIFY is a function, use that function to decode each split -part." + "Split the DATA argument for an org-protocol handler function. +If UNHEXIFY is non-nil, hex-decode each split part. If UNHEXIFY +is a function, use that function to decode each split part. The +string is split at each occurrence of SEPARATOR (regexp). If no +SEPARATOR is specified or SEPARATOR is nil, assume \"/+\". The +results of that splitting are returned as a list." (let* ((sep (or separator "/+\\|\\?")) (split-parts (split-string data sep))) (if unhexify @@ -302,23 +297,25 @@ part." split-parts))) (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) - "Greedy handlers might receive a list like this from emacsclient: - ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) -where \"/dir/\" is the absolute path to emacsclients working directory. This + "Transform PARAM-LIST into a flat list for greedy handlers. + +Greedy handlers might receive a list like this from emacsclient: +\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) +where \"/dir/\" is the absolute path to emacsclient's working directory. This function transforms it into a flat list using `org-protocol-flatten' and transforms the elements of that list as follows: -If strip-path is non-nil, remove the \"/dir/\" prefix from all members of +If STRIP-PATH is non-nil, remove the \"/dir/\" prefix from all members of param-list. -If replacement is string, replace the \"/dir/\" prefix with it. +If REPLACEMENT is string, replace the \"/dir/\" prefix with it. The first parameter, the one that contains the protocols, is always changed. Everything up to the end of the protocols is stripped. Note, that this function will always behave as if `org-protocol-reverse-list-of-files' was set to t and the returned list will -reflect that. I.e. emacsclients first parameter will be the first one in the +reflect that. emacsclient's first parameter will be the first one in the returned list." (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files param-list @@ -345,50 +342,106 @@ returned list." ret) l))) -(defun org-protocol-flatten (l) - "Greedy handlers might receive a list like this from emacsclient: - ((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) +(defun org-protocol-flatten (list) + "Transform LIST into a flat list. + +Greedy handlers might receive a list like this from emacsclient: +\((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\")) where \"/dir/\" is the absolute path to emacsclients working directory. This function transforms it into a flat list." - (if (null l) () - (if (listp l) - (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) - (list l)))) - + (if (null list) () + (if (listp list) + (append (org-protocol-flatten (car list)) (org-protocol-flatten (cdr list))) + (list list)))) + +(defun org-protocol-parse-parameters (info &optional new-style default-order) + "Return a property list of parameters from INFO. +If NEW-STYLE is non-nil, treat INFO as a query string (ex: +url=URL&title=TITLE). If old-style links are used (ex: +org-protocol://store-link/url/title), assign them to attributes +following DEFAULT-ORDER. + +If no DEFAULT-ORDER is specified, return the list of values. + +If INFO is already a property list, return it unchanged." + (if (listp info) + info + (if new-style + (let ((data (org-protocol-convert-query-to-plist info)) + result) + (while data + (setq result + (append + result + (list + (pop data) + (org-link-unescape (pop data)))))) + result) + (let ((data (org-protocol-split-data info t org-protocol-data-separator))) + (if default-order + (org-protocol-assign-parameters data default-order) + data))))) + +(defun org-protocol-assign-parameters (data default-order) + "Return a property list of parameters from DATA. +Key names are taken from DEFAULT-ORDER, which should be a list of +symbols. If DEFAULT-ORDER is shorter than the number of values +specified, the rest of the values are treated as :key value pairs." + (let (result) + (while default-order + (setq result + (append result + (list (pop default-order) + (pop data))))) + (while data + (setq result + (append result + (list (intern (concat ":" (pop data))) + (pop data))))) + result)) ;;; Standard protocol handlers: (defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url. + "Process an org-protocol://store-link style url. Additionally store a browser URL as an org link. Also pushes the link's URL to the `kill-ring'. +Parameters: url, title (optional), body (optional) + +Old-style links such as org-protocol://store-link://URL/TITLE are +also recognized. + The location for a browser's bookmark has to look like this: - javascript:location.href=\\='org-protocol://store-link://\\='+ \\ - encodeURIComponent(location.href) - encodeURIComponent(document.title)+\\='/\\='+ \\ + javascript:location.href = \\ + \\='org-protocol://store-link?url=\\=' + \\ + encodeURIComponent(location.href) + \\='&title=\\=' + \\ + encodeURIComponent(document.title); -Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page -could contain slashes and the location definitely will. +Don't use `escape()'! Use `encodeURIComponent()' instead. The +title of the page could contain slashes and the location +definitely will. The sub-protocol used to reach this function is set in -`org-protocol-protocol-alist'." - (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) - (uri (org-protocol-sanitize-uri (car splitparts))) - (title (cadr splitparts)) - orglink) - (if (boundp 'org-stored-links) - (setq org-stored-links (cons (list uri title) org-stored-links))) +`org-protocol-protocol-alist'. + +FNAME should be a property list. If not, an old-style link of the +form URL/TITLE can also be used." + (let* ((splitparts (org-protocol-parse-parameters fname nil '(:url :title))) + (uri (org-protocol-sanitize-uri (plist-get splitparts :url))) + (title (plist-get splitparts :title))) + (when (boundp 'org-stored-links) + (push (list uri title) org-stored-links)) (kill-new uri) (message "`%s' to insert new org-link, `%s' to insert `%s'" - (substitute-command-keys"\\[org-insert-link]") - (substitute-command-keys"\\[yank]") + (substitute-command-keys "`\\[org-insert-link]'") + (substitute-command-keys "`\\[yank]'") uri)) nil) (defun org-protocol-capture (info) - "Process an org-protocol://capture:// style url. + "Process an org-protocol://capture style url with INFO. The sub-protocol used to reach this function is set in `org-protocol-protocol-alist'. @@ -396,16 +449,16 @@ The sub-protocol used to reach this function is set in This function detects an URL, title and optional text, separated by `/'. The location for a browser's bookmark looks like this: - javascript:location.href=\\='org-protocol://capture://\\='+ \\ - encodeURIComponent(location.href)+\\='/\\=' \\ - encodeURIComponent(document.title)+\\='/\\='+ \\ + javascript:location.href = \\='org-protocol://capture?url=\\='+ \\ + encodeURIComponent(location.href) + \\='&title=\\=' \\ + encodeURIComponent(document.title) + \\='&body=\\=' + \\ encodeURIComponent(window.getSelection()) By default, it uses the character `org-protocol-default-template-key', which should be associated with a template in `org-capture-templates'. -But you may prepend the encoded URL with a character and a slash like so: +You may specify the template with a template= query parameter, like this: - javascript:location.href=\\='org-protocol://capture://b/\\='+ ... + javascript:location.href = \\='org-protocol://capture?template=b\\='+ ... Now template ?b will be used." (if (and (boundp 'org-stored-links) @@ -414,7 +467,7 @@ Now template ?b will be used." nil) (defun org-protocol-convert-query-to-plist (query) - "Convert query string that is part of url to property list." + "Convert QUERY key=value pairs in the URL to a property list." (if query (apply 'append (mapcar (lambda (x) (let ((c (split-string x "="))) @@ -422,45 +475,52 @@ Now template ?b will be used." (split-string query "&"))))) (defun org-protocol-do-capture (info) - "Support `org-capture'." - (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) - (template (or (and (>= 2 (length (car parts))) (pop parts)) + "Perform the actual capture based on INFO." + (let* ((temp-parts (org-protocol-parse-parameters info)) + (parts + (cond + ((and (listp info) (symbolp (car info))) info) + ((= (length (car temp-parts)) 1) ;; First parameter is exactly one character long + (org-protocol-assign-parameters temp-parts '(:template :url :title :body))) + (t + (org-protocol-assign-parameters temp-parts '(:url :title :body))))) + (template (or (plist-get parts :template) org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (or (cadr parts) "")) - (region (or (caddr parts) "")) - (orglink (org-make-link-string - url (if (string-match "[^[:space:]]" title) title url))) - (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) + (url (and (plist-get parts :url) (org-protocol-sanitize-uri (plist-get parts :url)))) + (type (and url (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url)))) + (title (or (plist-get parts :title) "")) + (region (or (plist-get parts :body) "")) + (orglink (if url + (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url)) + title)) (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link (setq org-stored-links (cons (list url title) org-stored-links)) - (kill-new orglink) (org-store-link-props :type type :link url :description title :annotation orglink :initial region - :query query) + :query parts) (raise-frame) (funcall 'org-capture nil template))) (defun org-protocol-open-source (fname) - "Process an org-protocol://open-source:// style url. + "Process an org-protocol://open-source?url= style URL with FNAME. Change a filename by mapping URLs to local filenames as set in `org-protocol-project-alist'. The location for a browser's bookmark should look like this: - javascript:location.href=\\='org-protocol://open-source://\\='+ \\ + javascript:location.href = \\='org-protocol://open-source?url=\\=' + \\ encodeURIComponent(location.href)" ;; As we enter this function for a match on our protocol, the return value ;; defaults to nil. (let ((result nil) - (f (org-link-unescape fname))) + (f (plist-get (org-protocol-parse-parameters fname nil '(:url)) :url))) (catch 'result (dolist (prolist org-protocol-project-alist) (let* ((base-url (plist-get (cdr prolist) :base-url)) @@ -490,13 +550,12 @@ The location for a browser's bookmark should look like this: (let ((rewrites (plist-get (cdr prolist) :rewrites))) (when rewrites (message "Rewrites found: %S" rewrites) - (mapc - (lambda (rewrite) - "Try to match a rewritten URL and map it to a real file." - ;; Compare redirects without suffix: - (if (string-match (car rewrite) f2) - (throw 'result (concat wdir (cdr rewrite))))) - rewrites)))) + (dolist (rewrite rewrites) + ;; Try to match a rewritten URL and map it to + ;; a real file. Compare redirects without + ;; suffix. + (when (string-match-p (car rewrite) f2) + (throw 'result (concat wdir (cdr rewrite)))))))) ;; -- end of redirects -- (if (file-readable-p the-file) @@ -509,44 +568,63 @@ The location for a browser's bookmark should look like this: ;;; Core functions: -(defun org-protocol-check-filename-for-protocol (fname restoffiles client) - "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. +(defun org-protocol-check-filename-for-protocol (fname restoffiles _client) + "Check if `org-protocol-the-protocol' and a valid protocol are used in FNAME. Sub-protocols are registered in `org-protocol-protocol-alist' and -`org-protocol-protocol-alist-default'. -This is, how the matching is done: +`org-protocol-protocol-alist-default'. This is how the matching is done: - (string-match \"protocol:/+sub-protocol:/+\" ...) + (string-match \"protocol:/+sub-protocol\\\\(://\\\\|\\\\?\\\\)\" ...) protocol and sub-protocol are regexp-quoted. -If a matching protocol is found, the protocol is stripped from fname and the -result is passed to the protocols function as the only parameter. If the -function returns nil, the filename is removed from the list of filenames -passed from emacsclient to the server. -If the function returns a non nil value, that value is passed to the server -as filename." +Old-style links such as \"protocol://sub-protocol://param1/param2\" are +also recognized. + +If a matching protocol is found, the protocol is stripped from +fname and the result is passed to the protocol function as the +first parameter. The second parameter will be non-nil if FNAME +uses key=val&key2=val2-type arguments, or nil if FNAME uses +val/val2-type arguments. If the function returns nil, the +filename is removed from the list of filenames passed from +emacsclient to the server. If the function returns a non-nil +value, that value is passed to the server as filename. + +If the handler function is greedy, RESTOFFILES will also be passed to it. + +CLIENT is ignored." (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) (catch 'fname - (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) + (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) + ":/+"))) (when (string-match the-protocol fname) (dolist (prolist sub-protocols) - (let ((proto (concat the-protocol - (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (let ((proto + (concat the-protocol + (regexp-quote (plist-get (cdr prolist) :protocol)) + "\\(:/+\\|\\?\\)"))) (when (string-match proto fname) (let* ((func (plist-get (cdr prolist) :function)) (greedy (plist-get (cdr prolist) :greedy)) (split (split-string fname proto)) - (result (if greedy restoffiles (cadr split)))) + (result (if greedy restoffiles (cadr split))) + (new-style (string= (match-string 1 fname) "?"))) (when (plist-get (cdr prolist) :kill-client) (message "Greedy org-protocol handler. Killing client.") (server-edit)) (when (fboundp func) (unless greedy - (throw 'fname (funcall func result))) - (funcall func result) + (throw 'fname + (if new-style + (funcall func (org-protocol-parse-parameters + result new-style)) + (warn "Please update your Org Protocol handler \ +to deal with new-style links.") + (funcall func result)))) + ;; Greedy protocol handlers are responsible for + ;; parsing their own filenames. + (funcall func result) (throw 'fname t)))))))) - ;; (message "fname: %s" fname) fname))) (defadvice server-visit-files (before org-protocol-detect-protocol-server activate) @@ -572,16 +650,18 @@ as filename." ;;; Org specific functions: (defun org-protocol-create-for-org () - "Create a org-protocol project for the current file's Org-mode project. + "Create a Org protocol project for the current file's project. The visited file needs to be part of a publishing project in `org-publish-project-alist' for this to work. The function delegates most of the work to `org-protocol-create'." (interactive) - (require 'org-publish) + (require 'ox-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did mean %s?" - (substitute-command-keys"\\[org-protocol-create]"))))) + (message "%s" + (substitute-command-keys + "Not in an Org project. \ +Did you mean `\\[org-protocol-create]'?"))))) (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. @@ -600,19 +680,18 @@ the cdr of an element in `org-publish-project-alist', reuse (working-suffix (if (plist-get project-plist :base-extension) (concat "." (plist-get project-plist :base-extension)) ".org")) - (worglet-buffer nil) (insert-default-directory t) (minibuffer-allow-text-properties nil)) (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) - (if (not (string-match "\\/$" base-url)) - (setq base-url (concat base-url "/"))) + (or (string-suffix-p "/" base-url) + (setq base-url (concat base-url "/"))) (setq working-dir (expand-file-name (read-directory-name "Local working directory: " working-dir working-dir t))) - (if (not (string-match "\\/$" working-dir)) - (setq working-dir (concat working-dir "/"))) + (or (string-suffix-p "/" working-dir) + (setq working-dir (concat working-dir "/"))) (setq strip-suffix (read-string diff --git a/lisp/org/org-rmail.el b/lisp/org/org-rmail.el index 80bfce920c..31c59a13d8 100644 --- a/lisp/org/org-rmail.el +++ b/lisp/org/org-rmail.el @@ -1,4 +1,4 @@ -;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode +;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,9 +24,9 @@ ;; ;;; Commentary: -;; This file implements links to Rmail messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. +;; This file implements links to Rmail messages from within Org mode. +;; Org mode loads this module by default - if this is not what you +;; want, configure the variable `org-modules'. ;;; Code: @@ -36,13 +36,14 @@ (declare-function rmail-show-message "rmail" (&optional n no-summary)) (declare-function rmail-what-message "rmail" (&optional pos)) (declare-function rmail-toggle-header "rmail" (&optional arg)) +(declare-function rmail "rmail" (&optional file-name-arg)) (declare-function rmail-widen "rmail" ()) (defvar rmail-current-message) ; From rmail.el (defvar rmail-header-style) ; From rmail.el +(defvar rmail-file-name) ; From rmail.el ;; Install the link type -(org-add-link-type "rmail" 'org-rmail-open) -(add-hook 'org-store-link-functions 'org-rmail-store-link) +(org-link-set-parameters "rmail" :follow #'org-rmail-open :store #'org-rmail-store-link) ;; Implementation (defun org-rmail-store-link () @@ -63,20 +64,11 @@ (to (mail-fetch-field "to")) (subject (mail-fetch-field "subject")) (date (mail-fetch-field "date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) desc link) (org-store-link-props - :type "rmail" :from from :to to + :type "rmail" :from from :to to :date date :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) + (setq message-id (org-unbracket-string "<" ">" message-id)) (setq desc (org-email-link-description)) (setq link (concat "rmail:" folder "#" message-id)) (org-add-link-props :link link :description desc) diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 4eb8a531b8..0e04d4b5a8 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -1,4 +1,4 @@ -;;; org-src.el --- Source code examples in Org +;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- ;; ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; @@ -26,43 +26,33 @@ ;; ;;; Commentary: -;; This file contains the code dealing with source code examples in Org-mode. +;; This file contains the code dealing with source code examples in +;; Org mode. ;;; Code: +(require 'cl-lib) (require 'org-macs) (require 'org-compat) (require 'ob-keys) (require 'ob-comint) -(eval-when-compile - (require 'cl)) +(declare-function org-base-buffer "org" (buffer)) (declare-function org-do-remove-indentation "org" (&optional n)) -(declare-function org-at-table.el-p "org" ()) -(declare-function org-in-src-block-p "org" (&optional inside)) -(declare-function org-in-block-p "org" (names)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" + (blob &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-footnote-goto-definition "org-footnote" + (label &optional location)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-switch-to-buffer-other-window "org" (&rest args)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-base-buffer "org" (buffer)) +(declare-function org-trim "org" (s &optional keep-lead)) -(defcustom org-edit-src-region-extra nil - "Additional regexps to identify regions for editing with `org-edit-src-code'. -For examples see the function `org-edit-src-find-region-and-lang'. -The regular expression identifying the begin marker should end with a newline, -and the regexp marking the end line should start with a newline, to make sure -there are kept outside the narrowed region." - :group 'org-edit-structure - :type '(repeat - (list - (regexp :tag "begin regexp") - (regexp :tag "end regexp") - (choice :tag "language" - (string :tag "specify") - (integer :tag "from match group") - (const :tag "from `lang' element") - (const :tag "from `style' element"))))) +(defvar org-inhibit-startup) (defcustom org-edit-src-turn-on-auto-save nil "Non-nil means turn `auto-save-mode' on when editing a source block. @@ -117,28 +107,29 @@ These are the regions where each line starts with a colon." (defcustom org-src-preserve-indentation nil "If non-nil preserve leading whitespace characters on export. +\\ If non-nil leading whitespace characters in source code blocks are preserved on export, and when switching between the org -buffer and the language mode edit buffer. If this variable is nil -then, after editing with \\[org-edit-src-code], the -minimum (across-lines) number of leading whitespace characters -are removed from all lines, and the code block is uniformly -indented according to the value of `org-edit-src-content-indentation'." +buffer and the language mode edit buffer. + +When this variable is nil, after editing with `\\[org-edit-src-code]', +the minimum (across-lines) number of leading whitespace characters +are removed from all lines, and the code block is uniformly indented +according to the value of `org-edit-src-content-indentation'." :group 'org-edit-structure :type 'boolean) (defcustom org-edit-src-content-indentation 2 "Indentation for the content of a source code block. + This should be the number of spaces added to the indentation of the #+begin line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if -`org-src-preserve-indentation' is non-nil." +editing it with `\\[org-edit-src-code]'. + +It has no effect if `org-src-preserve-indentation' is non-nil." :group 'org-edit-structure :type 'integer) -(defvar org-src-strip-leading-and-trailing-blank-lines nil - "If non-nil, blank lines are removed when exiting the code edit buffer.") - (defcustom org-edit-src-persistent-message t "Non-nil means show persistent exit help message while editing src examples. The message is shown in the header-line, which will be created in the @@ -146,6 +137,17 @@ first line of the window showing the editing buffer." :group 'org-edit-structure :type 'boolean) +(defcustom org-src-ask-before-returning-to-edit-buffer t + "Non-nil means ask before switching to an existing edit buffer. +If nil, when `org-edit-src-code' is used on a block that already +has an active edit buffer, it will switch to that edit buffer +immediately; otherwise it will ask whether you want to return to +the existing edit buffer." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + (defcustom org-src-window-setup 'reorganize-frame "How the source code edit buffer should be displayed. Possible values for this option are: @@ -167,10 +169,10 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer. (defvar org-src-mode-hook nil "Hook run after Org switched a source code snippet to its Emacs mode. -This hook will run - -- when editing a source code snippet with `\\[org-src-mode-map]'. -- When formatting a source code snippet for export with htmlize. +\\ +This hook will run: +- when editing a source code snippet with `\\[org-edit-special]' +- when formatting a source code snippet for export with htmlize. You may want to use this hook for example to turn off `outline-minor-mode' or similar things which you want to have when editing a source code file, @@ -180,7 +182,7 @@ but which mess up the display of a snippet in Org exported files.") '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) - ("screen" . shell-script)) + ("screen" . shell-script) ("shell" . sh) ("bash" . sh)) "Alist mapping languages to their major mode. The key is the language name, the value is the string that should be inserted as the name of the major mode. For many languages this is @@ -194,451 +196,383 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (string "Language name") (symbol "Major mode")))) -;;; Editing source examples +(defcustom org-src-block-faces nil + "Alist of faces to be used for source-block. +Each element is a cell of the format -(defvar org-src-mode-map (make-sparse-keymap)) -(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) -(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort) -(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) + (\"language\" FACE) -(defvar org-edit-src-force-single-line nil) -(defvar org-edit-src-from-org-mode nil) -(defvar org-edit-src-allow-write-back-p t) -(defvar org-edit-src-picture nil) -(defvar org-edit-src-beg-marker nil) -(defvar org-edit-src-end-marker nil) -(defvar org-edit-src-overlay nil) -(defvar org-edit-src-block-indentation nil) -(defvar org-edit-src-saved-temp-window-config nil) +Where FACE is either a defined face or an anonymous face. -(defcustom org-src-ask-before-returning-to-edit-buffer t - "If nil, when org-edit-src code is used on a block that already -has an active edit buffer, it will switch to that edit buffer -immediately; otherwise it will ask whether you want to return to -the existing edit buffer." - :group 'org-edit-structure - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defvar org-src-babel-info nil) +For instance, the following value would color the background of +emacs-lisp source blocks and python source blocks in purple and +green, respectability. -(define-minor-mode org-src-mode - "Minor mode for language major mode buffers generated by org. -This minor mode is turned on in two situations: -- when editing a source code snippet with `\\[org-src-mode-map]'. -- When formatting a source code snippet for export with htmlize. -There is a mode hook, and keybindings for `org-edit-src-exit' and -`org-edit-src-save'") - -(defvar org-edit-src-code-timer nil) -(defvar org-inhibit-startup) + \\='((\"emacs-lisp\" (:background \"#EEE2FF\")) + (\"python\" (:background \"#e5ffb8\")))" + :group 'org-edit-structure + :type '(repeat (list (string :tag "language") + (choice + (face :tag "Face") + (sexp :tag "Anonymous face")))) + :version "26.1" + :package-version '(Org . "9.0")) -(defun org-edit-src-code (&optional context code edit-buffer-name) - "Edit the source CODE block at point. -The code is copied to a separate buffer and the appropriate mode -is turned on. When done, exit with \\[org-edit-src-exit]. This will -remove the original code in the Org buffer, and replace it with the -edited version. An optional argument CONTEXT is used by \\[org-edit-src-save] -when calling this function. See `org-src-window-setup' to configure -the display of windows containing the Org buffer and the code buffer." - (interactive) - (if (not (or (org-in-block-p '("src" "example" "latex" "html")) - (org-at-table.el-p))) - (user-error "Not in a source code or example block") - (unless (eq context 'save) - (setq org-edit-src-saved-temp-window-config (current-window-configuration))) - (let* ((mark (and (org-region-active-p) (mark))) - (case-fold-search t) - (info - ;; If the src region consists in no lines, we insert a blank - ;; line. - (let* ((temp (org-edit-src-find-region-and-lang)) - (beg (nth 0 temp)) - (end (nth 1 temp))) - (if (>= end beg) temp - (goto-char beg) - (insert "\n") - (org-edit-src-find-region-and-lang)))) - (full-info (org-babel-get-src-block-info 'light)) - (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive - (beg (make-marker)) - ;; Move marker with inserted text for case when src block is - ;; just one empty line, i.e. beg == end. - (end (copy-marker (make-marker) t)) - (allow-write-back-p (null code)) - block-nindent total-nindent ovl lang lang-f single buffer msg - begline markline markcol line col transmitted-variables) - (setq beg (move-marker beg (nth 0 info)) - end (move-marker end (nth 1 info)) - msg (if allow-write-back-p - "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort" - "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort") - code (or code (buffer-substring-no-properties beg end)) - lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) - (nth 2 info)) - lang (if (symbolp lang) (symbol-name lang) lang) - single (nth 3 info) - block-nindent (nth 5 info) - lang-f (intern (concat lang "-mode")) - begline (save-excursion (goto-char beg) (org-current-line)) - transmitted-variables - `((org-edit-src-content-indentation - ,org-edit-src-content-indentation) - (org-edit-src-force-single-line ,single) - (org-edit-src-from-org-mode ,org-mode-p) - (org-edit-src-allow-write-back-p ,allow-write-back-p) - (org-src-preserve-indentation ,org-src-preserve-indentation) - (org-src-babel-info ,(org-babel-get-src-block-info 'light)) - (org-coderef-label-format - ,(or (nth 4 info) org-coderef-label-format)) - (org-edit-src-beg-marker ,beg) - (org-edit-src-end-marker ,end) - (org-edit-src-block-indentation ,block-nindent))) - (if (and mark (>= mark beg) (<= mark (1+ end))) - (save-excursion (goto-char (min mark end)) - (setq markline (org-current-line) - markcol (current-column)))) - (if (equal lang-f 'table.el-mode) - (setq lang-f (lambda () - (text-mode) - (if (org-bound-and-true-p flyspell-mode) - (flyspell-mode -1)) - (table-recognize) - (org-set-local 'org-edit-src-content-indentation 0)))) - (unless (functionp lang-f) - (error "No such language mode: %s" lang-f)) - (save-excursion - (if (> (point) end) (goto-char end)) - (setq line (org-current-line) - col (current-column))) - (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (or (eq context 'save) - (if org-src-ask-before-returning-to-edit-buffer - (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t))) - (org-src-switch-to-buffer buffer 'return) - (when buffer - (with-current-buffer buffer - (if (boundp 'org-edit-src-overlay) - (delete-overlay org-edit-src-overlay))) - (kill-buffer buffer)) - (setq buffer (generate-new-buffer - (or edit-buffer-name - (org-src-construct-edit-buffer-name (buffer-name) lang)))) - (setq ovl (make-overlay beg end)) - (overlay-put ovl 'edit-buffer buffer) - (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (overlay-put ovl :read-only "Leave me alone") - (setq transmitted-variables - (append transmitted-variables `((org-edit-src-overlay ,ovl)))) - (org-src-switch-to-buffer buffer 'edit) - (if (eq single 'macro-definition) - (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) - (insert code) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) - (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables)) - (setq total-nindent (or (org-do-remove-indentation) 0))) - (let ((org-inhibit-startup t)) - (condition-case e - (funcall lang-f) - (error - (message "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) - (dolist (pair transmitted-variables) - (org-set-local (car pair) (cadr pair))) - ;; Remove protecting commas from visible part of buffer. - (org-unescape-code-in-region (point-min) (point-max)) - (when markline - (org-goto-line (1+ (- markline begline))) - (org-move-to-column - (if org-src-preserve-indentation markcol - (max 0 (- markcol total-nindent)))) - (push-mark (point) 'no-message t) - (setq deactivate-mark nil)) - (org-goto-line (1+ (- line begline))) - (org-move-to-column - (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) - (org-src-mode) - (set-buffer-modified-p nil) - (setq buffer-file-name nil) - (when org-edit-src-turn-on-auto-save - (setq buffer-auto-save-file-name - (concat (make-temp-name "org-src-") - (format-time-string "-%Y-%d-%m") ".txt"))) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg)) - (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) - (when (fboundp edit-prep-func) - (funcall edit-prep-func full-info))) - (or org-edit-src-code-timer - (zerop org-edit-src-auto-save-idle-delay) - (setq org-edit-src-code-timer - (run-with-idle-timer - org-edit-src-auto-save-idle-delay t - (lambda () - (cond - ((org-string-match-p "\\`\\*Org Src" (buffer-name)) - (when (buffer-modified-p) (org-edit-src-save))) - ((not (org-some (lambda (b) - (org-string-match-p "\\`\\*Org Src" - (buffer-name b))) - (buffer-list))) - (cancel-timer org-edit-src-code-timer) - (setq org-edit-src-code-timer nil)))))))) - t))) +(defcustom org-src-tab-acts-natively nil + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer." + :type 'boolean + :version "24.1" + :group 'org-babel) -(defun org-edit-src-continue (e) - "Continue editing source blocks." ;; Fixme: be more accurate - (interactive "e") - (mouse-set-point e) - (let ((buf (get-char-property (point) 'edit-buffer))) - (if buf (org-src-switch-to-buffer buf 'continue) - (error "Something is wrong here")))) -(defun org-src-switch-to-buffer (buffer context) - (case org-src-window-setup - ('current-window - (org-pop-to-buffer-same-window buffer)) - ('other-window - (switch-to-buffer-other-window buffer)) - ('other-frame - (case context - ('exit - (let ((frame (selected-frame))) - (switch-to-buffer-other-frame buffer) - (delete-frame frame))) - ('save - (kill-buffer (current-buffer)) - (org-pop-to-buffer-same-window buffer)) - (t - (switch-to-buffer-other-frame buffer)))) - ('reorganize-frame - (if (eq context 'edit) (delete-other-windows)) - (org-switch-to-buffer-other-window buffer) - (if (eq context 'exit) (delete-other-windows))) - ('switch-invisibly - (set-buffer buffer)) - (t - (message "Invalid value %s for org-src-window-setup" - (symbol-name org-src-window-setup)) - (org-pop-to-buffer-same-window buffer)))) - -(defun org-src-construct-edit-buffer-name (org-buffer-name lang) + +;;; Internal functions and variables + +(defvar org-src--allow-write-back t) +(defvar org-src--auto-save-timer nil) +(defvar org-src--babel-info nil) +(defvar org-src--beg-marker nil) +(defvar org-src--block-indentation nil) +(defvar org-src--end-marker nil) +(defvar org-src--from-org-mode nil) +(defvar org-src--overlay nil) +(defvar org-src--preserve-indentation nil) +(defvar org-src--remote nil) +(defvar org-src--saved-temp-window-config nil) +(defvar org-src--source-type nil + "Type of element being edited, as a symbol.") +(defvar org-src--tab-width nil + "Contains `tab-width' value from Org source buffer. +However, if `indent-tabs-mode' is nil in that buffer, its value +is 0.") + +(defun org-src--construct-edit-buffer-name (org-buffer-name lang) "Construct the buffer name for a source editing buffer." (concat "*Org Src " org-buffer-name "[ " lang " ]*")) -(defun org-src-edit-buffer-p (&optional buffer) - "Test whether BUFFER (or the current buffer if BUFFER is nil) -is a source block editing buffer." - (let ((buffer (org-base-buffer (or buffer (current-buffer))))) - (and (buffer-name buffer) - (string-match "\\`*Org Src " (buffer-name buffer)) - (local-variable-p 'org-edit-src-beg-marker buffer) - (local-variable-p 'org-edit-src-end-marker buffer)))) - -(defun org-edit-src-find-buffer (beg end) - "Find a source editing buffer that is already editing the region BEG to END." +(defun org-src--edit-buffer (beg end) + "Return buffer editing area between BEG and END. +Return nil if there is no such buffer." (catch 'exit - (mapc - (lambda (b) - (with-current-buffer b - (if (and (string-match "\\`*Org Src " (buffer-name)) - (local-variable-p 'org-edit-src-beg-marker (current-buffer)) - (local-variable-p 'org-edit-src-end-marker (current-buffer)) - (equal beg org-edit-src-beg-marker) - (equal end org-edit-src-end-marker)) - (throw 'exit (current-buffer))))) - (buffer-list)) - nil)) + (dolist (b (buffer-list)) + (with-current-buffer b + (and (org-src-edit-buffer-p) + (= beg org-src--beg-marker) + (eq (marker-buffer beg) (marker-buffer org-src--beg-marker)) + (= end org-src--end-marker) + (eq (marker-buffer end) (marker-buffer org-src--end-marker)) + (throw 'exit b)))))) + +(defun org-src--source-buffer () + "Return source buffer edited by current buffer." + (unless (org-src-edit-buffer-p) (error "Not in a source buffer")) + (or (marker-buffer org-src--beg-marker) + (error "No source buffer available for current editing session"))) + +(defun org-src--get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) + (if (symbolp l) (symbol-name l) l)) + "-mode"))) -(defun org-edit-fixed-width-region () - "Edit the fixed-width ascii drawing at point. -This must be a region where each line starts with a colon followed by -a space character. -An new buffer is created and the fixed-width region is copied into it, -and the buffer is switched into `artist-mode' for editing. When done, -exit with \\[org-edit-src-exit]. The edited text will then replace -the fragment in the Org-mode buffer." - (interactive) - (let ((line (org-current-line)) - (col (current-column)) - (case-fold-search t) - (msg "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort") - (org-mode-p (derived-mode-p 'org-mode)) - (beg (make-marker)) - (end (make-marker)) - block-nindent ovl beg1 end1 code begline buffer) - (beginning-of-line 1) - (if (looking-at "[ \t]*[^:\n \t]") - nil - (if (looking-at "[ \t]*\\(\n\\|\\'\\)") - (setq beg1 (point) end1 beg1) - (save-excursion - (if (re-search-backward "^[ \t]*[^: \t]" nil 'move) - (setq beg1 (point-at-bol 2)) - (setq beg1 (point)))) - (save-excursion - (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) - (setq end1 (1- (match-beginning 0))) - (setq end1 (point)))) - (org-goto-line line)) - (setq beg (move-marker beg beg1) - end (move-marker end end1) - code (buffer-substring-no-properties beg end) - begline (save-excursion (goto-char beg) (org-current-line))) - (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")) - (org-pop-to-buffer-same-window buffer) - (when buffer - (with-current-buffer buffer - (if (boundp 'org-edit-src-overlay) - (delete-overlay org-edit-src-overlay))) - (kill-buffer buffer)) - (setq buffer (generate-new-buffer - (org-src-construct-edit-buffer-name - (buffer-name) "Fixed Width"))) - (setq ovl (make-overlay beg end)) - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl 'edit-buffer buffer) - (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (overlay-put ovl :read-only "Leave me alone") - (org-pop-to-buffer-same-window buffer) - (insert code) +(defun org-src--coordinates (pos beg end) + "Return coordinates of POS relatively to BEG and END. +POS, BEG and END are buffer positions. Return value is either +a cons cell (LINE . COLUMN) or symbol `end'. See also +`org-src--goto-coordinates'." + (if (>= pos end) 'end + (org-with-wide-buffer + (goto-char (max beg pos)) + (cons (count-lines beg (line-beginning-position)) + ;; Column is relative to the end of line to avoid problems of + ;; comma escaping or colons appended in front of the line. + (- (current-column) + (progn (end-of-line) (current-column))))))) + +(defun org-src--goto-coordinates (coord beg end) + "Move to coordinates COORD relatively to BEG and END. +COORD are coordinates, as returned by `org-src--coordinates', +which see. BEG and END are buffer positions." + (goto-char + (if (eq coord 'end) (max (1- end) beg) + ;; If BEG happens to be located outside of the narrowed part of + ;; the buffer, widen it first. + (org-with-wide-buffer + (goto-char beg) + (forward-line (car coord)) + (end-of-line) + (org-move-to-column (max (+ (current-column) (cdr coord)) 0)) + (point))))) + +(defun org-src--contents-area (datum) + "Return contents boundaries of DATUM. +DATUM is an element or object. Return a list (BEG END CONTENTS) +where BEG and END are buffer positions and CONTENTS is a string." + (let ((type (org-element-type datum))) + (org-with-wide-buffer + (cond + ((eq type 'footnote-definition) + (let* ((beg (progn + (goto-char (org-element-property :post-affiliated datum)) + (search-forward "]"))) + (end (or (org-element-property :contents-end datum) beg))) + (list beg end (buffer-substring-no-properties beg end)))) + ((eq type 'inline-src-block) + (let ((beg (progn (goto-char (org-element-property :begin datum)) + (search-forward "{" (line-end-position) t))) + (end (progn (goto-char (org-element-property :end datum)) + (search-backward "}" (line-beginning-position) t)))) + (list beg end (buffer-substring-no-properties beg end)))) + ((org-element-property :contents-begin datum) + (let ((beg (org-element-property :contents-begin datum)) + (end (org-element-property :contents-end datum))) + (list beg end (buffer-substring-no-properties beg end)))) + ((memq type '(example-block export-block src-block)) + (list (progn (goto-char (org-element-property :post-affiliated datum)) + (line-beginning-position 2)) + (progn (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 1)) + (org-element-property :value datum))) + ((memq type '(fixed-width table)) + (let ((beg (org-element-property :post-affiliated datum)) + (end (progn (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (list beg + end + (if (eq type 'fixed-width) (org-element-property :value datum) + (buffer-substring-no-properties beg end))))) + (t (error "Unsupported element or object: %s" type)))))) + +(defun org-src--make-source-overlay (beg end edit-buffer) + "Create overlay between BEG and END positions and return it. +EDIT-BUFFER is the buffer currently editing area between BEG and +END." + (let ((overlay (make-overlay beg end))) + (overlay-put overlay 'face 'secondary-selection) + (overlay-put overlay 'edit-buffer edit-buffer) + (overlay-put overlay 'help-echo + "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put overlay 'face 'secondary-selection) + (overlay-put overlay 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (let ((read-only + (list + (lambda (&rest _) + (user-error + "Cannot modify an area being edited in a dedicated buffer"))))) + (overlay-put overlay 'modification-hooks read-only) + (overlay-put overlay 'insert-in-front-hooks read-only) + (overlay-put overlay 'insert-behind-hooks read-only)) + overlay)) + +(defun org-src--remove-overlay () + "Remove overlay from current source buffer." + (when (overlayp org-src--overlay) (delete-overlay org-src--overlay))) + +(defun org-src--on-datum-p (datum) + "Non-nil when point is on DATUM. +DATUM is an element or an object. Consider blank lines or white +spaces after it as being outside." + (and (>= (point) (org-element-property :begin datum)) + (<= (point) + (org-with-wide-buffer + (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class datum) 'element) + (line-end-position) + (point)))))) + +(defun org-src--contents-for-write-back () + "Return buffer contents in a format appropriate for write back. +Assume point is in the corresponding edit buffer." + (let ((indentation-offset + (if org-src--preserve-indentation 0 + (+ (or org-src--block-indentation 0) + (if (memq org-src--source-type '(example-block src-block)) + org-edit-src-content-indentation + 0)))) + (use-tabs? (and (> org-src--tab-width 0) t)) + (source-tab-width org-src--tab-width) + (contents (org-with-wide-buffer (buffer-string))) + (write-back org-src--allow-write-back)) + (with-temp-buffer + ;; Reproduce indentation parameters from source buffer. + (setq-local indent-tabs-mode use-tabs?) + (when (> source-tab-width 0) (setq-local tab-width source-tab-width)) + ;; Apply WRITE-BACK function on edit buffer contents. + (insert (org-no-properties contents)) + (goto-char (point-min)) + (when (functionp write-back) (save-excursion (funcall write-back))) + ;; Add INDENTATION-OFFSET to every non-empty line in buffer, + ;; unless indentation is meant to be preserved. + (when (> indentation-offset 0) + (while (not (eobp)) + (skip-chars-forward " \t") + (unless (eolp) ;ignore blank lines + (let ((i (current-column))) + (delete-region (line-beginning-position) (point)) + (indent-to (+ i indentation-offset)))) + (forward-line))) + (buffer-string)))) + +(defun org-src--edit-element + (datum name &optional major write-back contents remote) + "Edit DATUM contents in a dedicated buffer NAME. + +MAJOR is the major mode used in the edit buffer. A nil value is +equivalent to `fundamental-mode'. + +When WRITE-BACK is non-nil, assume contents will replace original +region. Moreover, if it is a function, apply it in the edit +buffer, from point min, before returning the contents. + +When CONTENTS is non-nil, display them in the edit buffer. +Otherwise, show DATUM contents as specified by +`org-src--contents-area'. + +When REMOTE is non-nil, do not try to preserve point or mark when +moving from the edit area to the source. + +Leave point in edit buffer." + (setq org-src--saved-temp-window-config (current-window-configuration)) + (let* ((area (org-src--contents-area datum)) + (beg (copy-marker (nth 0 area))) + (end (copy-marker (nth 1 area) t)) + (old-edit-buffer (org-src--edit-buffer beg end)) + (contents (or contents (nth 2 area)))) + (if (and old-edit-buffer + (or (not org-src-ask-before-returning-to-edit-buffer) + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))) + ;; Move to existing buffer. + (org-src-switch-to-buffer old-edit-buffer 'return) + ;; Discard old edit buffer. + (when old-edit-buffer + (with-current-buffer old-edit-buffer (org-src--remove-overlay)) + (kill-buffer old-edit-buffer)) + (let* ((org-mode-p (derived-mode-p 'org-mode)) + (source-tab-width (if indent-tabs-mode tab-width 0)) + (type (org-element-type datum)) + (ind (org-with-wide-buffer + (goto-char (org-element-property :begin datum)) + (org-get-indentation))) + (preserve-ind + (and (memq type '(example-block src-block)) + (or (org-element-property :preserve-indent datum) + org-src-preserve-indentation))) + ;; Store relative positions of mark (if any) and point + ;; within the edited area. + (point-coordinates (and (not remote) + (org-src--coordinates (point) beg end))) + (mark-coordinates (and (not remote) + (org-region-active-p) + (let ((m (mark))) + (and (>= m beg) (>= end m) + (org-src--coordinates m beg end))))) + ;; Generate a new edit buffer. + (buffer (generate-new-buffer name)) + ;; Add an overlay on top of source. + (overlay (org-src--make-source-overlay beg end buffer))) + ;; Switch to edit buffer. + (org-src-switch-to-buffer buffer 'edit) + ;; Insert contents. + (insert contents) (remove-text-properties (point-min) (point-max) '(display nil invisible nil intangible nil)) - (setq block-nindent (or (org-do-remove-indentation) 0)) - (cond - ((eq org-edit-fixed-width-region-mode 'artist-mode) - (fundamental-mode) - (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) - (set (make-local-variable 'org-edit-src-force-single-line) nil) - (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) - (set (make-local-variable 'org-edit-src-picture) t) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*: ?" nil t) - (replace-match "")) - (org-goto-line (1+ (- line begline))) - (org-move-to-column (max 0 (- col block-nindent 2))) - (org-set-local 'org-edit-src-beg-marker beg) - (org-set-local 'org-edit-src-end-marker end) - (org-set-local 'org-edit-src-overlay ovl) - (org-set-local 'org-edit-src-block-indentation block-nindent) - (org-set-local 'org-edit-src-content-indentation 0) - (org-set-local 'org-src-preserve-indentation nil) - (org-src-mode) + (unless preserve-ind (org-do-remove-indentation)) (set-buffer-modified-p nil) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg))) - (message "%s" msg) - t))) + (setq buffer-file-name nil) + ;; Start major mode. + (if (not major) (fundamental-mode) + (let ((org-inhibit-startup t)) + (condition-case e (funcall major) + (error (message "Language mode `%s' fails with: %S" + major (nth 1 e)))))) + ;; Transmit buffer-local variables for exit function. It must + ;; be done after initializing major mode, as this operation + ;; may reset them otherwise. + (setq-local org-src--tab-width source-tab-width) + (setq-local org-src--from-org-mode org-mode-p) + (setq-local org-src--beg-marker beg) + (setq-local org-src--end-marker end) + (setq-local org-src--remote remote) + (setq-local org-src--source-type type) + (setq-local org-src--block-indentation ind) + (setq-local org-src--preserve-indentation preserve-ind) + (setq-local org-src--overlay overlay) + (setq-local org-src--allow-write-back write-back) + ;; Start minor mode. + (org-src-mode) + ;; Move mark and point in edit buffer to the corresponding + ;; location. + (if remote + (progn + ;; Put point at first non read-only character after + ;; leading blank. + (goto-char + (or (text-property-any (point-min) (point-max) 'read-only nil) + (point-max))) + (skip-chars-forward " \r\t\n")) + ;; Set mark and point. + (when mark-coordinates + (org-src--goto-coordinates mark-coordinates (point-min) (point-max)) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) + (org-src--goto-coordinates + point-coordinates (point-min) (point-max))))))) + + + +;;; Fontification of source blocks -(defun org-edit-src-find-region-and-lang () - "Find the region and language for a local edit. -Return a list with beginning and end of the region, a string representing -the language, a switch telling if the content should be in a single line." - (let ((re-list - (append - org-edit-src-region-extra - '( - ("[^<]*>[ \t]*\n?" "\n?[ \t]*" lang) - ("[^<]*>[ \t]*\n?" "\n?[ \t]*" style) - ("[ \t]*\n?" "\n?[ \t]*" "fundamental") - ("[ \t]*\n?" "\n?[ \t]*" "emacs-lisp") - ("[ \t]*\n?" "\n?[ \t]*" "perl") - ("[ \t]*\n?" "\n?[ \t]*" "python") - ("[ \t]*\n?" "\n?[ \t]*" "ruby") - ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2) - ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental") - ("^[ \t]*#\\+html:" "\n" "html" single-line) - ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html") - ("^[ \t]*#\\+latex:" "\n" "latex" single-line) - ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") - ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) - ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") - ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" - "\n" "fundamental" macro-definition) - ))) - (pos (point)) - re1 re2 single beg end lang lfmt match-re1 ind entry) - (catch 'exit - (while (setq entry (pop re-list)) - (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) - single (nth 3 entry)) - (save-excursion - (if (or (looking-at re1) - (re-search-backward re1 nil t)) - (progn - (setq match-re1 (match-string 0)) - (setq beg (match-end 0) - lang (org-edit-src-get-lang lang) - lfmt (org-edit-src-get-label-format match-re1) - ind (org-edit-src-get-indentation (match-beginning 0))) - (if (and (re-search-forward re2 nil t) - (>= (match-end 0) pos)) - (throw 'exit (list beg (match-beginning 0) - lang single lfmt ind)))) - (if (or (looking-at re2) - (re-search-forward re2 nil t)) - (progn - (setq end (match-beginning 0)) - (if (and (re-search-backward re1 nil t) - (<= (match-beginning 0) pos)) - (progn - (setq lfmt (org-edit-src-get-label-format - (match-string 0)) - ind (org-edit-src-get-indentation - (match-beginning 0))) - (throw 'exit - (list (match-end 0) end - (org-edit-src-get-lang lang) - single lfmt ind))))))))) - (when (org-at-table.el-p) - (re-search-backward "^[\t]*[^ \t|\\+]" nil t) - (setq beg (1+ (point-at-eol))) - (goto-char beg) - (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) - (progn (goto-char (point-max)) (newline))) - (setq end (1- (point-at-bol))) - (throw 'exit (list beg end 'table.el nil nil 0)))))) - -(defun org-edit-src-get-lang (lang) - "Extract the src language." - (let ((m (match-string 0))) - (cond - ((stringp lang) lang) - ((integerp lang) (match-string lang)) - ((and (eq lang 'lang) - (string-match "\\ cnt 0)) - (goto-char (point-max)) (insert "\\n"))) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " "))) - (when (and (org-bound-and-true-p org-edit-src-from-org-mode) - (not fixed-width-p)) - (org-escape-code-in-region (point-min) (point-max)) - (setq delta (+ delta - (save-excursion - (org-goto-line line) - (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1 - 0))))) - (when (org-bound-and-true-p org-edit-src-picture) - (setq preserve-indentation nil) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": "))) - (unless (or single preserve-indentation (= total-nindent 0)) - (setq indent (make-string total-nindent ?\ )) - (goto-char (point-min)) - (while (re-search-forward "\\(^\\).+" nil t) - (replace-match indent nil nil nil 1))) - (if (org-bound-and-true-p org-edit-src-picture) - (setq total-nindent (+ total-nindent 2))) - (setq code (buffer-string)) - (when (eq context 'save) - (erase-buffer) - (insert bufstr)) - (set-buffer-modified-p nil)) - (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) - (if (eq context 'save) (save-buffer) - (with-current-buffer buffer - (set-buffer-modified-p nil)) - (kill-buffer buffer)) - (goto-char beg) - (when allow-write-back-p - (undo-boundary) - (delete-region beg (max beg end)) - (unless (string-match "\\`[ \t]*\\'" code) - (insert code)) - ;; Make sure the overlay stays in place - (when (eq context 'save) (move-overlay ovl beg (point))) - (goto-char beg) - (if single (just-one-space))) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-hide-block)) - (overlays-at (point)))) - ;; Block is hidden; put point at start of block - (beginning-of-line 0) - ;; Block is visible, put point where it was in the code buffer - (when allow-write-back-p - (org-goto-line (1- (+ (org-current-line) line))) - (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))) - (unless (eq context 'save) - (move-marker beg nil) - (move-marker end nil))) - (unless (eq context 'save) - (when org-edit-src-saved-temp-window-config - (set-window-configuration org-edit-src-saved-temp-window-config) - (setq org-edit-src-saved-temp-window-config nil)))) - -(defun org-edit-src-abort () - "Abort editing of the src code and return to the Org buffer." - (interactive) - (let (org-edit-src-allow-write-back-p) - (org-edit-src-exit 'exit))) - -(defmacro org-src-in-org-buffer (&rest body) - `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) - (save-window-excursion - (org-edit-src-exit 'save) - ,@body - (setq msg (current-message)) - (if (eq org-src-window-setup 'other-frame) - (let ((org-src-window-setup 'current-window)) - (org-edit-src-code 'save)) - (org-edit-src-code 'save))) - (setq buffer-undo-list ul) - (push-mark m 'nomessage) - (goto-char (min p (point-max))) - (message (or msg "")))) -(def-edebug-spec org-src-in-org-buffer (body)) -(defun org-edit-src-save () - "Save parent buffer with current state source-code buffer." - (interactive) - (if (string-match "Fixed Width" (buffer-name)) - (user-error "%s" "Use C-c ' to save and exit, C-c C-k to abort editing") - (org-src-in-org-buffer (save-buffer)))) + +;;; Org src minor mode -(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang)) +(defvar org-src-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c'" 'org-edit-src-exit) + (define-key map "\C-c\C-k" 'org-edit-src-abort) + (define-key map "\C-x\C-s" 'org-edit-src-save) + map)) -(defun org-src-tangle (arg) - "Tangle the parent buffer." - (interactive) - (org-src-in-org-buffer (org-babel-tangle arg))) +(define-minor-mode org-src-mode + "Minor mode for language major mode buffers generated by Org. +\\ +This minor mode is turned on in two situations: + - when editing a source code snippet with `\\[org-edit-special]' + - when formatting a source code snippet for export with htmlize. + +\\{org-src-mode-map} + +See also `org-src-mode-hook'." + nil " OrgSrc" nil + (when org-edit-src-persistent-message + (setq-local + header-line-format + (substitute-command-keys + (if org-src--allow-write-back + "Edit, then exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'" + "Exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'")))) + ;; Possibly activate various auto-save features (for the edit buffer + ;; or the source buffer). + (when org-edit-src-turn-on-auto-save + (setq buffer-auto-save-file-name + (concat (make-temp-name "org-src-") + (format-time-string "-%Y-%d-%m") + ".txt"))) + (unless (or org-src--auto-save-timer (zerop org-edit-src-auto-save-idle-delay)) + (setq org-src--auto-save-timer + (run-with-idle-timer + org-edit-src-auto-save-idle-delay t + (lambda () + (save-excursion + (let (edit-flag) + (dolist (b (buffer-list)) + (with-current-buffer b + (when (org-src-edit-buffer-p) + (unless edit-flag (setq edit-flag t)) + (when (buffer-modified-p) (org-edit-src-save))))) + (unless edit-flag + (cancel-timer org-src--auto-save-timer) + (setq org-src--auto-save-timer nil))))))))) (defun org-src-mode-configure-edit-buffer () - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (org-add-hook 'kill-buffer-hook - #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) - (if (org-bound-and-true-p org-edit-src-allow-write-back-p) + (when (bound-and-true-p org-src--from-org-mode) + (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local) + (if (bound-and-true-p org-src--allow-write-back) (progn (setq buffer-offer-save t) (setq buffer-file-name - (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + (concat (buffer-file-name (marker-buffer org-src--beg-marker)) "[" (buffer-name) "]")) - (if (featurep 'xemacs) - (progn - (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 - (setq write-contents-hooks '(org-edit-src-save))) - (setq write-contents-functions '(org-edit-src-save)))) + (setq-local write-contents-functions '(org-edit-src-save))) (setq buffer-read-only t)))) -(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) +(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) + + +;;; Babel related functions (defun org-src-associate-babel-session (info) "Associate edit buffer with comint session." (interactive) - (let ((session (cdr (assoc :session (nth 2 info))))) + (let ((session (cdr (assq :session (nth 2 info))))) (and session (not (string= session "none")) (org-babel-comint-buffer-livep session) (let ((f (intern (format "org-babel-%s-associate-session" @@ -843,18 +690,22 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (and (fboundp f) (funcall f session)))))) (defun org-src-babel-configure-edit-buffer () - (when org-src-babel-info - (org-src-associate-babel-session org-src-babel-info))) + (when org-src--babel-info + (org-src-associate-babel-session org-src--babel-info))) + +(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer) + + +;;; Public API -(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) (defmacro org-src-do-at-code-block (&rest body) - "Execute a command from an edit buffer in the Org-mode buffer." - `(let ((beg-marker org-edit-src-beg-marker)) - (if beg-marker - (with-current-buffer (marker-buffer beg-marker) - (goto-char (marker-position beg-marker)) - ,@body)))) -(def-edebug-spec org-src-do-at-code-block (body)) + "Execute BODY from an edit buffer in the Org mode buffer." + (declare (debug (body))) + `(let ((beg-marker org-src--beg-marker)) + (when beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char beg-marker) + ,@body)))) (defun org-src-do-key-sequence-at-code-block (&optional key) "Execute key sequence at code block in the source Org buffer. @@ -878,85 +729,375 @@ Org-babel commands." (if (equal key (kbd "C-g")) (keyboard-quit) (org-edit-src-save) (org-src-do-at-code-block - (call-interactively - (lookup-key org-babel-map key))))) + (call-interactively (lookup-key org-babel-map key))))) -(defcustom org-src-tab-acts-natively nil - "If non-nil, the effect of TAB in a code block is as if it were -issued in the language major mode buffer." - :type 'boolean - :version "24.1" - :group 'org-babel) +(defun org-src-edit-buffer-p (&optional buffer) + "Non-nil when current buffer is a source editing buffer. +If BUFFER is non-nil, test it instead." + (let ((buffer (org-base-buffer (or buffer (current-buffer))))) + (and (buffer-live-p buffer) + (local-variable-p 'org-src--beg-marker buffer) + (local-variable-p 'org-src--end-marker buffer)))) + +(defun org-src-switch-to-buffer (buffer context) + (pcase org-src-window-setup + (`current-window (pop-to-buffer-same-window buffer)) + (`other-window + (switch-to-buffer-other-window buffer)) + (`other-frame + (pcase context + (`exit + (let ((frame (selected-frame))) + (switch-to-buffer-other-frame buffer) + (delete-frame frame))) + (`save + (kill-buffer (current-buffer)) + (pop-to-buffer-same-window buffer)) + (_ (switch-to-buffer-other-frame buffer)))) + (`reorganize-frame + (when (eq context 'edit) (delete-other-windows)) + (org-switch-to-buffer-other-window buffer) + (when (eq context 'exit) (delete-other-windows))) + (`switch-invisibly (set-buffer buffer)) + (_ + (message "Invalid value %s for `org-src-window-setup'" + org-src-window-setup) + (pop-to-buffer-same-window buffer)))) + +(defun org-src-coderef-format (&optional element) + "Return format string for block at point. + +When optional argument ELEMENT is provided, use that block. +Otherwise, assume point is either at a source block, at an +example block. + +If point is in an edit buffer, retrieve format string associated +to the remote source block." + (cond + ((and element (org-element-property :label-fmt element))) + ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format))) + ((org-element-property :label-fmt (org-element-at-point))) + (t org-coderef-label-format))) + +(defun org-src-coderef-regexp (fmt &optional label) + "Return regexp matching a coderef format string FMT. + +When optional argument LABEL is non-nil, match coderef for that +label only. + +Match group 1 contains the full coderef string with surrounding +white spaces. Match group 2 contains the same string without any +surrounding space. Match group 3 contains the label. + +A coderef format regexp can only match at the end of a line." + (format "\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" + (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)") + (regexp-quote fmt) + nil t))) + +(defun org-edit-footnote-reference () + "Edit definition of footnote reference at point." + (interactive) + (let* ((context (org-element-context)) + (label (org-element-property :label context))) + (unless (and (eq (org-element-type context) 'footnote-reference) + (org-src--on-datum-p context)) + (user-error "Not on a footnote reference")) + (unless label (user-error "Cannot edit remotely anonymous footnotes")) + (let* ((definition (org-with-wide-buffer + (org-footnote-goto-definition label) + (backward-char) + (org-element-context))) + (inline? (eq 'footnote-reference (org-element-type definition))) + (contents + (org-with-wide-buffer + (buffer-substring-no-properties + (or (org-element-property :post-affiliated definition) + (org-element-property :begin definition)) + (cond + (inline? (1+ (org-element-property :contents-end definition))) + ((org-element-property :contents-end definition)) + (t (goto-char (org-element-property :post-affiliated definition)) + (line-end-position))))))) + (add-text-properties + 0 + (progn (string-match (if inline? "\\`\\[fn:.*?:" "\\`.*?\\]") contents) + (match-end 0)) + '(read-only "Cannot edit footnote label" front-sticky t rear-nonsticky t) + contents) + (when inline? + (let ((l (length contents))) + (add-text-properties + (1- l) l + '(read-only "Cannot edit past footnote reference" + front-sticky nil rear-nonsticky nil) + contents))) + (org-src--edit-element + definition + (format "*Edit footnote [%s]*" label) + #'org-mode + (lambda () + (if (not inline?) (delete-region (point) (search-forward "]")) + (delete-region (point) (search-forward ":" nil t 2)) + (delete-region (1- (point-max)) (point-max)) + (when (re-search-forward "\n[ \t]*\n" nil t) + (user-error "Inline definitions cannot contain blank lines")) + ;; If footnote reference belongs to a table, make sure to + ;; remove any newline characters in order to preserve + ;; table's structure. + (when (org-element-lineage definition '(table-cell)) + (while (search-forward "\n" nil t) (replace-match ""))))) + contents + 'remote)) + ;; Report success. + t)) + +(defun org-edit-table.el () + "Edit \"table.el\" table at point. +\\ +A new buffer is created and the table is copied into it. Then +the table is recognized with `table-recognize'. When done +editing, exit with `\\[org-edit-src-exit]'. The edited text will \ +then replace +the area in the Org mode buffer. + +Throw an error when not at such a table." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'table) + (eq (org-element-property :type element) 'table.el) + (org-src--on-datum-p element)) + (user-error "Not in a table.el table")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "Table") + #'text-mode t) + (when (bound-and-true-p flyspell-mode) (flyspell-mode -1)) + (table-recognize) + t)) + +(defun org-edit-export-block () + "Edit export block at point. +\\ +A new buffer is created and the block is copied into it, and the +buffer is switched into an appropriate major mode. See also +`org-src-lang-modes'. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the area in the Org mode buffer. + +Throw an error when not at an export block." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'export-block) + (org-src--on-datum-p element)) + (user-error "Not in an export block")) + (let* ((type (downcase (org-element-property :type element))) + (mode (org-src--get-lang-mode type))) + (unless (functionp mode) (error "No such language mode: %s" mode)) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) type) + mode + (lambda () (org-escape-code-in-region (point-min) (point-max))))) + t)) + +(defun org-edit-src-code (&optional code edit-buffer-name) + "Edit the source or example block at point. +\\ +The code is copied to a separate buffer and the appropriate mode +is turned on. When done, exit with `\\[org-edit-src-exit]'. This \ +will remove the +original code in the Org buffer, and replace it with the edited +version. See `org-src-window-setup' to configure the display of +windows containing the Org buffer and the code buffer. -(defun org-src-native-tab-command-maybe () - "Perform language-specific TAB action. -Alter code block according to what TAB does in the language major mode." - (and org-src-tab-acts-natively - (org-in-src-block-p) - (not (equal this-command 'org-shifttab)) - (let ((org-src-strip-leading-and-trailing-blank-lines nil)) - (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) +When optional argument CODE is a string, edit it in a dedicated +buffer instead. -(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) +When optional argument EDIT-BUFFER-NAME is non-nil, use it as the +name of the sub-editing buffer." + (interactive) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (unless (and (memq type '(example-block src-block)) + (org-src--on-datum-p element)) + (user-error "Not in a source or example block")) + (let* ((lang + (if (eq type 'src-block) (org-element-property :language element) + "example")) + (lang-f (and (eq type 'src-block) (org-src--get-lang-mode lang))) + (babel-info (and (eq type 'src-block) + (org-babel-get-src-block-info 'light))) + deactivate-mark) + (when (and (eq type 'src-block) (not (functionp lang-f))) + (error "No such language mode: %s" lang-f)) + (org-src--edit-element + element + (or edit-buffer-name + (org-src--construct-edit-buffer-name (buffer-name) lang)) + lang-f + (and (null code) + (lambda () (org-escape-code-in-region (point-min) (point-max)))) + (and code (org-unescape-code-in-string code))) + ;; Finalize buffer. + (setq-local org-coderef-label-format + (or (org-element-property :label-fmt element) + org-coderef-label-format)) + (when (eq type 'src-block) + (setq-local org-src--babel-info babel-info) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) + (funcall edit-prep-func babel-info)))) + t))) -(defun org-src-font-lock-fontify-block (lang start end) - "Fontify code block. -This function is called by emacs automatic fontification, as long -as `org-src-fontify-natively' is non-nil. For manual -fontification of code blocks see `org-src-fontify-block' and -`org-src-fontify-buffer'" - (let ((lang-mode (org-src-get-lang-mode lang))) - (if (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (org-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (concat " org-src-fontification:" (symbol-name lang-mode))) - ;; Make sure that modification hooks are not inhibited in - ;; the org-src-fontification buffer in case we're called - ;; from `jit-lock-function' (Bug#25132). - (let ((inhibit-modification-hooks nil)) - (delete-region (point-min) (point-max)) - (insert string " ")) ;; so there's a final property change - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (org-font-lock-ensure) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - (get-text-property pos 'face) org-buffer) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) +(defun org-edit-inline-src-code () + "Edit inline source code at point." + (interactive) + (let ((context (org-element-context))) + (unless (and (eq (org-element-type context) 'inline-src-block) + (org-src--on-datum-p context)) + (user-error "Not on inline source code")) + (let* ((lang (org-element-property :language context)) + (lang-f (org-src--get-lang-mode lang)) + (babel-info (org-babel-get-src-block-info 'light)) + deactivate-mark) + (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) + (org-src--edit-element + context + (org-src--construct-edit-buffer-name (buffer-name) lang) + lang-f + (lambda () + ;; Inline src blocks are limited to one line. + (while (re-search-forward "\n[ \t]*" nil t) (replace-match " ")) + ;; Trim contents. + (goto-char (point-min)) + (skip-chars-forward " \t") + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)))) + ;; Finalize buffer. + (setq-local org-src--babel-info babel-info) + (setq-local org-src--preserve-indentation t) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info))) + ;; Return success. + t))) -(defvar org-src-fontify-natively) +(defun org-edit-fixed-width-region () + "Edit the fixed-width ASCII drawing at point. +\\ +This must be a region where each line starts with a colon +followed by a space or a newline character. + +A new buffer is created and the fixed-width region is copied into +it, and the buffer is switched into the major mode defined in +`org-edit-fixed-width-region-mode', which see. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the area in the Org mode buffer." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'fixed-width) + (org-src--on-datum-p element)) + (user-error "Not in a fixed-width area")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "Fixed Width") + org-edit-fixed-width-region-mode + (lambda () (while (not (eobp)) (insert ": ") (forward-line)))) + ;; Return success. + t)) -(defun org-src-fontify-block () - "Fontify code block at point." +(defun org-edit-src-abort () + "Abort editing of the src code and return to the Org buffer." (interactive) - (save-excursion - (let ((org-src-fontify-natively t) - (info (org-edit-src-find-region-and-lang))) - (font-lock-fontify-region (nth 0 info) (nth 1 info))))) + (let (org-src--allow-write-back) (org-edit-src-exit))) -(defun org-src-fontify-buffer () - "Fontify all code blocks in the current buffer." +(defun org-edit-src-continue (e) + "Unconditionally return to buffer editing area under point. +Throw an error if there is no such buffer." + (interactive "e") + (mouse-set-point e) + (let ((buf (get-char-property (point) 'edit-buffer))) + (if buf (org-src-switch-to-buffer buf 'continue) + (user-error "No sub-editing buffer for area at point")))) + +(defun org-edit-src-save () + "Save parent buffer with current state source-code buffer." (interactive) - (org-babel-map-src-blocks nil - (org-src-fontify-block))) + (unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer")) + (set-buffer-modified-p nil) + (let ((edited-code (org-src--contents-for-write-back)) + (beg org-src--beg-marker) + (end org-src--end-marker) + (overlay org-src--overlay)) + (with-current-buffer (org-src--source-buffer) + (undo-boundary) + (goto-char beg) + ;; Temporarily disable read-only features of OVERLAY in order to + ;; insert new contents. + (delete-overlay overlay) + (delete-region beg end) + (let ((expecting-bol (bolp))) + (insert edited-code) + (when (and expecting-bol (not (bolp))) (insert "\n"))) + (save-buffer) + (move-overlay overlay beg (point)))) + ;; `write-contents-functions' requires the function to return + ;; a non-nil value so that other functions are not called. + t) + +(defun org-edit-src-exit () + "Kill current sub-editing buffer and return to source buffer." + (interactive) + (unless (org-src-edit-buffer-p) (error "Not in a sub-editing buffer")) + (let* ((beg org-src--beg-marker) + (end org-src--end-marker) + (write-back org-src--allow-write-back) + (remote org-src--remote) + (coordinates (and (not remote) + (org-src--coordinates (point) 1 (point-max)))) + (code (and write-back (org-src--contents-for-write-back)))) + (set-buffer-modified-p nil) + ;; Switch to source buffer. Kill sub-editing buffer. + (let ((edit-buffer (current-buffer)) + (source-buffer (marker-buffer beg))) + (unless source-buffer (error "Source buffer disappeared. Aborting")) + (org-src-switch-to-buffer source-buffer 'exit) + (kill-buffer edit-buffer)) + ;; Insert modified code. Ensure it ends with a newline character. + (org-with-wide-buffer + (when (and write-back (not (equal (buffer-substring beg end) code))) + (undo-boundary) + (goto-char beg) + (delete-region beg end) + (let ((expecting-bol (bolp))) + (insert code) + (when (and expecting-bol (not (bolp))) (insert "\n"))))) + ;; If we are to return to source buffer, put point at an + ;; appropriate location. In particular, if block is hidden, move + ;; to the beginning of the block opening line. + (unless remote + (goto-char beg) + (cond + ;; Block is hidden; move at start of block. + ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) + (overlays-at (point))) + (beginning-of-line 0)) + (write-back (org-src--goto-coordinates coordinates beg end)))) + ;; Clean up left-over markers and restore window configuration. + (set-marker beg nil) + (set-marker end nil) + (when org-src--saved-temp-window-config + (set-window-configuration org-src--saved-temp-window-config) + (setq org-src--saved-temp-window-config nil)))) -(defun org-src-get-lang-mode (lang) - "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." - (intern - (concat - (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) - (if (symbolp l) (symbol-name l) l)) - "-mode"))) (provide 'org-src) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index 0c813d03a1..40a715aebd 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -1,4 +1,4 @@ -;;; org-table.el --- The table editor for Org-mode +;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*- ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -24,27 +24,53 @@ ;; ;;; Commentary: -;; This file contains the table editor and spreadsheet for Org-mode. +;; This file contains the table editor and spreadsheet for Org mode. ;; Watch out: Here we are talking about two different kind of tables. -;; Most of the code is for the tables created with the Org-mode table editor. +;; Most of the code is for the tables created with the Org mode table editor. ;; Sometimes, we talk about tables created and edited with the table.el ;; Emacs package. We call the former org-type tables, and the latter ;; table.el-type tables. ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl-lib) (require 'org) -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) -(declare-function aa2u "ext:ascii-art-to-unicode" ()) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-extract-element "org-element" (element)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function org-element-lineage "org-element" + (blob &optional types with-self)) +(declare-function org-element-map "org-element" + (data types fun + &optional info first-match no-recursion with-affiliated)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) + +(declare-function org-export-create-backend "ox" (&rest rest) t) +(declare-function org-export-data-with-backend "ox" (data backend info)) +(declare-function org-export-filter-apply-functions "ox" + (filters value info)) +(declare-function org-export-first-sibling-p "ox" (blob info)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" + (&optional backend subtreep ext-plist)) +(declare-function org-export-install-filters "ox" (info)) +(declare-function org-export-table-has-special-column-p "ox" (table)) +(declare-function org-export-table-row-is-special-p "ox" (table-row info)) + +(declare-function calc-eval "calc" (str &optional separator &rest args)) + (defvar orgtbl-mode) ; defined below (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized (defvar constants-unit-system) +(defvar org-export-filters-alist) (defvar org-table-follow-field-mode) +(defvar sort-fold-case) (defvar orgtbl-after-send-table-hook nil "Hook for functions attaching to `C-c C-c', if the table is sent. @@ -52,7 +78,7 @@ This can be used to add additional functionality after the table is sent to the receiver position, otherwise, if table is not sent, the functions are not run.") -(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") +(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ") (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) "Non-nil means use the optimized table editor version for `orgtbl-mode'. @@ -63,7 +89,7 @@ for empty fields). Outside tables, the correct binding of the keys is restored. The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing +Org mode. See the variable `org-enable-table-editor' for details. Changing this variable requires a restart of Emacs to become effective." :group 'org-table :type 'boolean) @@ -118,7 +144,7 @@ table, obtained by prompting the user." (string :tag "Format")))) (defgroup org-table-settings nil - "Settings for tables in Org-mode." + "Settings for tables in Org mode." :tag "Org Table Settings" :group 'org-table) @@ -167,13 +193,13 @@ alignment to the right border applies." :type 'number) (defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." + "Behavior of tables during editing in Org mode." :tag "Org Table Editing" :group 'org-table) (defcustom org-table-automatic-realign t "Non-nil means automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column +When nil, aligning is only done with `\\[org-table-align]', or after column removal/insertion." :group 'org-table-editing :type 'boolean) @@ -219,12 +245,12 @@ this line." :type 'boolean) (defgroup org-table-calculation nil - "Options concerning tables in Org-mode." + "Options concerning tables in Org mode." :tag "Org Table Calculation" :group 'org-table) (defcustom org-table-use-standard-references 'from - "Should org-mode work with table references like B3 instead of @3$2? + "Non-nil means using table references like B3 instead of @3$2. Possible values are: nil never use them from accept as input, do not present for editing @@ -236,9 +262,15 @@ t accept as input and present for editing" (const :tag "Convert user input, don't offer during editing" from))) (defcustom org-table-copy-increment t - "Non-nil means increment when copying current field with \\[org-table-copy-down]." + "Non-nil means increment when copying current field with \ +`\\[org-table-copy-down]'." :group 'org-table-calculation - :type 'boolean) + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Use the difference between the current and the above fields" t) + (integer :tag "Use a number" 1) + (const :tag "Don't increment the value when copying a field" nil))) (defcustom org-calc-default-modes '(calc-internal-prec 12 @@ -251,16 +283,16 @@ t accept as input and present for editing" ) "List with Calc mode settings for use in `calc-eval' for table formulas. The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode +Don't remove any of the default settings, just change the values. Org mode relies on the variables to be present in the list." :group 'org-table-calculation :type 'plist) (defcustom org-table-duration-custom-format 'hours "Format for the output of calc computations like $1+$2;t. -The default value is 'hours, and will output the results as a -number of hours. Other allowed values are 'seconds, 'minutes and -'days, and the output will be a fraction of seconds, minutes or +The default value is `hours', and will output the results as a +number of hours. Other allowed values are `seconds', `minutes' and +`days', and the output will be a fraction of seconds, minutes or days." :group 'org-table-calculation :version "24.1" @@ -285,7 +317,7 @@ which should be evaluated as described in the manual and in the documentation string of the command `org-table-eval-formula'. This feature requires the Emacs calc package. When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." +the command `\\[org-table-eval-formula]'." :group 'org-table-calculation :type 'boolean) @@ -317,15 +349,12 @@ Constants can also be defined on a per-file basis using a line like (defcustom org-table-allow-automatic-line-recalculation t "Non-nil means lines marked with |#| or |*| will be recomputed automatically. -Automatically means when TAB or RET or C-c C-c are pressed in the line." +\\\ +Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \ +are pressed in the line." :group 'org-table-calculation :type 'boolean) -(defcustom org-table-error-on-row-ref-crossing-hline t - "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'." - :group 'org-table - :type 'boolean) - (defcustom org-table-relative-ref-may-cross-hline t "Non-nil means relative formula references may cross hlines. Here are the allowed values: @@ -345,8 +374,20 @@ portability of tables." (const :tag "Stick to hline" nil) (const :tag "Error on attempt to cross" error))) +(defcustom org-table-formula-create-columns nil + "Non-nil means that evaluation of a field formula can add new +columns if an out-of-bounds field is being set." + :group 'org-table-calculation + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Setting an out-of-bounds field generates an error (default)" nil) + (const :tag "Setting an out-of-bounds field silently adds columns as needed" t) + (const :tag "Setting an out-of-bounds field adds columns as needed, but issues a warning message" warn) + (const :tag "When setting an out-of-bounds field, the user is prompted" prompt))) + (defgroup org-table-import-export nil - "Options concerning table import and export in Org-mode." + "Options concerning table import and export in Org mode." :tag "Org Table Import Export" :group 'org-table) @@ -359,38 +400,73 @@ available parameters." :group 'org-table-import-export :type 'string) +(defcustom org-table-convert-region-max-lines 999 + "Max lines that `org-table-convert-region' will attempt to process. + +The function can be slow on larger regions; this safety feature +prevents it from hanging emacs." + :group 'org-table-import-export + :type 'integer + :version "26.1" + :package-version '(Org . "8.3")) + (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") + "Regexp matching a line marked for automatic recalculation.") + (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") + "Regexp matching a line marked for recalculation.") + (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") + "Regexp matching a line marked for calculation.") + (defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line outside the table.") + "Regexp matching any line outside an Org table.") + (defvar org-table-last-highlighted-reference nil) + (defvar org-table-formula-history nil) (defvar org-table-column-names nil - "Alist with column names, derived from the `!' line.") + "Alist with column names, derived from the `!' line. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-column-name-regexp nil - "Regular expression matching the current column names.") + "Regular expression matching the current column names. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-local-parameters nil - "Alist with parameter names, derived from the `$' line.") + "Alist with parameter names, derived from the `$' line. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-named-field-locations nil - "Alist with locations of named fields.") + "Alist with locations of named fields. +Associations follow the pattern (NAME LINE COLUMN) where + NAME is the name of the field as a string, + LINE is the number of lines from the beginning of the table, + COLUMN is the column of the field, as an integer. +This variable is initialized with `org-table-analyze'.") (defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a command.") -(defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a command.") + "Table row types in current table. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a command.") + "Current table begin position, as a marker. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-current-ncol nil - "Number of columns in table, non-nil only for the duration of a command.") + "Number of columns in current table. +This variable is initialized with `org-table-analyze'.") + (defvar org-table-dlines nil - "Vector of data line line numbers in the current table.") + "Vector of data line line numbers in the current table. +Line numbers are counted from the beginning of the table. This +variable is initialized with `org-table-analyze'.") + (defvar org-table-hlines nil - "Vector of hline line numbers in the current table.") + "Vector of hline line numbers in the current table. +Line numbers are counted from the beginning of the table. This +variable is initialized with `org-table-analyze'.") (defconst org-table-range-regexp "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" @@ -404,85 +480,33 @@ available parameters." "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") "Match a range for reference display.") -(defun org-table-colgroup-line-p (line) - "Is this a table line colgroup information?" - (save-match-data - (and (string-match "[<>]\\|&[lg]t;" line) - (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" - line) - (not (delq - nil - (mapcar - (lambda (s) - (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) - (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) - -(defun org-table-cookie-line-p (line) - "Is this a table line with only alignment/width cookies?" - (save-match-data - (and (string-match "[<>]\\|&[lg]t;" line) - (or (string-match - "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line) - (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line)) - (not (delq nil (mapcar - (lambda (s) - (not (or (equal s "") - (string-match - "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s) - (string-match - "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" - s)))) - (org-split-string (match-string 1 line) - "[ \t]*|[ \t]*"))))))) - -(defvar org-table-clean-did-remove-column nil) ; dynamically scoped -(defun org-table-clean-before-export (lines &optional maybe-quoted) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (let ((special (if maybe-quoted - "^[ \t]*| *\\\\?[#!$*_^/ ] *|" - "^[ \t]*| *[#!$*_^/ ] *|")) - (ignore (if maybe-quoted - "^[ \t]*| *\\\\?[!$_^/] *|" - "^[ \t]*| *[!$_^/] *|"))) - (setq org-table-clean-did-remove-column - (not (memq nil - (mapcar - (lambda (line) - (or (string-match org-table-hline-regexp line) - (string-match special line))) - lines)))) - (delq nil - (mapcar - (lambda (line) - (cond - ((or (org-table-colgroup-line-p line) ;; colgroup info - (org-table-cookie-line-p line) ;; formatting cookies - (and org-table-clean-did-remove-column - (string-match ignore line))) ;; non-exportable data - nil) - ((and org-table-clean-did-remove-column - (or (string-match "^\\([ \t]*\\)|-+\\+" line) - (string-match "^\\([ \t]*\\)|[^|]*|" line))) - ;; remove the first column - (replace-match "\\1|" t nil line)) - (t line))) - lines)))) - (defconst org-table-translate-regexp (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") "Match a reference that needs translation, for reference display.") +(defmacro org-table-save-field (&rest body) + "Save current field; execute BODY; restore field. +Field is restored even in case of abnormal exit." + (declare (debug (body))) + (org-with-gensyms (line column) + `(let ((,line (copy-marker (line-beginning-position))) + (,column (org-table-current-column))) + (unwind-protect + (progn ,@body) + (goto-char ,line) + (org-table-goto-column ,column) + (set-marker ,line nil))))) + ;;;###autoload (defun org-table-create-with-table.el () "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables +If there is already a table at point, convert between Org tables and table.el tables." (interactive) (require 'table) (cond ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") + (if (y-or-n-p "Convert table to Org table? ") (org-table-convert))) ((org-at-table-p) (when (y-or-n-p "Convert table to table.el table? ") @@ -526,7 +550,7 @@ SIZE is a string Columns x Rows like for example \"3x2\"." (beginning-of-line 1) (newline)) ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) + (dotimes (_ rows) (insert line)) (goto-char pos) (if (> rows 1) ;; Insert a hline after the first row. @@ -539,15 +563,18 @@ SIZE is a string Columns x Rows like for example \"3x2\"." ;;;###autoload (defun org-table-convert-region (beg0 end0 &optional separator) "Convert region to a table. + The region goes from BEG0 to END0, but these borders will be moved slightly, to make sure a beginning of line in the first line is included. SEPARATOR specifies the field separator in the lines. It can have the following values: -(4) Use the comma as a field separator -(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator +(4) Use the comma as a field separator +(16) Use a TAB as field separator +(64) Prompt for a regular expression as field separator +integer When a number, use that many spaces, or a TAB, as field separator +regexp When a regular expression, use it to match the separator nil When nil, the command tries to be smart and figure out the separator in the following way: - when each line contains a TAB, assume TAB-separated material @@ -557,45 +584,52 @@ nil When nil, the command tries to be smart and figure out the (let* ((beg (min beg0 end0)) (end (max beg0 end0)) re) - (goto-char beg) - (beginning-of-line 1) - (setq beg (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - ;; Get the right field separator - (unless separator + (if (> (count-lines beg end) org-table-convert-region-max-lines) + (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting" + org-table-convert-region-max-lines) + (if (equal separator '(64)) + (setq separator (read-regexp "Regexp for field separator"))) (goto-char beg) - (setq separator + (beginning-of-line 1) + (setq beg (point-marker)) + (goto-char end) + (if (bolp) (backward-char 1) (end-of-line 1)) + (setq end (point-marker)) + ;; Get the right field separator + (unless separator + (goto-char beg) + (setq separator + (cond + ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) + ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + (t 1)))) + (goto-char beg) + (if (equal separator '(4)) + (while (< (point) end) + ;; parse the csv stuff (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (goto-char beg) - (if (equal separator '(4)) - (while (< (point) end) - ;; parse the csv stuff - (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") - (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Number of spaces in separator must be >= 1") - (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) - (t (error "This should not happen")))) - (while (re-search-forward re end t) - (replace-match "| " t t))) - (goto-char beg) - (org-table-align))) + ((looking-at "^") (insert "| ")) + ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") + (replace-match "\\1") + (if (looking-at "\"") (insert "\""))) + ((looking-at "[^,\n]+") (goto-char (match-end 0))) + ((looking-at "[ \t]*,") (replace-match " | ")) + (t (beginning-of-line 2)))) + (setq re (cond + ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") + ((equal separator '(16)) "^\\|\t") + ((integerp separator) + (if (< separator 1) + (user-error "Number of spaces in separator must be >= 1") + (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) + ((stringp separator) + (format "^ *\\|%s" separator)) + (t (error "This should not happen")))) + (while (re-search-forward re end t) + (replace-match "| " t t))) + (goto-char beg) + (org-table-align)))) ;;;###autoload (defun org-table-import (file arg) @@ -611,8 +645,6 @@ are found, lines will be split on whitespace into fields." (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) -(defvar org-table-last-alignment) -(defvar org-table-last-column-widths) ;;;###autoload (defun org-table-export (&optional file format) "Export table to a file, with configurable format. @@ -630,77 +662,61 @@ extension of the given file name, and finally on the variable `org-table-export-default-format'." (interactive) (unless (org-at-table-p) (user-error "No table at point")) - (org-table-align) ;; make sure we have everything we need - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (txt (buffer-substring-no-properties beg end)) - (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) - (formats '("orgtbl-to-tsv" "orgtbl-to-csv" - "orgtbl-to-latex" "orgtbl-to-html" - "orgtbl-to-generic" "orgtbl-to-texinfo" - "orgtbl-to-orgtbl")) - (format (or format - (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) - buf deffmt-readable fileext) + (org-table-align) ; Make sure we have everything we need. + (let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t)))) (unless file (setq file (read-file-name "Export table to: ")) (unless (or (not (file-exists-p file)) (y-or-n-p (format "Overwrite file %s? " file))) (user-error "File not written"))) - (if (file-directory-p file) - (user-error "This is a directory path, not a file")) - (if (and (buffer-file-name) - (equal (file-truename file) - (file-truename (buffer-file-name)))) - (user-error "Please specify a file name that is different from current")) - (setq fileext (concat (file-name-extension file) "$")) - (unless format - (setq deffmt-readable - (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats))) - org-table-export-default-format)) - (while (string-match "\t" deffmt-readable) - (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) - (while (string-match "\n" deffmt-readable) - (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) - (setq format (org-completing-read "Format: " formats nil nil deffmt-readable))) - (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) - (let* ((transform (intern (match-string 1 format))) - (params (if (match-end 2) - (read (concat "(" (match-string 2 format) ")")))) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) - (lines (org-table-clean-before-export lines)) - (i0 (if org-table-clean-did-remove-column 2 1)) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0))) - - (unless (fboundp transform) - (user-error "No such transformation function %s" transform)) - (setq txt (funcall transform table params)) - - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert txt "\n") - (save-buffer)) - (kill-buffer buf) - (message "Export done.")) - (user-error "TABLE_EXPORT_FORMAT invalid")))) + (when (file-directory-p file) + (user-error "This is a directory path, not a file")) + (when (and (buffer-file-name (buffer-base-buffer)) + (file-equal-p + (file-truename file) + (file-truename (buffer-file-name (buffer-base-buffer))))) + (user-error "Please specify a file name that is different from current")) + (let ((fileext (concat (file-name-extension file) "$")) + (format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t)))) + (unless format + (let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex" + "orgtbl-to-html" "orgtbl-to-generic" + "orgtbl-to-texinfo" "orgtbl-to-orgtbl" + "orgtbl-to-unicode")) + (deffmt-readable + (replace-regexp-in-string + "\t" "\\t" + (replace-regexp-in-string + "\n" "\\n" + (or (car (delq nil + (mapcar + (lambda (f) + (and (string-match-p fileext f) f)) + formats))) + org-table-export-default-format) + t t) t t))) + (setq format + (org-completing-read + "Format: " formats nil nil deffmt-readable)))) + (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) + (let ((transform (intern (match-string 1 format))) + (params (and (match-end 2) + (read (concat "(" (match-string 2 format) ")")))) + (table (org-table-to-lisp + (buffer-substring-no-properties + (org-table-begin) (org-table-end))))) + (unless (fboundp transform) + (user-error "No such transformation function %s" transform)) + (let (buf) + (with-current-buffer (find-file-noselect file) + (setq buf (current-buffer)) + (erase-buffer) + (fundamental-mode) + (insert (funcall transform table params) "\n") + (save-buffer)) + (kill-buffer buf)) + (message "Export done.")) + (user-error "TABLE_EXPORT_FORMAT invalid"))))) (defvar org-table-aligned-begin-marker (make-marker) "Marker at the beginning of the table last aligned. @@ -714,13 +730,11 @@ This is being used to correctly align a single field after TAB or RET.") (defvar org-table-last-column-widths nil "List of max width of fields in each column. This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-formula-debug nil +(defvar-local org-table-formula-debug nil "Non-nil means debug table formulas. When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) -(defvar org-table-overlay-coordinates nil +(defvar-local org-table-overlay-coordinates nil "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) (defvar org-last-recalc-line nil) (defvar org-table-do-narrow t) ; for dynamic scoping @@ -731,216 +745,198 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (defun org-table-align () "Align the table at point by aligning all vertical bars." (interactive) - (let* ( - ;; Limits of table - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (org-table-current-column)) - (winstart (window-start)) - (winstartline (org-current-line (min winstart (1- (point-max))))) - lines (new "") lengths l typenums ty fields maxfields i - column - (indent "") cnt frac - rfmt hfmt - (spaces '(1 . 1)) - (sp1 (car spaces)) - (sp2 (cdr spaces)) - (rfmt1 (concat - (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) - (hfmt1 (concat - (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph raise narrow - falign falign1 fmax f1 len c e space) - (untabify beg end) - (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) - ;; Check if we have links or dates - (goto-char beg) - (setq links (re-search-forward org-bracket-link-regexp end t)) - (goto-char beg) - (setq emph (and org-hide-emphasis-markers - (re-search-forward org-emph-re end t))) - (goto-char beg) - (setq raise (and org-use-sub-superscripts - (re-search-forward org-match-substring-regexp end t))) - (goto-char beg) - (setq dates (and org-display-custom-times - (re-search-forward org-ts-regexp-both end t))) - ;; Make sure the link properties are right - (when links (goto-char beg) (while (org-activate-bracket-links end))) - ;; Make sure the date properties are right - (when dates (goto-char beg) (while (org-activate-dates end))) - (when emph (goto-char beg) (while (org-do-emphasis-faces end))) - (when raise (goto-char beg) (while (org-raise-scripts end))) - - ;; Check if we are narrowing any columns - (goto-char beg) - (setq narrow (and org-table-do-narrow - org-format-transports-properties-p - (re-search-forward "<[lrc]?[0-9]+>" end t))) - (goto-char beg) - (setq falign (re-search-forward "<[lrc][0-9]*>" end t)) - (goto-char beg) - ;; Get the rows - (setq lines (org-split-string - (buffer-substring beg end) "\n")) - ;; Store the indentation of the first line - (if (string-match "^ *" (car lines)) - (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - ;; Mark the hlines by setting the corresponding element to nil - ;; At the same time, we remove trailing space. - (setq lines (mapcar (lambda (l) - (if (string-match "^ *|-" l) - nil - (if (string-match "[ \t]+$" l) - (substring l 0 (match-beginning 0)) - l))) - lines)) - ;; Get the data fields by splitting the lines. - (setq fields (mapcar - (lambda (l) - (org-split-string l " *| *")) - (delq nil (copy-sequence lines)))) - ;; How many fields in the longest line? - (condition-case nil - (setq maxfields (apply 'max (mapcar 'length fields))) - (error - (kill-region beg end) - (org-table-create org-table-default-size) - (user-error "Empty table - created default table"))) - ;; A list of empty strings to fill any short rows on output - (setq emptystrings (make-list maxfields "")) - ;; Check for special formatting. - (setq i -1) - (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns - (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) - ;; Check if there is an explicit width specified - (setq fmax nil) - (when (or narrow falign) - (setq c column fmax nil falign1 nil) - (while c - (setq e (pop c)) - (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e)) - (if (match-end 1) (setq falign1 (match-string 1 e))) - (if (and org-table-do-narrow (match-end 2)) - (setq fmax (string-to-number (match-string 2 e)) c nil)))) - ;; Find fields that are wider than fmax, and shorten them - (when fmax - (loop for xx in column do - (when (and (stringp xx) - (> (org-string-width xx) fmax)) - (org-add-props xx nil - 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) - (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) - (unless (> f1 1) - (user-error "Cannot narrow field starting with wide link \"%s\"" - (match-string 0 xx))) - (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) - (add-text-properties (- f1 2) f1 - (list 'display org-narrow-column-arrow) - xx))))) - ;; Get the maximum width for each column - (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column)) - lengths) - ;; Get the fraction of numbers, to decide about alignment of the column - (if falign1 - (push (equal (downcase falign1) "r") typenums) - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums))) - (setq lengths (nreverse lengths) typenums (nreverse typenums)) - - ;; Store the alignment of this table, for later editing of single fields - (setq org-table-last-alignment typenums - org-table-last-column-widths lengths) - - ;; With invisible characters, `format' does not get the field width right - ;; So we need to make these fields wide by hand. - (when (or links emph raise) - (loop for i from 0 upto (1- maxfields) do - (setq len (nth i lengths)) - (loop for j from 0 upto (1- (length fields)) do - (setq c (nthcdr i (car (nthcdr j fields)))) - (if (and (stringp (car c)) - (or (text-property-any 0 (length (car c)) - 'invisible 'org-link (car c)) - (text-property-any 0 (length (car c)) - 'org-dwidth t (car c))) - (< (org-string-width (car c)) len)) - (progn - (setq space (make-string (- len (org-string-width (car c))) ?\ )) - (setcar c (if (nth i typenums) - (concat space (car c)) - (concat (car c) space)))))))) - - ;; Compute the formats needed for output of the table - (setq rfmt (concat indent "|") hfmt (concat indent "|")) - (while (setq l (pop lengths)) - (setq ty (if (pop typenums) "" "-")) ; number types flushright - (setq rfmt (concat rfmt (format rfmt1 ty l)) - hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) - (setq rfmt (concat rfmt "\n") - hfmt (concat (substring hfmt 0 -1) "|\n")) - - (setq new (mapconcat - (lambda (l) - (if l (apply 'format rfmt - (append (pop fields) emptystrings)) - hfmt)) - lines "")) - (move-marker org-table-aligned-begin-marker (point)) - (insert new) - ;; Replace the old one - (delete-region (point) end) - (move-marker end nil) - (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) - (goto-char org-table-aligned-begin-marker) - (while (org-hide-wide-columns org-table-aligned-end-marker))) - ;; Try to move to the old location - (org-goto-line winstartline) - (setq winstart (point-at-bol)) - (org-goto-line linepos) - (when (eq (window-buffer (selected-window)) (current-buffer)) - (set-window-start (selected-window) winstart 'noforce)) - (org-table-goto-column colpos) - (and org-table-overlay-coordinates (org-table-overlay-coordinates)) - (setq org-table-may-need-update nil) - )) + (let* ((beg (org-table-begin)) + (end (copy-marker (org-table-end)))) + (org-table-save-field + ;; Make sure invisible characters in the table are at the right + ;; place since column widths take them into account. + (font-lock-fontify-region beg end) + (move-marker org-table-aligned-begin-marker beg) + (move-marker org-table-aligned-end-marker end) + (goto-char beg) + (let* ((indent (progn (looking-at "[ \t]*") (match-string 0))) + ;; Table's rows. Separators are replaced by nil. Trailing + ;; spaces are also removed. + (lines (mapcar (lambda (l) + (and (not (string-match-p "\\`[ \t]*|-" l)) + (let ((l (org-trim l))) + (remove-text-properties + 0 (length l) '(display t org-cwidth t) l) + l))) + (org-split-string (buffer-substring beg end) "\n"))) + ;; Get the data fields by splitting the lines. + (fields (mapcar (lambda (l) (org-split-string l " *| *")) + (remq nil lines))) + ;; Compute number of fields in the longest line. If the + ;; table contains no field, create a default table. + (maxfields (if fields (apply #'max (mapcar #'length fields)) + (kill-region beg end) + (org-table-create org-table-default-size) + (user-error "Empty table - created default table"))) + ;; A list of empty strings to fill any short rows on output. + (emptycells (make-list maxfields "")) + lengths typenums) + ;; Check for special formatting. + (dotimes (i maxfields) + (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields)) + fmax falign) + ;; Look for an explicit width or alignment. + (when (save-excursion + (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t) + (and org-table-do-narrow + (re-search-forward + "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t)))) + (catch :exit + (dolist (cell column) + (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell) + (when (match-end 1) (setq falign (match-string 1 cell))) + (when (and org-table-do-narrow (match-end 2)) + (setq fmax (string-to-number (match-string 2 cell)))) + (when (or falign fmax) (throw :exit nil))))) + ;; Find fields that are wider than FMAX, and shorten them. + (when fmax + (dolist (x column) + (when (> (org-string-width x) fmax) + (org-add-props x nil + 'help-echo + (concat + "Clipped table field, use `\\[org-table-edit-field]' to \ +edit. Full value is:\n" + (substring-no-properties x))) + (let ((l (length x)) + (f1 (min fmax + (or (string-match org-bracket-link-regexp x) + fmax))) + (f2 1)) + (unless (> f1 1) + (user-error + "Cannot narrow field starting with wide link \"%s\"" + (match-string 0 x))) + (if (= (org-string-width x) l) (setq f2 f1) + (setq f2 1) + (while (< (org-string-width (substring x 0 f2)) f1) + (cl-incf f2))) + (add-text-properties f2 l (list 'org-cwidth t) x) + (add-text-properties + (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2) + (- f2 2)) + f2 + (list 'display org-narrow-column-arrow) + x)))))) + ;; Get the maximum width for each column + (push (apply #'max (or fmax 1) 1 (mapcar #'org-string-width column)) + lengths) + ;; Get the fraction of numbers among non-empty cells to + ;; decide about alignment of the column. + (if falign (push (equal (downcase falign) "r") typenums) + (let ((cnt 0) + (frac 0.0)) + (dolist (x column) + (unless (equal x "") + (setq frac + (/ (+ (* frac cnt) + (if (string-match-p org-table-number-regexp x) + 1 + 0)) + (cl-incf cnt))))) + (push (>= frac org-table-number-fraction) typenums))))) + (setq lengths (nreverse lengths)) + (setq typenums (nreverse typenums)) + ;; Store alignment of this table, for later editing of single + ;; fields. + (setq org-table-last-alignment typenums) + (setq org-table-last-column-widths lengths) + ;; With invisible characters, `format' does not get the field + ;; width right So we need to make these fields wide by hand. + ;; Invisible characters may be introduced by fontified links, + ;; emphasis, macros or sub/superscripts. + (when (or (text-property-any beg end 'invisible 'org-link) + (text-property-any beg end 'invisible t)) + (dotimes (i maxfields) + (let ((len (nth i lengths))) + (dotimes (j (length fields)) + (let* ((c (nthcdr i (nth j fields))) + (cell (car c))) + (when (and + (stringp cell) + (let ((l (length cell))) + (or (text-property-any 0 l 'invisible 'org-link cell) + (text-property-any beg end 'invisible t))) + (< (org-string-width cell) len)) + (let ((s (make-string (- len (org-string-width cell)) ?\s))) + (setcar c (if (nth i typenums) (concat s cell) + (concat cell s)))))))))) + + ;; Compute the formats needed for output of the table. + (let ((hfmt (concat indent "|")) + (rfmt (concat indent "|")) + (rfmt1 " %%%s%ds |") + (hfmt1 "-%s-+")) + (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|"))) + (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right. + (setq rfmt (concat rfmt (format rfmt1 ty l))) + (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))) + ;; Replace modified lines only. Check not only contents, but + ;; also columns' width. + (dolist (l lines) + (let ((line + (if l (apply #'format rfmt (append (pop fields) emptycells)) + hfmt)) + (previous (buffer-substring (point) (line-end-position)))) + (if (and (equal previous line) + (let ((a 0) + (b 0)) + (while (and (progn + (setq a (next-single-property-change + a 'org-cwidth previous)) + (setq b (next-single-property-change + b 'org-cwidth line))) + (eq a b))) + (eq a b))) + (forward-line) + (insert line "\n") + (delete-region (point) (line-beginning-position 2)))))) + (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) + (goto-char org-table-aligned-begin-marker) + (while (org-hide-wide-columns org-table-aligned-end-marker))) + (set-marker end nil) + (when org-table-overlay-coordinates (org-table-overlay-coordinates)) + (setq org-table-may-need-update nil))))) ;;;###autoload (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table." - (save-excursion - (if (not (re-search-backward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (progn (goto-char (point-min)) (point)) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (point)))) +With a non-nil optional argument TABLE-TYPE, return the beginning +of a table.el-type table. This function assumes point is on +a table." + (cond (table-type + (org-element-property :post-affiliated (org-element-at-point))) + ((save-excursion + (and (re-search-backward org-table-border-regexp nil t) + (line-beginning-position 2)))) + (t (point-min)))) ;;;###autoload (defun org-table-end (&optional table-type) "Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table." +With a non-nil optional argument TABLE-TYPE, return the end of +a table.el-type table. This function assumes point is on +a table." (save-excursion - (if (not (re-search-forward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (goto-char (point-max)) - (goto-char (match-beginning 0))) - (point-marker))) + (cond (table-type + (goto-char (org-element-property :end (org-element-at-point))) + (skip-chars-backward " \t\n") + (line-beginning-position 2)) + ((re-search-forward org-table-border-regexp nil t) + (match-beginning 0)) + ;; When the line right after the table is the last line in + ;; the buffer with trailing spaces but no final newline + ;; character, be sure to catch the correct ending at its + ;; beginning. In any other case, ending is expected to be + ;; at point max. + (t (goto-char (point-max)) + (skip-chars-backward " \t") + (if (bolp) (point) (line-end-position)))))) ;;;###autoload (defun org-table-justify-field-maybe (&optional new) @@ -950,38 +946,40 @@ Optional argument NEW may specify text to replace the current field content." ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway ((org-at-table-hline-p)) ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) + (or (not (eq (marker-buffer org-table-aligned-begin-marker) + (current-buffer))) (< (point) org-table-aligned-begin-marker) (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align + ;; This is not the same table, force a full re-align. (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) + (t + ;; Realign the current field, based on previous full realign. + (let ((pos (point)) + (col (org-table-current-column))) (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 (- (match-end 0) (match-beginning 0) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (if (equal (string-to-char n) ?-) (setq n (concat " " n))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) + (skip-chars-backward "^|") + (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")) + (setq org-table-may-need-update t) + (let* ((numbers? (nth (1- col) org-table-last-alignment)) + (cell (match-string 0)) + (field (match-string 1)) + (len (max 1 (- (org-string-width cell) 3))) + (properly-closed? (/= (match-beginning 2) (match-end 2))) + (fmt (format (if numbers? " %%%ds %s" " %%-%ds %s") + len + (if properly-closed? "|" + (setq org-table-may-need-update t) + ""))) + (new-cell + (cond ((not new) (format fmt field)) + ((<= (org-string-width new) len) (format fmt new)) + (t + (setq org-table-may-need-update t) + (format " %s |" new))))) + (unless (equal new-cell cell) + (let (org-table-may-need-update) + (replace-match new-cell t t))) + (goto-char pos)))))))) ;;;###autoload (defun org-table-next-field () @@ -1036,9 +1034,10 @@ Before doing so, re-align the table if necessary." (goto-char (match-end 0)))) (defun org-table-beginning-of-field (&optional n) - "Move to the end of the current table field. -If already at or after the end, move to the end of the next table field. -With numeric argument N, move N-1 fields forward first." + "Move to the beginning of the current table field. +If already at or before the beginning, move to the beginning of the +previous field. +With numeric argument N, move N-1 fields backward first." (interactive "p") (let ((pos (point))) (while (> n 1) @@ -1051,10 +1050,9 @@ With numeric argument N, move N-1 fields forward first." (if (>= (point) pos) (org-table-beginning-of-field 2)))) (defun org-table-end-of-field (&optional n) - "Move to the beginning of the current table field. -If already at or before the beginning, move to the beginning of the -previous field. -With numeric argument N, move N-1 fields backward first." + "Move to the end of the current table field. +If already at or after the end, move to the end of the next table field. +With numeric argument N, move N-1 fields forward first." (interactive "p") (let ((pos (point))) (while (> n 1) @@ -1093,30 +1091,36 @@ Before doing so, re-align the table if necessary." ;;;###autoload (defun org-table-copy-down (n) - "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of -the nearest non-empty field above. With argument N, use the Nth -non-empty field. If the current field is not empty, it is copied -down to the next row, and the cursor is moved with it. -Therefore, repeating this command causes the column to be filled -row-by-row. + "Copy the value of the current field one row below. + +If the field at the cursor is empty, copy the content of the +nearest non-empty field above. With argument N, use the Nth +non-empty field. + +If the current field is not empty, it is copied down to the next +row, and the cursor is moved with it. Therefore, repeating this +command causes the column to be filled row-by-row. + If the variable `org-table-copy-increment' is non-nil and the field is an integer or a timestamp, it will be incremented while -copying. In the case of a timestamp, increment by one day." +copying. By default, increment by the difference between the +value in the current field and the one in the field above. To +increment using a fixed integer, set `org-table-copy-increment' +to a number. In the case of a timestamp, increment by days." (interactive "p") (let* ((colpos (org-table-current-column)) (col (current-column)) (field (save-excursion (org-table-get-field))) + (field-up (or (save-excursion + (org-table-get (1- (org-table-current-line)) + (org-table-current-column))) "")) (non-empty (string-match "[^ \t]" field)) + (non-empty-up (string-match "[^ \t]" field-up)) (beg (org-table-begin)) (orig-n n) - txt) + txt txt-up inc) (org-table-check-inside-data-field) - (if non-empty - (progn - (setq txt (org-trim field)) - (org-table-next-row) - (org-table-blank-field)) + (if (not non-empty) (save-excursion (setq txt (catch 'exit @@ -1127,35 +1131,60 @@ copying. In the case of a timestamp, increment by one day." (if (and (looking-at "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") (<= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))))) - (if txt - (progn - (if (and org-table-copy-increment - (not (equal orig-n 0)) - (string-match "^[0-9]+$" txt) - (< (string-to-number txt) 100000000)) - (setq txt (format "%d" (+ (string-to-number txt) 1)))) - (insert txt) - (org-move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up-day) - (org-table-maybe-recalculate-line)) - (org-table-align) - (org-move-to-column col)) - (user-error "No non-empty field found")))) + (throw 'exit (match-string 1)))))) + (setq field-up + (catch 'exit + (while (progn (beginning-of-line 1) + (re-search-backward org-table-dataline-regexp + beg t)) + (org-table-goto-column colpos t) + (if (and (looking-at + "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") + (<= (setq n (1- n)) 0)) + (throw 'exit (match-string 1)))))) + (setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) + ;; Above field was not empty, go down to the next row + (setq txt (org-trim field)) + (org-table-next-row) + (org-table-blank-field)) + (if non-empty-up (setq txt-up (org-trim field-up))) + (setq inc (cond + ((numberp org-table-copy-increment) org-table-copy-increment) + (txt-up (cond ((and (string-match org-ts-regexp3 txt-up) + (string-match org-ts-regexp3 txt)) + (- (org-time-string-to-absolute txt) + (org-time-string-to-absolute txt-up))) + ((string-match org-ts-regexp3 txt) 1) + ((string-match "\\([-+]\\)?[0-9]+\\(?:\.[0-9]+\\)?" txt-up) + (- (string-to-number txt) + (string-to-number (match-string 0 txt-up)))) + (t 1))) + (t 1))) + (if (not txt) + (user-error "No non-empty field found") + (if (and org-table-copy-increment + (not (equal orig-n 0)) + (string-match-p "^[-+^/*0-9eE.]+$" txt) + (< (string-to-number txt) 100000000)) + (setq txt (calc-eval (concat txt "+" (number-to-string inc))))) + (insert txt) + (org-move-to-column col) + (if (and org-table-copy-increment (org-at-timestamp-p t)) + (org-timestamp-up-day inc) + (org-table-maybe-recalculate-line)) + (org-table-align) + (org-move-to-column col)))) (defun org-table-check-inside-data-field (&optional noerror) "Is point inside a table data field? I.e. not on a hline or before the first or after the last column? This actually throws an error, so it aborts the current command." - (if (or (not (org-at-table-p)) - (= (org-table-current-column) 0) - (org-at-table-hline-p) - (looking-at "[ \t]*$")) - (if noerror - nil - (user-error "Not in table data field")) - t)) + (cond ((and (org-at-table-p) + (not (save-excursion (skip-chars-backward " \t") (bolp))) + (not (org-at-table-hline-p)) + (not (looking-at "[ \t]*$")))) + (noerror nil) + (t (user-error "Not in table data field")))) (defvar org-table-clip nil "Clipboard for table regions.") @@ -1166,7 +1195,7 @@ If LINE is larger than the number of data lines in the table, the function returns nil. However, if COLUMN is too large, we will simply return an empty string. If LINE is nil, use the current line. -If column is nil, use the current column." +If COLUMN is nil, use the current column." (setq column (or column (org-table-current-column))) (save-excursion (and (or (not line) (org-table-goto-line line)) @@ -1206,7 +1235,7 @@ Return t when the line exists, nil if it does not exist." "Blank the current table field or active region." (interactive) (org-table-check-inside-data-field) - (if (and (org-called-interactively-p 'any) (org-region-active-p)) + (if (and (called-interactively-p 'any) (org-region-active-p)) (let (org-table-clip) (org-table-cut-region (region-beginning) (region-end))) (skip-chars-backward "^|") @@ -1221,52 +1250,53 @@ Return t when the line exists, nil if it does not exist." (defun org-table-get-field (&optional n replace) "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) +N defaults to current column. If REPLACE is a string, replace +field with this value. The return value is always the old +value." + (when n (org-table-goto-column n)) (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" (if (equal replace "") " " replace)) - t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) + (if (or (bolp) (looking-at-p "[ \t]*$")) + ;; Before first column or after last one. + "" + (looking-at "[^|\r\n]*") + (let* ((pos (match-beginning 0)) + (val (buffer-substring pos (match-end 0)))) + (when replace + (replace-match (if (equal replace "") " " replace) t t)) + (goto-char (min (line-end-position) (1+ pos))) + val))) ;;;###autoload -(defun org-table-field-info (arg) +(defun org-table-field-info (_arg) "Show info about the current field, and highlight any reference at point." (interactive "P") (unless (org-at-table-p) (user-error "Not at a table")) - (org-table-get-specials) + (org-table-analyze) (save-excursion (let* ((pos (point)) (col (org-table-current-column)) (cname (car (rassoc (int-to-string col) org-table-column-names))) - (name (car (rassoc (list (org-current-line) col) + (name (car (rassoc (list (count-lines org-table-current-begin-pos + (line-beginning-position)) + col) org-table-named-field-locations))) (eql (org-table-expand-lhs-ranges (mapcar (lambda (e) - (cons (org-table-formula-handle-first/last-rc - (car e)) (cdr e))) + (cons (org-table-formula-handle-first/last-rc (car e)) + (cdr e))) (org-table-get-stored-formulas)))) (dline (org-table-current-dline)) (ref (format "@%d$%d" dline col)) (ref1 (org-table-convert-refs-to-an ref)) + ;; Prioritize field formulas over column formulas. (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) + (cequation (assoc (format "$%d" col) eql)) (eqn (or fequation cequation))) - (if (and eqn (get-text-property 0 :orig-eqn (car eqn))) - (setq eqn (get-text-property 0 :orig-eqn (car eqn)))) + (let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn))))) + (when p (setq eqn p))) (goto-char pos) - (condition-case nil - (org-table-show-reference 'local) - (error nil)) + (ignore-errors (org-table-show-reference 'local)) (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" dline col (if cname (concat " or $" cname) "") @@ -1277,39 +1307,42 @@ is always the old value." (concat ", formula: " (org-table-formula-to-user (concat - (if (string-match "^[$@]"(car eqn)) "" "$") + (if (or (string-prefix-p "$" (car eqn)) + (string-prefix-p "@" (car eqn))) + "" + "$") (car eqn) "=" (cdr eqn)))) ""))))) (defun org-table-current-column () "Find out which column we are in." (interactive) - (if (org-called-interactively-p 'any) (org-table-check-inside-data-field)) + (when (called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion - (let ((cnt 0) (pos (point))) - (beginning-of-line 1) - (while (search-forward "|" pos t) - (setq cnt (1+ cnt))) - (when (org-called-interactively-p 'interactive) - (message "In table column %d" cnt)) - cnt))) + (let ((column 0) (pos (point))) + (beginning-of-line) + (while (search-forward "|" pos t) (cl-incf column)) + (when (called-interactively-p 'interactive) + (message "In table column %d" column)) + column))) ;;;###autoload (defun org-table-current-dline () "Find out what table data line we are in. Only data lines count for this." (interactive) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (org-table-check-inside-data-field)) (save-excursion - (let ((cnt 0) (pos (point))) + (let ((c 0) + (pos (point))) (goto-char (org-table-begin)) (while (<= (point) pos) - (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) - (beginning-of-line 2)) - (when (org-called-interactively-p 'any) - (message "This is table line %d" cnt)) - cnt))) + (when (looking-at org-table-dataline-regexp) (cl-incf c)) + (forward-line)) + (when (called-interactively-p 'any) + (message "This is table line %d" c)) + c))) ;;;###autoload (defun org-table-goto-column (n &optional on-delim force) @@ -1338,25 +1371,19 @@ However, when FORCE is non-nil, create new columns if necessary." (defun org-table-insert-column () "Insert a new column into the table." (interactive) - (if (not (org-at-table-p)) - (user-error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-find-dataline) (let* ((col (max 1 (org-table-current-column))) (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (insert "| ")) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) - (org-table-goto-column colpos) + (end (copy-marker (org-table-end)))) + (org-table-save-field + (goto-char beg) + (while (< (point) end) + (unless (org-at-table-hline-p) + (org-table-goto-column col t) + (insert "| ")) + (forward-line))) + (set-marker end nil) (org-table-align) (when (or (not org-table-fix-formulas-confirm) (funcall org-table-fix-formulas-confirm "Fix formulas? ")) @@ -1384,58 +1411,55 @@ However, when FORCE is non-nil, create new columns if necessary." (defun org-table-line-to-dline (line &optional above) "Turn a buffer line number into a data line number. + If there is no data line in this line, return nil. -If there is no matching dline (most likely te reference was a hline), the -first dline below it is used. When ABOVE is non-nil, the one above is used." - (catch 'exit - (let ((ll (length org-table-dlines)) - i) - (if above - (progn - (setq i (1- ll)) - (while (> i 0) - (if (<= (aref org-table-dlines i) line) - (throw 'exit i)) - (setq i (1- i)))) - (setq i 1) - (while (< i ll) - (if (>= (aref org-table-dlines i) line) - (throw 'exit i)) - (setq i (1+ i))))) - nil)) + +If there is no matching dline (most likely the reference was +a hline), the first dline below it is used. When ABOVE is +non-nil, the one above is used." + (let ((min 1) + (max (1- (length org-table-dlines)))) + (cond ((or (> (aref org-table-dlines min) line) + (< (aref org-table-dlines max) line)) + nil) + ((= (aref org-table-dlines max) line) max) + (t (catch 'exit + (while (> (- max min) 1) + (let* ((mean (/ (+ max min) 2)) + (v (aref org-table-dlines mean))) + (cond ((= v line) (throw 'exit mean)) + ((> v line) (setq max mean)) + (t (setq min mean))))) + (if above min max)))))) ;;;###autoload (defun org-table-delete-column () "Delete a column from the table." (interactive) - (if (not (org-at-table-p)) - (user-error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|"))) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) - (org-table-goto-column colpos) + (let ((col (org-table-current-column)) + (beg (org-table-begin)) + (end (copy-marker (org-table-end)))) + (org-table-save-field + (goto-char beg) + (while (< (point) end) + (if (org-at-table-hline-p) + nil + (org-table-goto-column col t) + (and (looking-at "|[^|\n]+|") + (replace-match "|"))) + (forward-line))) + (set-marker end nil) + (org-table-goto-column (max 1 (1- col))) (org-table-align) (when (or (not org-table-fix-formulas-confirm) (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col) - (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) - col -1 col)))) + (org-table-fix-formulas + "$" (list (cons (number-to-string col) "INVALID")) col -1 col) + (org-table-fix-formulas + "$LR" (list (cons (number-to-string col) "INVALID")) col -1 col)))) ;;;###autoload (defun org-table-move-column-right () @@ -1452,31 +1476,29 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." (defun org-table-move-column (&optional left) "Move the current column to the right. With arg LEFT, move to the left." (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) + (unless (org-at-table-p) (user-error "Not at a table")) (org-table-find-dataline) (org-table-check-inside-data-field) (let* ((col (org-table-current-column)) (col1 (if left (1- col) col)) + (colpos (if left (1- col) (1+ col))) (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (if left (1- col) (1+ col)))) - (if (and left (= col 1)) - (user-error "Cannot move column further left")) - (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (user-error "Cannot move column further right")) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col1 t) - (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) + (end (copy-marker (org-table-end)))) + (when (and left (= col 1)) + (user-error "Cannot move column further left")) + (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) + (user-error "Cannot move column further right")) + (org-table-save-field + (goto-char beg) + (while (< (point) end) + (unless (org-at-table-hline-p) + (org-table-goto-column col1 t) + (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") + (transpose-regions + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2)))) + (forward-line))) + (set-marker end nil) (org-table-goto-column colpos) (org-table-align) (when (or (not org-table-fix-formulas-confirm) @@ -1538,19 +1560,21 @@ first dline below it is used. When ABOVE is non-nil, the one above is used." "Insert a new row above the current line into the table. With prefix ARG, insert below the current line." (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) + (unless (org-at-table-p) (user-error "Not at a table")) + (let* ((line (buffer-substring (line-beginning-position) (line-end-position))) (new (org-table-clean-line line))) ;; Fix the first field if necessary (if (string-match "^[ \t]*| *[#$] *|" line) (setq new (replace-match (match-string 0 line) t t new))) (beginning-of-line (if arg 2 1)) + ;; Buffer may not end of a newline character, so ensure + ;; (beginning-of-line 2) moves point to a new line. + (unless (bolp) (insert "\n")) (let (org-table-may-need-update) (insert-before-markers new "\n")) (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) + (re-search-forward "| ?" (line-end-position) t) + (when (or org-table-may-need-update org-table-overlay-coordinates) + (org-table-align)) (when (or (not org-table-fix-formulas-confirm) (funcall org-table-fix-formulas-confirm "Fix formulas? ")) (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) @@ -1563,7 +1587,7 @@ With prefix ABOVE, insert above the current line." (if (not (org-at-table-p)) (user-error "Not at a table")) (when (eobp) (insert "\n") (backward-char 1)) - (if (not (string-match "|[ \t]*$" (org-current-line-string))) + (if (not (string-match-p "|[ \t]*$" (org-current-line-string))) (org-table-align)) (let ((line (org-table-clean-line (buffer-substring (point-at-bol) (point-at-eol)))) @@ -1623,7 +1647,8 @@ In particular, this does handle wide and invisible characters." dline -1 dline)))) ;;;###autoload -(defun org-table-sort-lines (with-case &optional sorting-type) +(defun org-table-sort-lines + (&optional with-case sorting-type getkey-func compare-func interactive?) "Sort table lines according to the column at point. The position of point indicates the column to be used for @@ -1636,76 +1661,112 @@ should be in the last line to be included into the sorting. The command then prompts for the sorting type which can be alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. +in the field, or as a HH:MM value). Sorting in reverse order is +also possible. With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. If SORTING-TYPE is specified when this function is called from a Lisp program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order." - (interactive "P") - (let* ((thisline (org-current-line)) - (thiscol (org-table-current-column)) - (otc org-table-overlay-coordinates) - beg end bcol ecol tend tbeg column lns pos) - (when (equal thiscol 0) - (if (org-called-interactively-p 'any) - (setq thiscol - (string-to-number - (read-string "Use column N for sorting: "))) - (setq thiscol 1)) - (org-table-goto-column thiscol)) - (org-table-check-inside-data-field) - (if (org-region-active-p) - (progn - (setq beg (region-beginning) end (region-end)) - (goto-char beg) - (setq column (org-table-current-column) - beg (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2))) - (setq column (org-table-current-column) - pos (point) - tbeg (org-table-begin) - tend (org-table-end)) - (if (re-search-backward org-table-hline-regexp tbeg t) - (setq beg (point-at-bol 2)) - (goto-char tbeg) - (setq beg (point-at-bol 1))) - (goto-char pos) - (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 1)) - (goto-char tend) - (setq end (point-at-bol)))) - (setq beg (move-marker (make-marker) beg) - end (move-marker (make-marker) end)) - (untabify beg end) - (goto-char beg) - (org-table-goto-column column) - (skip-chars-backward "^|") - (setq bcol (current-column)) - (org-table-goto-column (1+ column)) - (skip-chars-backward "^|") - (setq ecol (1- (current-column))) - (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons - (org-sort-remove-invisible - (nth (1- column) - (org-split-string x "[ \t]*|[ \t]*"))) - x)) - (org-split-string (buffer-substring beg end) "\n"))) - (setq lns (org-do-sort lns "Table" with-case sorting-type)) - (when org-table-overlay-coordinates - (org-table-toggle-coordinate-overlays)) - (delete-region beg end) - (move-marker beg nil) - (move-marker end nil) - (insert (mapconcat 'cdr lns "\n") "\n") - (org-goto-line thisline) - (org-table-goto-column thiscol) - (when otc (org-table-toggle-coordinate-overlays)) - (message "%d lines sorted, based on column %d" (length lns) column))) +any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that +sorting should be done in reverse order. + +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies +a function to be called to extract the key. It must return a value +that is compatible with COMPARE-FUNC, the function used to compare +entries. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil t)) + (when (org-region-active-p) (goto-char (region-beginning))) + ;; Point must be either within a field or before a data line. + (save-excursion + (skip-chars-backward " \t") + (when (bolp) (search-forward "|" (line-end-position) t)) + (org-table-check-inside-data-field)) + ;; Set appropriate case sensitivity and column used for sorting. + (let ((column (let ((c (org-table-current-column))) + (cond ((> c 0) c) + (interactive? + (read-number "Use column N for sorting: ")) + (t 1)))) + (sorting-type + (or sorting-type + (read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \ +\[t]ime, [f]unc. A/N/T/F means reversed: ")))) + (save-restriction + ;; Narrow buffer to appropriate sorting area. + (if (org-region-active-p) + (progn (goto-char (region-beginning)) + (narrow-to-region + (point) + (save-excursion (goto-char (region-end)) + (line-beginning-position 2)))) + (let ((start (org-table-begin)) + (end (org-table-end))) + (narrow-to-region + (save-excursion + (if (re-search-backward org-table-hline-regexp start t) + (line-beginning-position 2) + start)) + (if (save-excursion (re-search-forward org-table-hline-regexp end t)) + (match-beginning 0) + end)))) + ;; Determine arguments for `sort-subr'. Also record original + ;; position. `org-table-save-field' cannot help here since + ;; sorting is too much destructive. + (let* ((sort-fold-case (not with-case)) + (coordinates + (cons (count-lines (point-min) (line-beginning-position)) + (current-column))) + (extract-key-from-field + ;; Function to be called on the contents of the field + ;; used for sorting in the current row. + (cl-case sorting-type + ((?n ?N) #'string-to-number) + ((?a ?A) #'org-sort-remove-invisible) + ((?t ?T) + (lambda (f) + (cond ((string-match org-ts-regexp-both f) + (float-time + (org-time-string-to-time (match-string 0 f)))) + ((string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" f) + (org-hh:mm-string-to-minutes f)) + (t 0)))) + ((?f ?F) + (or getkey-func + (and interactive? + (org-read-function "Function for extracting keys: ")) + (error "Missing key extractor to sort rows"))) + (t (user-error "Invalid sorting type `%c'" sorting-type)))) + (predicate + (cl-case sorting-type + ((?n ?N ?t ?T) #'<) + ((?a ?A) #'string<) + ((?f ?F) + (or compare-func + (and interactive? + (org-read-function + (concat "Fuction for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty))))))) + (goto-char (point-min)) + (sort-subr (memq sorting-type '(?A ?N ?T ?F)) + (lambda () + (forward-line) + (while (and (not (eobp)) + (not (looking-at org-table-dataline-regexp))) + (forward-line))) + #'end-of-line + (lambda () + (funcall extract-key-from-field + (org-trim (org-table-get-field column)))) + nil + predicate) + ;; Move back to initial field. + (forward-line (car coordinates)) + (move-to-column (cdr coordinates)))))) ;;;###autoload (defun org-table-cut-region (beg end) @@ -1725,34 +1786,31 @@ with `org-table-paste-rectangle'." (if (org-region-active-p) (region-beginning) (point)) (if (org-region-active-p) (region-end) (point)) current-prefix-arg)) - (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) - (goto-char beg) - (org-table-check-inside-data-field) - (setq l01 (org-current-line) - c01 (org-table-current-column)) - (goto-char end) + (goto-char (min beg end)) + (org-table-check-inside-data-field) + (let ((beg (line-beginning-position)) + (c01 (org-table-current-column)) + region) + (goto-char (max beg end)) (org-table-check-inside-data-field) - (setq l02 (org-current-line) - c02 (org-table-current-column)) - (setq l1 (min l01 l02) l2 (max l01 l02) - c1 (min c01 c02) c2 (max c01 c02)) - (catch 'exit - (while t - (catch 'nextline - (if (> l1 l2) (throw 'exit t)) - (org-goto-line l1) - (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) - (setq cols nil ic1 c1 ic2 c2) - (while (< ic1 (1+ ic2)) - (push (org-table-get-field ic1 rpl) cols) - (setq ic1 (1+ ic1))) - (push (nreverse cols) region) - (setq l1 (1+ l1))))) - (setq org-table-clip (nreverse region)) - (if cut (org-table-align)) - org-table-clip)) + (let* ((end (copy-marker (line-end-position))) + (c02 (org-table-current-column)) + (column-start (min c01 c02)) + (column-end (max c01 c02)) + (column-number (1+ (- column-end column-start))) + (rpl (and cut " "))) + (goto-char beg) + (while (< (point) end) + (unless (org-at-table-hline-p) + ;; Collect every cell between COLUMN-START and COLUMN-END. + (let (cols) + (dotimes (c column-number) + (push (org-table-get-field (+ c column-start) rpl) cols)) + (push (nreverse cols) region))) + (forward-line)) + (set-marker end nil)) + (when cut (org-table-align)) + (setq org-table-clip (nreverse region)))) ;;;###autoload (defun org-table-paste-rectangle () @@ -1762,45 +1820,43 @@ will be overwritten. If the rectangle does not fit into the present table, the table is enlarged as needed. The process ignores horizontal separator lines." (interactive) - (unless (and org-table-clip (listp org-table-clip)) + (unless (consp org-table-clip) (user-error "First cut/copy a region to paste!")) (org-table-check-inside-data-field) - (let* ((clip org-table-clip) - (line (org-current-line)) - (col (org-table-current-column)) + (let* ((column (org-table-current-column)) (org-enable-table-editor t) - (org-table-automatic-realign nil) - c cols field) - (while (setq cols (pop clip)) - (while (org-at-table-hline-p) (beginning-of-line 2)) - (if (not (org-at-table-p)) - (progn (end-of-line 0) (org-table-next-field))) - (setq c col) - (while (setq field (pop cols)) - (org-table-goto-column c nil 'force) - (org-table-get-field nil field) - (setq c (1+ c))) - (beginning-of-line 2)) - (org-goto-line line) - (org-table-goto-column col) + (org-table-automatic-realign nil)) + (org-table-save-field + (dolist (row org-table-clip) + (while (org-at-table-hline-p) (forward-line)) + ;; If we left the table, create a new row. + (when (and (bolp) (not (looking-at "[ \t]*|"))) + (end-of-line 0) + (org-table-next-field)) + (let ((c column)) + (dolist (field row) + (org-table-goto-column c nil 'force) + (org-table-get-field nil field) + (cl-incf c))) + (forward-line))) (org-table-align))) ;;;###autoload (defun org-table-convert () "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." +Obviously, this only works within limits. When an Org table is converted +to table.el, all horizontal separator lines get lost, because table.el uses +these as cell boundaries and has no notion of horizontal lines. A table.el +table can be converted to an Org table only if it does not do row or column +spanning. Multiline cells will become multiple cells. Beware, Org mode +does not test if the table can be successfully converted - it blindly +applies a recipe that works for simple tables." (interactive) (require 'table) (if (org-at-table.el-p) - ;; convert to Org-mode table - (let ((beg (move-marker (make-marker) (org-table-begin t))) - (end (move-marker (make-marker) (org-table-end t)))) + ;; convert to Org table + (let ((beg (copy-marker (org-table-begin t))) + (end (copy-marker (org-table-end t)))) (table-unrecognize-region beg end) (goto-char beg) (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) @@ -1808,8 +1864,8 @@ blindly applies a recipe that works for simple tables." (goto-char beg)) (if (org-at-table-p) ;; convert to table.el table - (let ((beg (move-marker (make-marker) (org-table-begin))) - (end (move-marker (make-marker) (org-table-end)))) + (let ((beg (copy-marker (org-table-begin))) + (end (copy-marker (org-table-end)))) ;; first, get rid of all horizontal lines (goto-char beg) (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) @@ -1832,7 +1888,7 @@ blindly applies a recipe that works for simple tables." (goto-char beg))))) (defun org-table-transpose-table-at-point () - "Transpose orgmode table at point and eliminate hlines. + "Transpose Org table at point and eliminate hlines. So a table like | 1 | 2 | 4 | 5 | @@ -1847,22 +1903,31 @@ will be transposed as | 4 | c | g | | 5 | d | h | -Note that horizontal lines disappeared." +Note that horizontal lines disappear." (interactive) (let* ((table (delete 'hline (org-table-to-lisp))) - (contents (mapcar (lambda (p) + (dline_old (org-table-current-line)) + (col_old (org-table-current-column)) + (contents (mapcar (lambda (_) (let ((tp table)) (mapcar - (lambda (rown) + (lambda (_) (prog1 (pop (car tp)) (setq tp (cdr tp)))) table))) (car table)))) - (delete-region (org-table-begin) (org-table-end)) - (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) - contents "")) - (org-table-align))) + (goto-char (org-table-begin)) + (re-search-forward "|") + (backward-char) + (delete-region (point) (org-table-end)) + (insert (mapconcat + (lambda(x) + (concat "| " (mapconcat 'identity x " | " ) " |\n" )) + contents "")) + (org-table-goto-line col_old) + (org-table-goto-column dline_old)) + (org-table-align)) ;;;###autoload (defun org-table-wrap-region (arg) @@ -1873,7 +1938,8 @@ lines, in order to keep the table compact. If there is an active region, and both point and mark are in the same column, the text in the column is wrapped to minimum width for the given number of lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' +used to change the number of desired lines. For example, \ +`C-2 \\[org-table-wrap-region]' formats the selected text to two lines. If the region was longer than two lines, the remaining lines remain empty. A negative prefix argument reduces the current number of lines by that amount. The wrapped text is pasted back @@ -1890,57 +1956,53 @@ blank, and the content is appended to the field above." (interactive "P") (org-table-check-inside-data-field) (if (org-region-active-p) - ;; There is a region: fill as a paragraph - (let* ((beg (region-beginning)) - (cline (save-excursion (goto-char beg) (org-current-line))) - (ccol (save-excursion (goto-char beg) (org-table-current-column))) - nlines) + ;; There is a region: fill as a paragraph. + (let ((start (region-beginning))) (org-table-cut-region (region-beginning) (region-end)) - (if (> (length (car org-table-clip)) 1) - (user-error "Region must be limited to single column")) - (setq nlines (if arg - (if (< arg 1) - (+ (length org-table-clip) arg) - arg) - (length org-table-clip))) - (setq org-table-clip - (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") - nil nlines))) - (org-goto-line cline) - (org-table-goto-column ccol) + (when (> (length (car org-table-clip)) 1) + (user-error "Region must be limited to single column")) + (let ((nlines (cond ((not arg) (length org-table-clip)) + ((< arg 1) (+ (length org-table-clip) arg)) + (t arg)))) + (setq org-table-clip + (mapcar #'list + (org-wrap (mapconcat #'car org-table-clip " ") + nil + nlines)))) + (goto-char start) (org-table-paste-rectangle)) - ;; No region, split the current field at point + ;; No region, split the current field at point. (unless (org-get-alist-option org-M-RET-may-split-line 'table) (skip-chars-forward "^\r\n|")) - (if arg - ;; combine with field above - (let ((s (org-table-blank-field)) - (col (org-table-current-column))) - (beginning-of-line 0) - (while (org-at-table-hline-p) (beginning-of-line 0)) - (org-table-goto-column col) - (skip-chars-forward "^|") - (skip-chars-backward " ") - (insert " " (org-trim s)) - (org-table-align)) - ;; split field - (if (looking-at "\\([^|]+\\)+|") - (let ((s (match-string 1))) - (replace-match " |") - (goto-char (match-beginning 0)) - (org-table-next-row) - (insert (org-trim s) " ") - (org-table-align)) - (org-table-next-row))))) + (cond + (arg ; Combine with field above. + (let ((s (org-table-blank-field)) + (col (org-table-current-column))) + (forward-line -1) + (while (org-at-table-hline-p) (forward-line -1)) + (org-table-goto-column col) + (skip-chars-forward "^|") + (skip-chars-backward " ") + (insert " " (org-trim s)) + (org-table-align))) + ((looking-at "\\([^|]+\\)+|") ; Split field. + (let ((s (match-string 1))) + (replace-match " |") + (goto-char (match-beginning 0)) + (org-table-next-row) + (insert (org-trim s) " ") + (org-table-align))) + (t (org-table-next-row))))) (defvar org-field-marker nil) ;;;###autoload (defun org-table-edit-field (arg) "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." +This is mainly useful for fields that contain hidden parts. When called +with a `\\[universal-argument]' prefix, just make the full field \ +visible so that it can be +edited in place." (interactive "P") (cond ((equal arg '(16)) @@ -1980,9 +2042,9 @@ it can be edited in place." '(invisible t org-cwidth t display t intangible t)) (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) + (setq-local org-finish-function 'org-table-finish-edit-field) + (setq-local org-window-configuration cw) + (setq-local org-field-marker pos) (message "Edit and finish with C-c C-c"))))) (defun org-table-finish-edit-field () @@ -2015,8 +2077,8 @@ current field. The mode exits automatically when the cursor leaves the table (but see `org-table-exit-follow-field-mode-when-leaving-table')." nil " TblFollow" nil (if org-table-follow-field-mode - (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor - 'append 'local) + (add-hook 'post-command-hook 'org-table-follow-fields-with-editor + 'append 'local) (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) (let* ((buf (get-buffer "*Org Table Edit Field*")) (win (and buf (get-buffer-window buf)))) @@ -2091,11 +2153,10 @@ If NLAST is a number, only the NLAST fields will actually be summed." s diff) (format "%.0f:%02.0f:%02.0f" h m s)))) (kill-new sres) - (if (org-called-interactively-p 'interactive) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) + (when (called-interactively-p 'interactive) + (message "%s" (substitute-command-keys + (format "Sum of %d items: %-20s \ +\(\\[yank] will insert result into buffer)" (length numbers) sres)))) sres)))) (defun org-table-get-number-for-summing (s) @@ -2120,57 +2181,58 @@ If NLAST is a number, only the NLAST fields will actually be summed." (defun org-table-current-field-formula (&optional key noerror) "Return the formula active for the current field. -Assumes that specials are in place. -If KEY is given, return the key to this formula. -Otherwise return the formula preceded with \"=\" or \":=\"." - (let* ((name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (col (org-table-current-column)) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (if key - (car ass) - (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) + +Assumes that table is already analyzed. If KEY is given, return +the key to this formula. Otherwise return the formula preceded +with \"=\" or \":=\"." + (let* ((line (count-lines org-table-current-begin-pos + (line-beginning-position))) + (row (org-table-line-to-dline line))) + (cond + (row + (let* ((col (org-table-current-column)) + (name (car (rassoc (list line col) + org-table-named-field-locations))) + (scol (format "$%d" col)) + (ref (format "@%d$%d" (org-table-current-dline) col)) + (stored-list (org-table-get-stored-formulas noerror)) + (ass (or (assoc name stored-list) + (assoc ref stored-list) + (assoc scol stored-list)))) + (cond (key (car ass)) + (ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=") + (cdr ass)))))) + (noerror nil) + (t (error "No formula active for the current field"))))) (defun org-table-get-formula (&optional equation named) "Read a formula from the minibuffer, offer stored formula as default. When NAMED is non-nil, look for a named equation." (let* ((stored-list (org-table-get-stored-formulas)) - (name (car (rassoc (list (org-current-line) + (name (car (rassoc (list (count-lines org-table-current-begin-pos + (line-beginning-position)) (org-table-current-column)) org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) + (ref (format "@%d$%d" + (org-table-current-dline) (org-table-current-column))) - (refass (assoc ref stored-list)) - (nameass (assoc name stored-list)) - (scol (if named - (if (and name (not (string-match "^LR[0-9]+$" name))) - name - ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or nameass refass) (not named) - (not (y-or-n-p "Replace existing field formula with column formula? " )) - (message "Formula not replaced"))) + (scol (cond + ((not named) (format "$%d" (org-table-current-column))) + ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name) + (t ref))) (name (or name ref)) (org-table-may-need-update nil) (stored (cdr (assoc scol stored-list))) (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) + ((and stored equation (string-match-p "^ *=? *$" equation)) stored) ((stringp equation) equation) (t (org-table-formula-from-user (read-string (org-table-formula-to-user - (format "%s formula %s%s=" + (format "%s formula %s=" (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") scol)) (if stored (org-table-formula-to-user stored) "") 'org-table-formula-history @@ -2194,25 +2256,27 @@ When NAMED is non-nil, look for a named equation." (org-table-store-formulas stored-list)) eq)) -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (let ((case-fold-search t)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") +(defun org-table-store-formulas (alist &optional location) + "Store the list of formulas below the current table. +If optional argument LOCATION is a buffer position, insert it at +LOCATION instead." + (save-excursion + (if location + (progn (goto-char location) (beginning-of-line)) + (goto-char (org-table-end))) + (let ((case-fold-search t)) + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)") (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff + ;; Don't overwrite TBLFM, we might use text properties to + ;; store stuff. (goto-char (match-beginning 3)) (delete-region (match-beginning 3) (match-end 0))) (org-indent-line) (insert (or (match-string 2) "#+TBLFM:"))) (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") + (mapconcat (lambda (x) (concat (car x) "=" (cdr x))) + (sort alist #'org-table-formula-less-p) + "::") "\n")))) (defsubst org-table-formula-make-cmp-string (a) @@ -2241,33 +2305,47 @@ When NAMED is non-nil, look for a named equation." (and as bs (string< as bs)))) ;;;###autoload -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." - (interactive) ;; FIXME interactive? - (let ((case-fold-search t) scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") - (setq strings (org-split-string (org-match-string-no-properties 2) - " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - scol (if (member (string-to-char scol) '(?< ?>)) - (concat "$" scol) scol) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) +(defun org-table-get-stored-formulas (&optional noerror location) + "Return an alist with the stored formulas directly after current table. +By default, only return active formulas, i.e., formulas located +on the first line after the table. However, if optional argument +LOCATION is a buffer position, consider the formulas there." + (save-excursion + (if location + (progn (goto-char location) (beginning-of-line)) + (goto-char (org-table-end))) + (let ((case-fold-search t)) + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") + (let ((strings (org-split-string (match-string-no-properties 2) + " *:: *")) + eq-alist seen) + (dolist (string strings (nreverse eq-alist)) + (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\ +[<>]+\\)\\) *= *\\(.*[^ \t]\\)" + string) + (let ((lhs + (let ((m (match-string 1 string))) + (cond + ((not (match-end 2)) m) + ;; Is it a column reference? + ((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m) + ;; Since named columns are not possible in + ;; LHS, assume this is a named field. + (t (match-string 2 string))))) + (rhs (match-string 3 string))) + (push (cons lhs rhs) eq-alist) + (cond + ((not (member lhs seen)) (push lhs seen)) + (noerror + (message + "Double definition `%s=' in TBLFM line, please fix by hand" + lhs) + (ding) + (sit-for 2)) + (t + (user-error + "Double definition `%s=' in TBLFM line, please fix by hand" + lhs))))))))))) (defun org-table-fix-formulas (key replace &optional limit delta remove) "Modify the equations after the table structure has been edited. @@ -2305,83 +2383,6 @@ For all numbers larger than LIMIT, shift them by DELTA." (message msg)))))) (forward-line)))) -(defun org-table-get-specials () - "Get the column names and local parameters for this table." - (save-excursion - (let ((beg (org-table-begin)) (end (org-table-end)) - names name fields fields1 field cnt - c v l line col types dlines hlines last-dline) - (setq org-table-column-names nil - org-table-local-parameters nil - org-table-named-field-locations nil - org-table-current-begin-line nil - org-table-current-begin-pos nil - org-table-current-line-types nil - org-table-current-ncol 0) - (goto-char beg) - (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) - (setq names (org-split-string (match-string 1) " *| *") - cnt 1) - (while (setq name (pop names)) - (setq cnt (1+ cnt)) - (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name) - (push (cons name (int-to-string cnt)) org-table-column-names)))) - (setq org-table-column-names (nreverse org-table-column-names)) - (setq org-table-column-name-regexp - (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) - (setq fields (org-split-string (match-string 1) " *| *")) - (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) - (push (cons (match-string 1 field) (match-string 2 field)) - org-table-local-parameters)))) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) - (setq c (match-string 1) - fields (org-split-string (match-string 2) " *| *")) - (save-excursion - (beginning-of-line (if (equal c "_") 2 0)) - (setq line (org-current-line) col 1) - (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") - (setq fields1 (org-split-string (match-string 1) " *| *")))) - (while (and fields1 (setq field (pop fields))) - (setq v (pop fields1) col (1+ col)) - (when (and (stringp field) (stringp v) - (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) - ;; Analyze the line types. - (goto-char beg) - (setq org-table-current-begin-line (org-current-line) - org-table-current-begin-pos (point) - l org-table-current-begin-line) - (while (looking-at "[ \t]*|\\(-\\)?") - (push (if (match-end 1) 'hline 'dline) types) - (if (match-end 1) (push l hlines) (push l dlines)) - (beginning-of-line 2) - (setq l (1+ l))) - (push 'hline types) ;; add an imaginary extra hline to the end - (setq org-table-current-line-types (apply 'vector (nreverse types)) - last-dline (car dlines) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines)))) - (org-goto-line last-dline) - (let* ((l last-dline) - (fields (org-split-string - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*")) - (nfields (length fields)) - al al2) - (setq org-table-current-ncol nfields) - (loop for i from 1 to nfields do - (push (list (format "LR%d" i) l i) al) - (push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) - (setq org-table-named-field-locations - (append org-table-named-field-locations al)) - (setq org-table-local-parameters - (append org-table-local-parameters al2)))))) - ;;;###autoload (defun org-table-maybe-eval-formula () "Check if the current field starts with \"=\" or \":=\". @@ -2394,11 +2395,8 @@ If yes, store the formula and apply it." (when (string-match "^:?=\\(.*[^=]\\)$" field) (setq named (equal (string-to-char field) ?:) eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + (org-table-eval-formula (and named '(4)) + (org-table-formula-from-user eq)))))) (defvar org-recalc-commands nil "List of commands triggering the recalculation of a line. @@ -2424,56 +2422,199 @@ After each change, a message will be displayed indicating the meaning of the new mark." (interactive) (unless (org-at-table-p) (user-error "Not at a table")) - (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) - (beg (org-table-begin)) - (end (org-table-end)) - (l (org-current-line)) - (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) - (l2 (if (org-region-active-p) (org-current-line (region-end)))) - (have-col - (save-excursion - (goto-char beg) - (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) + (let* ((region (org-region-active-p)) + (l1 (and region + (save-excursion (goto-char (region-beginning)) + (copy-marker (line-beginning-position))))) + (l2 (and region + (save-excursion (goto-char (region-end)) + (copy-marker (line-beginning-position))))) + (l (copy-marker (line-beginning-position))) (col (org-table-current-column)) - (forcenew (car (assoc newchar org-recalc-marks))) - epos new) - (when l1 - (message "Change region to what mark? Type # * ! $ or SPC: ") - (setq newchar (char-to-string (read-char-exclusive)) - forcenew (car (assoc newchar org-recalc-marks)))) - (if (and newchar (not forcenew)) - (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" - newchar)) - (if l1 (org-goto-line l1)) + (newchar (if region + (char-to-string + (read-char-exclusive + "Change region to what mark? Type # * ! $ or SPC: ")) + newchar)) + (no-special-column + (save-excursion + (goto-char (org-table-begin)) + (re-search-forward + "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t)))) + (when (and newchar (not (assoc newchar org-recalc-marks))) + (user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'" + newchar)) + (when l1 (goto-char l1)) (save-excursion - (beginning-of-line 1) + (beginning-of-line) (unless (looking-at org-table-dataline-regexp) (user-error "Not at a table data line"))) - (unless have-col + (when no-special-column (org-table-goto-column 1) - (org-table-insert-column) - (org-table-goto-column (1+ col))) - (setq epos (point-at-eol)) + (org-table-insert-column)) + (let ((previous-line-end (line-end-position)) + (newchar + (save-excursion + (beginning-of-line) + (cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#") + (newchar) + (t (cadr (member (match-string 1) + (append (mapcar #'car org-recalc-marks) + '(" "))))))))) + ;; Rotate mark in first row. + (org-table-get-field 1 (format " %s " newchar)) + ;; Rotate marks in additional rows if a region is active. + (when region + (save-excursion + (forward-line) + (while (<= (point) l2) + (when (looking-at org-table-dataline-regexp) + (org-table-get-field 1 (format " %s " newchar))) + (forward-line)))) + ;; Only align if rotation actually changed lines' length. + (when (/= previous-line-end (line-end-position)) (org-table-align))) + (goto-char l) + (org-table-goto-column (if no-special-column (1+ col) col)) + (when l1 (set-marker l1 nil)) + (when l2 (set-marker l2 nil)) + (set-marker l nil) + (when (called-interactively-p 'interactive) + (message "%s" (cdr (assoc newchar org-recalc-marks)))))) + +;;;###autoload +(defun org-table-analyze () + "Analyze table at point and store results. + +This function sets up the following dynamically scoped variables: + + `org-table-column-name-regexp', + `org-table-column-names', + `org-table-current-begin-pos', + `org-table-current-line-types', + `org-table-current-ncol', + `org-table-dlines', + `org-table-hlines', + `org-table-local-parameters', + `org-table-named-field-locations'." + (let ((beg (org-table-begin)) + (end (org-table-end))) (save-excursion - (beginning-of-line 1) - (org-table-get-field - 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") - (concat " " - (setq new (or forcenew - (cadr (member (match-string 1) marks)))) - " ") - " # "))) - (if (and l1 l2) - (progn - (org-goto-line l1) - (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) - (and (looking-at org-table-dataline-regexp) - (org-table-get-field 1 (concat " " new " ")))) - (org-goto-line l1))) - (if (not (= epos (point-at-eol))) (org-table-align)) - (org-goto-line l) - (and (org-called-interactively-p 'interactive) - (message "%s" (cdr (assoc new org-recalc-marks)))))) + (goto-char beg) + ;; Extract column names. + (setq org-table-column-names nil) + (when (save-excursion + (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)) + (let ((c 1)) + (dolist (name (org-split-string (match-string 1) " *| *")) + (cl-incf c) + (when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name) + (push (cons name (int-to-string c)) org-table-column-names))))) + (setq org-table-column-names (nreverse org-table-column-names)) + (setq org-table-column-name-regexp + (format "\\$\\(%s\\)\\>" + (regexp-opt (mapcar #'car org-table-column-names) t))) + ;; Extract local parameters. + (setq org-table-local-parameters nil) + (save-excursion + (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) + (dolist (field (org-split-string (match-string 1) " *| *")) + (when (string-match + "\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) + (push (cons (match-string 1 field) (match-string 2 field)) + org-table-local-parameters))))) + ;; Update named fields locations. We minimize `count-lines' + ;; processing by storing last known number of lines in LAST. + (setq org-table-named-field-locations nil) + (save-excursion + (let ((last (cons (point) 0))) + (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) + (let ((c (match-string 1)) + (fields (org-split-string (match-string 2) " *| *"))) + (save-excursion + (forward-line (if (equal c "_") 1 -1)) + (let ((fields1 + (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") + (org-split-string (match-string 1) " *| *"))) + (line (cl-incf (cdr last) (count-lines (car last) (point)))) + (col 1)) + (setcar last (point)) ; Update last known position. + (while (and fields fields1) + (let ((field (pop fields)) + (v (pop fields1))) + (cl-incf col) + (when (and (stringp field) + (stringp v) + (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" + field)) + (push (cons field v) org-table-local-parameters) + (push (list field line col) + org-table-named-field-locations)))))))))) + ;; Re-use existing markers when possible. + (if (markerp org-table-current-begin-pos) + (move-marker org-table-current-begin-pos (point)) + (setq org-table-current-begin-pos (point-marker))) + ;; Analyze the line types. + (let ((l 0) hlines dlines types) + (while (looking-at "[ \t]*|\\(-\\)?") + (push (if (match-end 1) 'hline 'dline) types) + (if (match-end 1) (push l hlines) (push l dlines)) + (forward-line) + (cl-incf l)) + (push 'hline types) ; Add an imaginary extra hline to the end. + (setq org-table-current-line-types (apply #'vector (nreverse types))) + (setq org-table-dlines (apply #'vector (cons nil (nreverse dlines)))) + (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines))))) + ;; Get the number of columns from the first data line in table. + (goto-char beg) + (forward-line (aref org-table-dlines 1)) + (let* ((fields + (org-split-string + (buffer-substring (line-beginning-position) (line-end-position)) + "[ \t]*|[ \t]*")) + (nfields (length fields)) + al al2) + (setq org-table-current-ncol nfields) + (let ((last-dline + (aref org-table-dlines (1- (length org-table-dlines))))) + (dotimes (i nfields) + (let ((column (1+ i))) + (push (list (format "LR%d" column) last-dline column) al) + (push (cons (format "LR%d" column) (nth i fields)) al2)))) + (setq org-table-named-field-locations + (append org-table-named-field-locations al)) + (setq org-table-local-parameters + (append org-table-local-parameters al2)))))) + +(defun org-table-goto-field (ref &optional create-column-p) + "Move point to a specific field in the current table. + +REF is either the name of a field its absolute reference, as +a string. No column is created unless CREATE-COLUMN-P is +non-nil. If it is a function, it is called with the column +number as its argument as is used as a predicate to know if the +column can be created. + +This function assumes the table is already analyzed (i.e., using +`org-table-analyze')." + (let* ((coordinates + (cond + ((cdr (assoc ref org-table-named-field-locations))) + ((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref) + (list (condition-case nil + (aref org-table-dlines + (string-to-number (match-string 1 ref))) + (error (user-error "Invalid row number in %s" ref))) + (string-to-number (match-string 2 ref)))) + (t (user-error "Unknown field: %s" ref)))) + (line (car coordinates)) + (column (nth 1 coordinates)) + (create-new-column (if (functionp create-column-p) + (funcall create-column-p column) + create-column-p))) + (when coordinates + (goto-char org-table-current-begin-pos) + (forward-line line) + (org-table-goto-column column nil create-new-column)))) ;;;###autoload (defun org-table-maybe-recalculate-line () @@ -2481,7 +2622,7 @@ of the new mark." (interactive) (and org-table-allow-automatic-line-recalculation (not (and (memq last-command org-recalc-commands) - (equal org-last-recalc-line (org-current-line)))) + (eq org-last-recalc-line (line-beginning-position)))) (save-excursion (beginning-of-line 1) (looking-at org-table-auto-recalculate-regexp)) (org-table-recalculate) t)) @@ -2505,20 +2646,18 @@ of the new mark." suppress-store suppress-analysis) "Replace the table field value at the cursor by the result of a calculation. -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - In a table, this command replaces the value in the current field with the result of a formula. It also installs the formula as the \"current\" column formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must be a named field, and the -formula is installed as valid in only this specific field. +with a `\\[universal-argument]' prefix the formula is installed as a \ +field formula. -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. +When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ +insert the active equation for the field +back into the current field, so that it can be edited there. This is \ +useful +in order to use \\`\\[org-table-show-reference]' to \ +check the referenced fields. When called, the command first prompts for a formula, which is read in the minibuffer. Previously entered formulas are available through the @@ -2527,7 +2666,7 @@ These stored formulas are adapted correctly when moving, inserting, or deleting columns with the corresponding commands. The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. +For details, see the Org mode manual. This function can also be called from Lisp programs and offers additional arguments: EQUATION can be the formula to apply. If this @@ -2537,13 +2676,13 @@ SUPPRESS-CONST suppresses the interpretation of constants in the formula, assuming that this has been done already outside the function. SUPPRESS-STORE means the formula should not be stored, either because it is already stored, or because it is a modified equation that should -not overwrite the stored one." +not overwrite the stored one. SUPPRESS-ANALYSIS prevents any call to +`org-table-analyze'." (interactive "P") (org-table-check-inside-data-field) - (or suppress-analysis (org-table-get-specials)) + (or suppress-analysis (org-table-analyze)) (if (equal arg '(16)) (let ((eq (org-table-current-field-formula))) - (or eq (user-error "No equation active for current field")) (org-table-get-field nil eq) (org-table-align) (setq org-table-may-need-update t)) @@ -2557,7 +2696,7 @@ not overwrite the stored one." (org-table-get-formula equation (equal arg '(4))))) (n0 (org-table-current-column)) (org-tbl-calc-modes (copy-sequence org-calc-default-modes)) - (numbers nil) ; was a variable, now fixed default + (numbers nil) ; was a variable, now fixed default (keep-empty nil) n form form0 formrpl formrg bw fmt x ev orig c lispp literal duration duration-output-format) @@ -2603,12 +2742,15 @@ not overwrite the stored one." (setq fmt (replace-match "" t t fmt))) (unless (string-match "\\S-" fmt) (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) + (when (and (not suppress-const) org-table-formula-use-constants) + (setq formula (org-table-formula-substitute-names formula))) (setq orig (or (get-text-property 1 :orig-formula formula) "?")) + (setq formula (org-table-formula-handle-first/last-rc formula)) (while (> ndown 0) (setq fields (org-split-string - (buffer-substring-no-properties (point-at-bol) (point-at-eol)) + (org-trim + (buffer-substring-no-properties + (line-beginning-position) (line-end-position))) " *| *")) ;; replace fields with duration values if relevant (if duration @@ -2641,9 +2783,10 @@ not overwrite the stored one." t t form))) ;; Check for old vertical references - (setq form (org-table-rewrite-old-row-references form)) + (org-table--error-on-old-row-references form) ;; Insert remote references - (while (string-match "\\ (length (match-string 0 form)) 1)) - (setq formrg (save-match-data - (org-table-get-range (match-string 0 form) nil n0))) + (setq formrg + (save-match-data + (org-table-get-range + (match-string 0 form) org-table-current-begin-pos n0))) (setq formrpl (save-match-data (org-table-make-reference @@ -2676,15 +2821,20 @@ not overwrite the stored one." (string-match (regexp-quote form) formrpl))) (setq form (replace-match formrpl t t form)) (user-error "Spreadsheet error: invalid reference \"%s\"" form))) - ;; Insert simple ranges - (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) + ;; Insert simple ranges, i.e. included in the current row. + (while (string-match + "\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)" + form) (setq form (replace-match (save-match-data (org-table-make-reference - (org-sublist - fields (string-to-number (match-string 1 form)) - (string-to-number (match-string 2 form))) + (cl-subseq fields + (+ (if (match-end 2) n0 0) + (string-to-number (match-string 1 form)) + -1) + (+ (if (match-end 4) n0 0) + (string-to-number (match-string 3 form)))) keep-empty numbers lispp)) t t form))) (setq form0 form) @@ -2692,14 +2842,16 @@ not overwrite the stored one." (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) (setq n (+ (string-to-number (match-string 1 form)) (if (match-end 2) n0 0)) - x (nth (1- (if (= n 0) n0 (max n 1))) fields)) - (unless x (user-error "Invalid field specifier \"%s\"" - (match-string 0 form))) - (setq form (replace-match - (save-match-data - (org-table-make-reference - x keep-empty numbers lispp)) - t t form))) + x (nth (1- (if (= n 0) n0 (max n 1))) fields) + formrpl (save-match-data + (org-table-make-reference + x keep-empty numbers lispp))) + (when (or (not x) + (save-match-data + (string-match (regexp-quote formula) formrpl))) + (user-error "Invalid field specifier \"%s\"" + (match-string 0 form))) + (setq form (replace-match formrpl t t form))) (if lispp (setq ev (condition-case nil @@ -2709,20 +2861,23 @@ not overwrite the stored one." ev (if duration (org-table-time-seconds-to-string (string-to-number ev) duration-output-format) ev)) - (or (fboundp 'calc-eval) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) - ;; Use <...> time-stamps so that Calc can handle them - (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form) - (setq form (replace-match "<\\1>" nil nil form))) - ;; I18n-ize local time-stamps by setting (system-time-locale "C") - (when (string-match org-ts-regexp2 form) - (let* ((ts (match-string 0 form)) - (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) - (system-time-locale "C") - (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) - (cdr org-time-stamp-formats)) - (car org-time-stamp-formats)))) - (setq form (replace-match (format-time-string tf tsp) t t form)))) + + ;; Use <...> time-stamps so that Calc can handle them. + (setq form + (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form)) + ;; Internationalize local time-stamps by setting locale to + ;; "C". + (setq form + (replace-regexp-in-string + org-ts-regexp + (lambda (ts) + (let ((system-time-locale "C")) + (format-time-string + (org-time-stamp-format + (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (apply #'encode-time + (save-match-data (org-parse-time-string ts)))))) + form t t)) (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) form @@ -2742,7 +2897,7 @@ Orig: %s $xyz-> %s @r$c-> %s $1-> %s\n" orig formula form0 form)) - (if (listp ev) + (if (consp ev) (princ (format " %s^\nError: %s" (make-string (car ev) ?\-) (nth 1 ev))) (princ (format "Result: %s\nFormat: %s\nFinal: %s" @@ -2750,14 +2905,14 @@ $1-> %s\n" orig formula form0 form)) (if fmt (format fmt (string-to-number ev)) ev))))) (setq bw (get-buffer-window "*Substitution History*")) (org-fit-window-to-buffer bw) - (unless (and (org-called-interactively-p 'any) (not ndown)) + (unless (and (called-interactively-p 'any) (not ndown)) (unless (let (inhibit-redisplay) (y-or-n-p "Debugging Formula. Continue to next? ")) (org-table-align) (user-error "Abort")) (delete-window bw) (message ""))) - (if (listp ev) (setq fmt nil ev "#ERROR")) + (when (consp ev) (setq fmt nil ev "#ERROR")) (org-table-justify-field-maybe (format org-table-formula-field-format (if fmt (format fmt (string-to-number ev)) ev))) @@ -2776,146 +2931,152 @@ $1-> %s\n" orig formula form0 form)) (defun org-table-get-range (desc &optional tbeg col highlight corners-only) "Get a calc vector from a column, according to descriptor DESC. + Optional arguments TBEG and COL can give the beginning of the table and the current column, to avoid unnecessary parsing. HIGHLIGHT means just highlight the range. When CORNERS-ONLY is set, only return the corners of the range as -a list (line1 column1 line2 column2) where line1 and line2 are line numbers -in the buffer and column1 and column2 are table column numbers." - (if (not (equal (string-to-char desc) ?@)) - (setq desc (concat "@" desc))) - (save-excursion - (or tbeg (setq tbeg (org-table-begin))) - (or col (setq col (org-table-current-column))) - (let ((thisline (org-current-line)) - beg end c1 c2 r1 r2 rangep tmp) - (unless (string-match org-table-range-regexp desc) - (user-error "Invalid table range specifier `%s'" desc)) - (setq rangep (match-end 3) - r1 (and (match-end 1) (match-string 1 desc)) - r2 (and (match-end 4) (match-string 4 desc)) - c1 (and (match-end 2) (substring (match-string 2 desc) 1)) - c2 (and (match-end 5) (substring (match-string 5 desc) 1))) - - (and c1 (setq c1 (+ (string-to-number c1) - (if (memq (string-to-char c1) '(?- ?+)) col 0)))) - (and c2 (setq c2 (+ (string-to-number c2) - (if (memq (string-to-char c2) '(?- ?+)) col 0)))) - (if (equal r1 "") (setq r1 nil)) - (if (equal r2 "") (setq r2 nil)) - (if r1 (setq r1 (org-table-get-descriptor-line r1))) - (if r2 (setq r2 (org-table-get-descriptor-line r2))) - ; (setq r2 (or r2 r1) c2 (or c2 c1)) - (if (not r1) (setq r1 thisline)) - (if (not r2) (setq r2 thisline)) - (if (or (not c1) (= 0 c1)) (setq c1 col)) - (if (or (not c2) (= 0 c2)) (setq c2 col)) - (if (and (not corners-only) - (or (not rangep) (and (= r1 r2) (= c1 c2)))) - ;; just one field - (progn - (org-goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (prog1 (org-trim (org-table-get-field c1)) - (if highlight (org-table-highlight-rectangle (point) (point))))) - ;; A range, return a vector - ;; First sort the numbers to get a regular rectangle - (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) - (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (if corners-only - ;; Only return the corners of the range - (list r1 c1 r2 c2) - ;; Copy the range values into a list - (org-goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (org-goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end)))))))) - -(defun org-table-get-descriptor-line (desc &optional cline bline table) - "Analyze descriptor DESC and retrieve the corresponding line number. -The cursor is currently in line CLINE, the table begins in line BLINE, -and TABLE is a vector with line types." - (if (string-match "^[0-9]+$" desc) +a list (line1 column1 line2 column2) where line1 and line2 are +line numbers relative to beginning of table, or TBEG, and column1 +and column2 are table column numbers." + (let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc) + (replace-regexp-in-string "\\$" "@0$" desc) + desc)) + (col (or col (org-table-current-column))) + (tbeg (or tbeg (org-table-begin))) + (thisline (count-lines tbeg (line-beginning-position)))) + (unless (string-match org-table-range-regexp desc) + (user-error "Invalid table range specifier `%s'" desc)) + (let ((rangep (match-end 3)) + (r1 (let ((r (and (match-end 1) (match-string 1 desc)))) + (or (save-match-data + (and (org-string-nw-p r) + (org-table--descriptor-line r thisline))) + thisline))) + (r2 (let ((r (and (match-end 4) (match-string 4 desc)))) + (or (save-match-data + (and (org-string-nw-p r) + (org-table--descriptor-line r thisline))) + thisline))) + (c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1)))) + (if (or (not c) (= (string-to-number c) 0)) col + (+ (string-to-number c) + (if (memq (string-to-char c) '(?- ?+)) col 0))))) + (c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1)))) + (if (or (not c) (= (string-to-number c) 0)) col + (+ (string-to-number c) + (if (memq (string-to-char c) '(?- ?+)) col 0)))))) + (save-excursion + (if (and (not corners-only) + (or (not rangep) (and (= r1 r2) (= c1 c2)))) + ;; Just one field. + (progn + (forward-line (- r1 thisline)) + (while (not (looking-at org-table-dataline-regexp)) + (forward-line)) + (prog1 (org-trim (org-table-get-field c1)) + (when highlight (org-table-highlight-rectangle)))) + ;; A range, return a vector. First sort the numbers to get + ;; a regular rectangle. + (let ((first-row (min r1 r2)) + (last-row (max r1 r2)) + (first-column (min c1 c2)) + (last-column (max c1 c2))) + (if corners-only (list first-row first-column last-row last-column) + ;; Copy the range values into a list. + (forward-line (- first-row thisline)) + (while (not (looking-at org-table-dataline-regexp)) + (forward-line) + (cl-incf first-row)) + (org-table-goto-column first-column) + (let ((beg (point))) + (forward-line (- last-row first-row)) + (while (not (looking-at org-table-dataline-regexp)) + (forward-line -1)) + (org-table-goto-column last-column) + (let ((end (point))) + (when highlight + (org-table-highlight-rectangle + beg (progn (skip-chars-forward "^|\n") (point)))) + ;; Return string representation of calc vector. + (mapcar #'org-trim + (apply #'append + (org-table-copy-region beg end)))))))))))) + +(defun org-table--descriptor-line (desc cline) + "Return relative line number corresponding to descriptor DESC. +The cursor is currently in relative line number CLINE." + (if (string-match "\\`[0-9]+\\'" desc) (aref org-table-dlines (string-to-number desc)) - (setq cline (or cline (org-current-line)) - bline (or bline org-table-current-begin-line) - table (or table org-table-current-line-types)) - (if (or - (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) - ;; 1 2 3 4 5 6 - (and (not (match-end 3)) (not (match-end 6))) - (and (match-end 3) (match-end 6) (not (match-end 5)))) - (user-error "Invalid row descriptor `%s'" desc)) - (let* ((hdir (and (match-end 2) (match-string 2 desc))) - (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) - (odir (and (match-end 5) (match-string 5 desc))) - (on (if (match-end 6) (string-to-number (match-string 6 desc)))) - (i (- cline bline)) + (when (or (not (string-match + "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" + ;; 1 2 3 4 5 6 + desc)) + (and (not (match-end 3)) (not (match-end 6))) + (and (match-end 3) (match-end 6) (not (match-end 5)))) + (user-error "Invalid row descriptor `%s'" desc)) + (let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3)))) + (hdir (match-string 2 desc)) + (odir (match-string 5 desc)) + (on (and (match-end 6) (string-to-number (match-string 6 desc)))) (rel (and (match-end 6) (or (and (match-end 1) (not (match-end 3))) (match-end 5))))) - (if (and hn (not hdir)) - (progn - (setq i 0 hdir "+") - (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) - (if (and (not hn) on (not odir)) - (user-error "Should never happen");;(aref org-table-dlines on) - (if (and hn (> hn 0)) - (setq i (org-table-find-row-type table i 'hline (equal hdir "-") - nil hn cline desc))) - (if on - (setq i (org-table-find-row-type table i 'dline (equal odir "-") - rel on cline desc))) - (+ bline i))))) - -(defun org-table-find-row-type (table i type backwards relative n cline desc) - "FIXME: Needs more documentation." - (let ((l (length table))) - (while (> n 0) - (while (and (setq i (+ i (if backwards -1 1))) - (>= i 0) (< i l) - (not (eq (aref table i) type)) - (if (and relative (eq (aref table i) 'hline)) - (cond - ((eq org-table-relative-ref-may-cross-hline t) t) - ((eq org-table-relative-ref-may-cross-hline 'error) - (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) - (t (setq i (- i (if backwards -1 1)) - n 1) - nil)) - t))) - (setq n (1- n))) - (if (or (< i 0) (>= i l)) - (user-error "Row descriptor %s used in line %d leads outside table" - desc cline) - i))) - -(defun org-table-rewrite-old-row-references (s) - (if (string-match "&[-+0-9I]" s) - (user-error "Formula contains old &row reference, please rewrite using @-syntax") - s)) + (when (and hn (not hdir)) + (setq cline 0) + (setq hdir "+") + (when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn))) + (when (and (not hn) on (not odir)) (user-error "Should never happen")) + (when hn + (setq cline + (org-table--row-type 'hline hn cline (equal hdir "-") nil desc))) + (when on + (setq cline + (org-table--row-type 'dline on cline (equal odir "-") rel desc))) + cline))) + +(defun org-table--row-type (type n i backwards relative desc) + "Return relative line of Nth row with type TYPE. +Search starts from relative line I. When BACKWARDS in non-nil, +look before I. When RELATIVE is non-nil, the reference is +relative. DESC is the original descriptor that started the +search, as a string." + (let ((l (length org-table-current-line-types))) + (catch :exit + (dotimes (_ n) + (while (and (cl-incf i (if backwards -1 1)) + (>= i 0) + (< i l) + (not (eq (aref org-table-current-line-types i) type)) + ;; We are going to cross a hline. Check if this is + ;; an authorized move. + (cond + ((not relative)) + ((not (eq (aref org-table-current-line-types i) 'hline))) + ((eq org-table-relative-ref-may-cross-hline t)) + ((eq org-table-relative-ref-may-cross-hline 'error) + (user-error "Row descriptor %s crosses hline" desc)) + (t (cl-decf i (if backwards -1 1)) ; Step back. + (throw :exit nil))))))) + (cond ((or (< i 0) (>= i l)) + (user-error "Row descriptor %s leads outside table" desc)) + ;; The last hline doesn't exist. Instead, point to last row + ;; in table. + ((= i (1- l)) (1- i)) + (t i)))) + +(defun org-table--error-on-old-row-references (s) + (when (string-match "&[-+0-9I]" s) + (user-error "Formula contains old &row reference, please rewrite using @-syntax"))) (defun org-table-make-reference (elements keep-empty numbers lispp) "Convert list ELEMENTS to something appropriate to insert into formula. KEEP-EMPTY indicated to keep empty fields, default is to skip them. NUMBERS indicates that everything should be converted to numbers. LISPP non-nil means to return something appropriate for a Lisp -list, 'literal is for the format specifier L." +list, `literal' is for the format specifier L." ;; Calc nan (not a number) is used for the conversion of the empty ;; field to a reference for several reasons: (i) It is accepted in a ;; Calc formula (e. g. "" or "()" would result in a Calc error). @@ -2961,162 +3122,185 @@ list, 'literal is for the format specifier L." elements ",") "]")))) -;;;###autoload -(defun org-table-set-constants () - "Set `org-table-formula-constants-local' in the current buffer." - (let (cst consts const-str) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) - (setq const-str (substring-no-properties (match-string 1))) - (setq consts (append consts (org-split-string const-str "[ \t]+"))) - (when consts - (let (e) - (while (setq e (pop consts)) - (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (if (assoc-string (match-string 1 e) cst) - (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))))))) +(defun org-table-message-once-per-second (t1 &rest args) + "If there has been more than one second since T1, display message. +ARGS are passed as arguments to the `message' function. Returns +current time if a message is printed, otherwise returns T1. If +T1 is nil, always messages." + (let ((curtime (current-time))) + (if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1)))) + (progn (apply 'message args) + curtime) + t1))) ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. + With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' \ -\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if -it is the symbol `iterate', recompute the table until it no longer changes. + +When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \ +if ALL is the symbol `iterate', +recompute the table until it no longer changes. + If NOALIGN is not nil, do not re-align the table after the computations are done. This is typically used internally to save time, if it is known that the table will be realigned a little later anyway." (interactive "P") - (or (memq this-command org-recalc-commands) - (setq org-recalc-commands (cons this-command org-recalc-commands))) + (unless (memq this-command org-recalc-commands) + (push this-command org-recalc-commands)) (unless (org-at-table-p) (user-error "Not at a table")) (if (or (eq all 'iterate) (equal all '(16))) (org-table-iterate) - (org-table-get-specials) + (org-table-analyze) (let* ((eqlist (sort (org-table-get-stored-formulas) (lambda (a b) (string< (car a) (car b))))) - (eqlist1 (copy-sequence eqlist)) (inhibit-redisplay (not debug-on-error)) (line-re org-table-dataline-regexp) - (thisline (org-current-line)) - (thiscol (org-table-current-column)) - seen-fields lhs1 - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) - ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (when (string-match "\\`$[<>]" (car x)) - (setq lhs1 (car x)) - (setq x (cons (substring - (org-table-formula-handle-first/last-rc - (car x)) 1) - (cdr x))) - (if (assoc (car x) eqlist1) - (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" - lhs1 (car x)))) - (cons - (org-table-formula-handle-first/last-rc (car x)) - (org-table-formula-substitute-names - (org-table-formula-handle-first/last-rc (cdr x))))) - eqlist)) - ;; Split the equation list - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - ;; Expand ranges in lhs of formulas - (setq eqlname (org-table-expand-lhs-ranges eqlname)) - - ;; Get the correct line range to process - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (re-search-forward org-table-calculate-mark-regexp end t) - ;; This is a table with marked lines, compute selected lines - (setq line-re org-table-recalculate-regexp) - ;; Move forward to the first non-header line - (if (and (re-search-forward org-table-dataline-regexp end t) - (re-search-forward org-table-hline-regexp end t) - (re-search-forward org-table-dataline-regexp end t)) - (setq beg (match-beginning 0)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchable. - ;; Also check if several field/range formulas try to set the same field. - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (setq name1 name) - (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) - (nth 2 a)))) - (when (member name1 seen-fields) - (user-error "Several field/range formulas try to set %s" name1)) - (push name1 seen-fields) - - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (condition-case nil - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (error (user-error "Invalid row number in %s" - name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (org-goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - (setq eqlname1 (nreverse eqlname1)) - - ;; Now evaluate the column formulas, but skip fields covered by - ;; field formulas - (goto-char beg) - (while (re-search-forward line-re end t) - (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) - ;; Unprotected line, recalculate - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (org-goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (org-goto-line (nth 1 eq)) - (org-table-goto-column (nth 2 eq)) - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis)) - - (org-goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (org-goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) + (log-first-time (current-time)) + (log-last-time log-first-time) + (cnt 0) + beg end eqlcol eqlfield) + ;; Insert constants in all formulas. + (when eqlist + (org-table-save-field + ;; Expand equations, then split the equation list between + ;; column formulas and field formulas. + (dolist (eq eqlist) + (let* ((rhs (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc (cdr eq)))) + (old-lhs (car eq)) + (lhs + (org-table-formula-handle-first/last-rc + (cond + ((string-match "\\`@-?I+" old-lhs) + (user-error "Can't assign to hline relative reference")) + ((string-match "\\`$[<>]" old-lhs) + (let ((new (org-table-formula-handle-first/last-rc + old-lhs))) + (when (assoc new eqlist) + (user-error "\"%s=\" formula tries to overwrite \ +existing formula for column %s" + old-lhs + new)) + new)) + (t old-lhs))))) + (if (string-match-p "\\`\\$[0-9]+\\'" lhs) + (push (cons lhs rhs) eqlcol) + (push (cons lhs rhs) eqlfield)))) + (setq eqlcol (nreverse eqlcol)) + ;; Expand ranges in lhs of formulas + (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield))) + ;; Get the correct line range to process. + (if all + (progn + (setq end (copy-marker (org-table-end))) + (goto-char (setq beg org-table-current-begin-pos)) + (cond + ((re-search-forward org-table-calculate-mark-regexp end t) + ;; This is a table with marked lines, compute selected + ;; lines. + (setq line-re org-table-recalculate-regexp)) + ;; Move forward to the first non-header line. + ((and (re-search-forward org-table-dataline-regexp end t) + (re-search-forward org-table-hline-regexp end t) + (re-search-forward org-table-dataline-regexp end t)) + (setq beg (match-beginning 0))) + ;; Just leave BEG at the start of the table. + (t nil))) + (setq beg (line-beginning-position) + end (copy-marker (line-beginning-position 2)))) + (goto-char beg) + ;; Mark named fields untouchable. Also check if several + ;; field/range formulas try to set the same field. + (remove-text-properties beg end '(org-untouchable t)) + (let ((current-line (count-lines org-table-current-begin-pos + (line-beginning-position))) + seen-fields) + (dolist (eq eqlfield) + (let* ((name (car eq)) + (location (assoc name org-table-named-field-locations)) + (eq-line (or (nth 1 location) + (and (string-match "\\`@\\([0-9]+\\)" name) + (aref org-table-dlines + (string-to-number + (match-string 1 name)))))) + (reference + (if location + ;; Turn field coordinates associated to NAME + ;; into an absolute reference. + (format "@%d$%d" + (org-table-line-to-dline eq-line) + (nth 2 location)) + name))) + (when (member reference seen-fields) + (user-error "Several field/range formulas try to set %s" + reference)) + (push reference seen-fields) + (when (or all (eq eq-line current-line)) + (org-table-goto-field name) + (org-table-put-field-property :org-untouchable t))))) + ;; Evaluate the column formulas, but skip fields covered by + ;; field formulas. + (goto-char beg) + (while (re-search-forward line-re end t) + (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1)) + ;; Unprotected line, recalculate. + (cl-incf cnt) + (when all + (setq log-last-time + (org-table-message-once-per-second + log-last-time + "Re-applying formulas to full table...(line %d)" cnt))) + (if (markerp org-last-recalc-line) + (move-marker org-last-recalc-line (line-beginning-position)) + (setq org-last-recalc-line + (copy-marker (line-beginning-position)))) + (dolist (entry eqlcol) + (goto-char org-last-recalc-line) + (org-table-goto-column + (string-to-number (substring (car entry) 1)) nil 'force) + (unless (get-text-property (point) :org-untouchable) + (org-table-eval-formula + nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis))))) + ;; Evaluate the field formulas. + (dolist (eq eqlfield) + (let ((reference (car eq)) + (formula (cdr eq))) + (setq log-last-time + (org-table-message-once-per-second + (and all log-last-time) + "Re-applying formula to field: %s" (car eq))) + (org-table-goto-field + reference + ;; Possibly create a new column, as long as + ;; `org-table-formula-create-columns' allows it. + (let ((column-count (progn (end-of-line) + (1- (org-table-current-column))))) + (lambda (column) + (when (> column 1000) + (user-error "Formula column target too large")) + (and (> column column-count) + (or (eq org-table-formula-create-columns t) + (and (eq org-table-formula-create-columns 'warn) + (progn + (org-display-warning + "Out-of-bounds formula added columns") + t)) + (and (eq org-table-formula-create-columns 'prompt) + (yes-or-no-p + "Out-of-bounds formula. Add columns? "))))))) + (org-table-eval-formula nil formula t t t t)))) + ;; Clean up markers and internal text property. + (remove-text-properties (point-min) (point-max) '(org-untouchable t)) + (set-marker end nil) + (unless noalign + (when org-table-may-need-update (org-table-align)) + (when all + (org-table-message-once-per-second + log-first-time "Re-applying formulas to %d lines... done" cnt))) + (org-table-message-once-per-second + (and all log-first-time) "Re-applying formulas... done"))))) ;;;###autoload (defun org-table-iterate (&optional arg) @@ -3145,10 +3329,15 @@ with the prefix ARG." (defun org-table-recalculate-buffer-tables () "Recalculate all tables in the current buffer." (interactive) - (save-excursion - (save-restriction - (widen) - (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + (org-with-wide-buffer + (org-table-map-tables + (lambda () + ;; Reason for separate `org-table-align': When repeating + ;; (org-table-recalculate t) `org-table-may-need-update' gets in + ;; the way. + (org-table-recalculate t t) + (org-table-align)) + t))) ;;;###autoload (defun org-table-iterate-buffer-tables () @@ -3158,85 +3347,90 @@ with the prefix ARG." (i imax) (checksum (md5 (buffer-string))) c1) - (save-excursion - (save-restriction - (widen) - (catch 'exit - (while (> i 0) - (setq i (1- i)) - (org-table-map-tables (lambda () (org-table-recalculate t)) t) - (if (equal checksum (setq c1 (md5 (buffer-string)))) - (progn - (message "Convergence after %d iterations" (- imax i)) - (throw 'exit t)) - (setq checksum c1))) - (user-error "No convergence after %d iterations" imax)))))) + (org-with-wide-buffer + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (org-table-map-tables #'org-table-align t) + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (org-table-map-tables #'org-table-align t) + (user-error "No convergence after %d iterations" imax))))) (defun org-table-calc-current-TBLFM (&optional arg) "Apply the #+TBLFM in the line at point to the table." (interactive "P") (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) (let ((formula (buffer-substring - (point-at-bol) - (point-at-eol))) - s e) + (line-beginning-position) + (line-end-position)))) (save-excursion ;; Insert a temporary formula at right after the table (goto-char (org-table-TBLFM-begin)) - (setq s (point-marker)) - (insert (concat formula "\n")) - (setq e (point-marker)) - ;; Recalculate the table - (beginning-of-line 0) ; move to the inserted line - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) + (let ((s (point-marker))) + (insert formula "\n") + (let ((e (point-marker))) + ;; Recalculate the table. + (beginning-of-line 0) ; move to the inserted line + (skip-chars-backward " \r\n\t") (unwind-protect - (org-call-with-arg 'org-table-recalculate (or arg t)) - ;; delete the formula inserted temporarily - (delete-region s e)))))) + (org-call-with-arg #'org-table-recalculate (or arg t)) + ;; Delete the formula inserted temporarily. + (delete-region s e) + (set-marker s nil) + (set-marker e nil))))))) (defun org-table-TBLFM-begin () "Find the beginning of the TBLFM lines and return its position. Return nil when the beginning of TBLFM line was not found." (save-excursion (when (progn (forward-line 1) - (re-search-backward - org-table-TBLFM-begin-regexp - nil t)) - (point-at-bol 2)))) + (re-search-backward org-table-TBLFM-begin-regexp nil t)) + (line-beginning-position 2)))) (defun org-table-expand-lhs-ranges (equations) "Expand list of formulas. -If some of the RHS in the formulas are ranges or a row reference, expand -them to individual field equations for each field." - (let (e res lhs rhs range r1 r2 c1 c2) - (while (setq e (pop equations)) - (setq lhs (car e) rhs (cdr e)) - (cond - ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs) - ;; This just refers to one fixed field - (push e res)) - ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs) - ;; This just refers to one fixed named field - (push e res)) - ((string-match "^@[0-9]+$" lhs) - (loop for ic from 1 to org-table-current-ncol do - (push (cons (format "%s$%d" lhs ic) rhs) res) - (put-text-property 0 (length (caar res)) - :orig-eqn e (caar res)))) - (t - (setq range (org-table-get-range lhs org-table-current-begin-pos - 1 nil 'corners)) - (setq r1 (nth 0 range) c1 (nth 1 range) - r2 (nth 2 range) c2 (nth 3 range)) - (setq r1 (org-table-line-to-dline r1)) - (setq r2 (org-table-line-to-dline r2 'above)) - (loop for ir from r1 to r2 do - (loop for ic from c1 to c2 do - (push (cons (format "@%d$%d" ir ic) rhs) res) - (put-text-property 0 (length (caar res)) - :orig-eqn e (caar res))))))) - (nreverse res))) +If some of the RHS in the formulas are ranges or a row reference, +expand them to individual field equations for each field. This +function assumes the table is already analyzed (i.e., using +`org-table-analyze')." + (let (res) + (dolist (e equations (nreverse res)) + (let ((lhs (car e)) + (rhs (cdr e))) + (cond + ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) + ;; This just refers to one fixed field. + (push e res)) + ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) + ;; This just refers to one fixed named field. + (push e res)) + ((string-match-p "\\`\\$[0-9]+\\'" lhs) + ;; Column formulas are treated specially and are not + ;; expanded. + (push e res)) + ((string-match "\\`@[0-9]+\\'" lhs) + (dotimes (ic org-table-current-ncol) + (push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e) + rhs) + res))) + (t + (let* ((range (org-table-get-range + lhs org-table-current-begin-pos 1 nil 'corners)) + (r1 (org-table-line-to-dline (nth 0 range))) + (c1 (nth 1 range)) + (r2 (org-table-line-to-dline (nth 2 range) 'above)) + (c2 (nth 3 range))) + (cl-loop for ir from r1 to r2 do + (cl-loop for ic from c1 to c2 do + (push (cons (propertize + (format "@%d$%d" ir ic) :orig-eqn e) + rhs) + res)))))))))) (defun org-table-formula-handle-first/last-rc (s) "Replace @<, @>, $<, $> with first/last row/column of the table. @@ -3262,32 +3456,40 @@ borders of the table using the @< @> $< $> makers." (- nmax len -1))) (if (or (< n 1) (> n nmax)) (user-error "Reference \"%s\" in expression \"%s\" points outside table" - (match-string 0 s) s)) + (match-string 0 s) s)) (setq start (match-beginning 0)) (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) s) (defun org-table-formula-substitute-names (f) "Replace $const with values in string F." - (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) - ;; First, check for column names - (while (setq start (string-match org-table-column-name-regexp f start)) - (setq start (1+ start)) - (setq a (assoc (match-string 1 f) org-table-column-names)) - (setq f (replace-match (concat "$" (cdr a)) t t f))) - ;; Parameters and constants - (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\]" (car entry)) 'column) - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "^[0-9]" (car entry)) 'column) - (t 'named))) - (when (setq title (assq type titles)) - (or (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (remove title titles))) - (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") - (car entry) " = " (cdr entry) "\n")) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)) - (if (eq org-table-use-standard-references t) + (let ((at-tblfm (org-at-TBLFM-p))) + (unless (or at-tblfm (org-at-table-p)) + (user-error "Not at a table")) + (save-excursion + ;; Move point within the table before analyzing it. + (when at-tblfm (re-search-backward "^[ \t]*|")) + (org-table-analyze)) + (let ((key (org-table-current-field-formula 'key 'noerror)) + (eql (sort (org-table-get-stored-formulas t (and at-tblfm (point))) + #'org-table-formula-less-p)) + (pos (point-marker)) + (source (copy-marker (line-beginning-position))) + (startline 1) + (wc (current-window-configuration)) + (sel-win (selected-window)) + (titles '((column . "# Column Formulas\n") + (field . "# Field and Range Formulas\n") + (named . "# Named Field Formulas\n")))) + (org-switch-to-buffer-other-window "*Edit Formulas*") + (erase-buffer) + ;; Keep global-font-lock-mode from turning on font-lock-mode + (let ((font-lock-global-modes '(not fundamental-mode))) + (fundamental-mode)) + (setq-local font-lock-global-modes (list 'not major-mode)) + (setq-local org-pos pos) + (setq-local org-table--fedit-source source) + (setq-local org-window-configuration wc) + (setq-local org-selected-window sel-win) + (use-local-map org-table-fedit-map) + (add-hook 'post-command-hook #'org-table-fedit-post-command t t) + (easy-menu-add org-table-fedit-menu) + (setq startline (org-current-line)) + (dolist (entry eql) + (let* ((type (cond + ((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry)) + 'column) + ((equal (string-to-char (car entry)) ?@) 'field) + (t 'named))) + (title (assq type titles))) + (when title + (unless (bobp) (insert "\n")) + (insert + (org-add-props (cdr title) nil 'face font-lock-comment-face)) + (setq titles (remove title titles))) + (when (equal key (car entry)) (setq startline (org-current-line))) + (let ((s (concat + (if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$") + (car entry) " = " (cdr entry) "\n"))) + (remove-text-properties 0 (length s) '(face nil) s) + (insert s)))) + (when (eq org-table-use-standard-references t) (org-table-fedit-toggle-ref-type)) - (org-goto-line startline) - (message "%s" "Edit formulas, finish with C-c C-c or C-c '. See menu for more commands."))) + (org-goto-line startline) + (message "%s" (substitute-command-keys "\\\ +Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \ +See menu for more commands."))))) (defun org-table-fedit-post-command () (when (not (memq this-command '(lisp-complete-symbol))) (let ((win (selected-window))) (save-excursion - (condition-case nil - (org-table-show-reference) - (error nil)) + (ignore-errors (org-table-show-reference)) (select-window win))))) (defun org-table-formula-to-user (s) @@ -3537,23 +3748,24 @@ minutes or seconds." (format "%.1f" (/ (float secs0) 60))) ((eq output-format 'seconds) (format "%d" secs0)) - (t (org-format-seconds "%.2h:%.2m:%.2s" secs0))))) + (t (format-seconds "%.2h:%.2m:%.2s" secs0))))) (if (< secs 0) (concat "-" res) res))) (defun org-table-fedit-convert-buffer (function) "Convert all references in this buffer, using FUNCTION." - (let ((line (org-current-line))) + (let ((origin (copy-marker (line-beginning-position)))) (goto-char (point-min)) (while (not (eobp)) - (insert (funcall function (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)) - (or (eobp) (forward-char 1))) - (org-goto-line line))) + (insert (funcall function (buffer-substring (point) (line-end-position)))) + (delete-region (point) (line-end-position)) + (forward-line)) + (goto-char origin) + (set-marker origin nil))) (defun org-table-fedit-toggle-ref-type () "Convert all references in the buffer from B3 to @3$2 and back." (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) + (setq-local org-table-buffer-is-an (not org-table-buffer-is-an)) (org-table-fedit-convert-buffer (if org-table-buffer-is-an 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) @@ -3579,16 +3791,16 @@ minutes or seconds." (defun org-table-fedit-shift-reference (dir) (cond - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") + ((org-in-regexp "\\(\\<[a-zA-Z]\\)&") (if (memq dir '(left right)) (org-rematch-and-replace 1 (eq dir 'left)) (user-error "Cannot shift reference in this direction"))) - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") + ((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") ;; A B3-like reference (if (memq dir '(up down)) (org-rematch-and-replace 2 (eq dir 'up)) (org-rematch-and-replace 1 (eq dir 'left)))) - ((org-at-regexp-p + ((org-in-regexp "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") ;; An internal reference (if (memq dir '(up down)) @@ -3649,32 +3861,31 @@ a translation reference." With prefix ARG, apply the new formulas to the table." (interactive "P") (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) (sel-win org-selected-window) eql var form) + (when org-table-use-standard-references + (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) + (setq org-table-buffer-is-an nil)) + (let ((pos org-pos) + (sel-win org-selected-window) + (source org-table--fedit-source) + eql) (goto-char (point-min)) (while (re-search-forward "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (user-error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) + (let ((var (match-string 1)) + (form (org-trim (match-string 3)))) + (unless (equal form "") + (while (string-match "[ \t]*\n[ \t]*" form) + (setq form (replace-match " " t t form))) + (when (assoc var eql) + (user-error "Double formulas for %s" var)) + (push (cons var form) eql)))) (set-window-configuration org-window-configuration) (select-window sel-win) - (goto-char pos) - (unless (org-at-table-p) - (user-error "Lost table position - cannot install formulas")) + (goto-char source) (org-table-store-formulas eql) - (move-marker pos nil) + (set-marker pos nil) + (set-marker source nil) (kill-buffer "*Edit Formulas*") (if arg (org-table-recalculate 'all) @@ -3733,9 +3944,11 @@ With prefix ARG, apply the new formulas to the table." (defvar org-show-positions nil) (defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." + "Show the location/value of the $ expression at point. +When LOCAL is non-nil, show references for the table at point." (interactive) (org-table-remove-rectangle-highlight) + (when local (org-table-analyze)) (catch 'exit (let ((pos (if local (point) org-pos)) (face2 'highlight) @@ -3743,41 +3956,41 @@ With prefix ARG, apply the new formulas to the table." (win (selected-window)) (org-show-positions nil) var name e what match dest) - (if local (org-table-get-specials)) (setq what (cond - ((org-at-regexp-p "^@[0-9]+[ \t=]") + ((org-in-regexp "^@[0-9]+[ \t=]") (setq match (concat (substring (match-string 0) 0 -1) "$1.." (substring (match-string 0) 0 -1) "$100")) 'range) - ((or (org-at-regexp-p org-table-range-regexp2) - (org-at-regexp-p org-table-translate-regexp) - (org-at-regexp-p org-table-range-regexp)) + ((or (org-in-regexp org-table-range-regexp2) + (org-in-regexp org-table-translate-regexp) + (org-in-regexp org-table-range-regexp)) (setq match (save-match-data (org-table-convert-refs-to-rc (match-string 0)))) 'range) - ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) - ((org-at-regexp-p "\\$[0-9]+") 'column) + ((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) + ((org-in-regexp "\\$[0-9]+") 'column) ((not local) nil) (t (user-error "No reference at point"))) match (and what (or match (match-string 0)))) (when (and match (not (equal (match-beginning 0) (point-at-bol)))) (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) 'secondary-selection)) - (org-add-hook 'before-change-functions - 'org-table-remove-rectangle-highlight) - (if (eq what 'name) (setq var (substring match 1))) + (add-hook 'before-change-functions + #'org-table-remove-rectangle-highlight) + (when (eq what 'name) (setq var (substring match 1))) (when (eq what 'range) - (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) + (unless (eq (string-to-char match) ?@) (setq match (concat "@" match))) (setq match (org-table-formula-substitute-names match))) (unless local (save-excursion - (end-of-line 1) + (end-of-line) (re-search-backward "^\\S-" nil t) - (beginning-of-line 1) - (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") + (beginning-of-line) + (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\ +\\([0-9]+\\|&\\)\\) *=") (setq dest (save-match-data (org-table-convert-refs-to-rc (match-string 1)))) @@ -3790,60 +4003,52 @@ With prefix ARG, apply the new formulas to the table." (marker-buffer pos))))) (goto-char pos) (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) - (cond - ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (setq e (assoc name org-table-named-field-locations)) - (org-goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e))) - ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) - (let ((l (string-to-number (match-string 1 dest))) - (c (string-to-number (match-string 2 dest)))) - (org-goto-line (aref org-table-dlines l)) - (org-table-goto-column c))) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (condition-case nil - (save-excursion - (org-table-get-range match nil nil 'highlight)) - (error nil))) - ((setq e (assoc var org-table-named-field-locations)) - (org-goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e)) - (org-table-highlight-rectangle (point) (point)) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle (point) (point)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (user-error "Column name not found"))) - ((eq what 'column) - ;; column number - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle (point) (point)) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (user-error "Parameter not found"))) - (t + (let ((table-start + (if local org-table-current-begin-pos (org-table-begin)))) + (when dest + (setq name (substring dest 1)) + (cond + ((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) + (org-table-goto-field dest)) + ((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" + dest) + (org-table-goto-field dest)) + (t (org-table-goto-column (string-to-number name)))) + (move-marker pos (point)) + (org-table-highlight-rectangle nil nil face2)) (cond + ((equal dest match)) + ((not match)) + ((eq what 'range) + (ignore-errors (org-table-get-range match table-start nil 'highlight))) + ((setq e (assoc var org-table-named-field-locations)) + (org-table-goto-field var) + (org-table-highlight-rectangle) + (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) + ((setq e (assoc var org-table-column-names)) + (org-table-goto-column (string-to-number (cdr e))) + (org-table-highlight-rectangle) + (goto-char table-start) + (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") + (org-table-end) t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Named column (column %s)" (cdr e))) + (user-error "Column name not found"))) + ((eq what 'column) + ;; Column number. + (org-table-goto-column (string-to-number (substring match 1))) + (org-table-highlight-rectangle) + (message "Column %s" (substring match 1))) + ((setq e (assoc var org-table-local-parameters)) + (goto-char table-start) + (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Local parameter.")) + (user-error "Parameter not found"))) ((not var) (user-error "No reference at point")) ((setq e (assoc var org-table-formula-constants-local)) (message "Local Constant: $%s=%s in #+CONSTANTS line." @@ -3854,19 +4059,19 @@ With prefix ARG, apply the new formulas to the table." ((setq e (and (fboundp 'constants-get) (constants-get var))) (message "Constant: $%s=%s, from `constants.el'%s." var e (format " (%s units)" constants-unit-system))) - (t (user-error "Undefined name $%s" var))))) - (goto-char pos) - (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) - (push pos org-show-positions) - (push org-table-current-begin-pos org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (set-window-start (selected-window) min) - (goto-char max) - (or (pos-visible-in-window-p max) - (set-window-start (selected-window) max)))) + (t (user-error "Undefined name $%s" var))) + (goto-char pos) + (when (and org-show-positions + (not (memq this-command '(org-table-fedit-scroll + org-table-fedit-scroll-down)))) + (push pos org-show-positions) + (push table-start org-show-positions) + (let ((min (apply 'min org-show-positions)) + (max (apply 'max org-show-positions))) + (set-window-start (selected-window) min) + (goto-char max) + (or (pos-visible-in-window-p max) + (set-window-start (selected-window) max))))) (select-window win)))) (defun org-table-force-dataline () @@ -3926,43 +4131,49 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." (push ov org-table-rectangle-overlays))) (defun org-table-highlight-rectangle (&optional beg end face) - "Highlight rectangular region in a table." - (setq beg (or beg (point)) end (or end (point))) - (let ((b (min beg end)) - (e (max beg end)) - l1 c1 l2 c2 tmp) - (and (boundp 'org-show-positions) - (setq org-show-positions (cons b (cons e org-show-positions)))) - (goto-char (min beg end)) - (setq l1 (org-current-line) - c1 (org-table-current-column)) - (goto-char (max beg end)) - (setq l2 (org-current-line) - c2 (org-table-current-column)) - (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (org-goto-line l1) - (beginning-of-line 1) - (loop for line from l1 to l2 do - (when (looking-at org-table-dataline-regexp) - (org-table-goto-column c1) - (skip-chars-backward "^|\n") (setq beg (point)) - (org-table-goto-column c2) - (skip-chars-forward "^|\n") (setq end (point)) - (org-table-add-rectangle-overlay beg end face)) - (beginning-of-line 2)) - (goto-char b)) - (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) - -(defun org-table-remove-rectangle-highlight (&rest ignore) + "Highlight rectangular region in a table. +When buffer positions BEG and END are provided, use them to +delimit the region to highlight. Otherwise, refer to point. Use +FACE, when non-nil, for the highlight." + (let* ((beg (or beg (point))) + (end (or end (point))) + (b (min beg end)) + (e (max beg end)) + (start-coordinates + (save-excursion + (goto-char b) + (cons (line-beginning-position) (org-table-current-column)))) + (end-coordinates + (save-excursion + (goto-char e) + (cons (line-beginning-position) (org-table-current-column))))) + (when (boundp 'org-show-positions) + (setq org-show-positions (cons b (cons e org-show-positions)))) + (goto-char (car start-coordinates)) + (let ((column-start (min (cdr start-coordinates) (cdr end-coordinates))) + (column-end (max (cdr start-coordinates) (cdr end-coordinates))) + (last-row (car end-coordinates))) + (while (<= (point) last-row) + (when (looking-at org-table-dataline-regexp) + (org-table-goto-column column-start) + (skip-chars-backward "^|\n") + (let ((p (point))) + (org-table-goto-column column-end) + (skip-chars-forward "^|\n") + (org-table-add-rectangle-overlay p (point) face))) + (forward-line))) + (goto-char (car start-coordinates))) + (add-hook 'before-change-functions #'org-table-remove-rectangle-highlight)) + +(defun org-table-remove-rectangle-highlight (&rest _ignore) "Remove the rectangle overlays." (unless org-inhibit-highlight-removal (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) (mapc 'delete-overlay org-table-rectangle-overlays) (setq org-table-rectangle-overlays nil))) -(defvar org-table-coordinate-overlays nil +(defvar-local org-table-coordinate-overlays nil "Collects the coordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) (defun org-table-overlay-coordinates () "Add overlays to the table at point, to show row/column coordinates." @@ -4017,19 +4228,20 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;;; The orgtbl minor mode ;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. +;; integrate the Org table editor. + +;; This is really a hack, because the Org table editor uses several +;; keys which normally belong to the major mode, for example the TAB +;; and RET keys. Here is how it works: The minor mode defines all the +;; keys necessary to operate the table editor, but wraps the commands +;; into a function which tests if the cursor is currently inside +;; a table. If that is the case, the table editor command is +;; executed. However, when any of those keys is used outside a table, +;; the function uses `key-binding' to look up if the key has an +;; associated command in another currently active keymap (minor modes, +;; major mode, global), and executes that command. There might be +;; problems if any of the keys used by the table editor is otherwise +;; used as a prefix key. ;; Another challenge is that the key binding for TAB can be tab or \C-i, ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode @@ -4079,16 +4291,16 @@ Use COMMAND to do the motion, repeat if necessary to end up in a data line." ;; FIXME: maybe it should use emulation-mode-map-alists? (and c (setq minor-mode-map-alist (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) + (setq-local org-table-may-need-update t) + (add-hook 'before-change-functions 'org-before-change-function + nil 'local) + (setq-local org-old-auto-fill-inhibit-regexp + auto-fill-inhibit-regexp) + (setq-local auto-fill-inhibit-regexp + (if auto-fill-inhibit-regexp + (concat orgtbl-line-start-regexp "\\|" + auto-fill-inhibit-regexp) + orgtbl-line-start-regexp)) (add-to-invisibility-spec '(org-cwidth)) (when (fboundp 'font-lock-add-keywords) (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) @@ -4188,27 +4400,26 @@ to execute outside of tables." cmd (orgtbl-make-binding fun nfunc key)) (org-defkey orgtbl-mode-map key cmd)) - ;; Special treatment needed for TAB and RET + ;; Special treatment needed for TAB, RET and DEL (org-defkey orgtbl-mode-map [(return)] (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) (org-defkey orgtbl-mode-map "\C-m" (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - (org-defkey orgtbl-mode-map [(tab)] (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) (org-defkey orgtbl-mode-map "\C-i" (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - (org-defkey orgtbl-mode-map [(shift tab)] (orgtbl-make-binding 'org-table-previous-field 104 [(shift tab)] [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map [backspace] + (orgtbl-make-binding 'org-delete-backward-char 109 + [backspace] (kbd "DEL"))) - - (unless (featurep 'xemacs) - (org-defkey orgtbl-mode-map [S-iso-lefttab] - (orgtbl-make-binding 'org-table-previous-field 107 - [S-iso-lefttab] [backtab] [(shift tab)] - [(tab)] "\C-i"))) + (org-defkey orgtbl-mode-map [S-iso-lefttab] + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i")) (org-defkey orgtbl-mode-map [backtab] (orgtbl-make-binding 'org-table-previous-field 108 @@ -4290,7 +4501,10 @@ to execute outside of tables." org-table-toggle-coordinate-overlays :active (org-at-table-p) :keys "C-c }" :style toggle :selected org-table-overlay-coordinates] - )) + "--" + ("Plot" + ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"] + ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"]))) t)) (defun orgtbl-ctrl-c-ctrl-c (arg) @@ -4316,7 +4530,6 @@ With prefix arg, also recompute table." (when (orgtbl-send-table 'maybe) (run-hooks 'orgtbl-after-send-table-hook))) ((eq action 'recalc) - (org-table-set-constants) (save-excursion (beginning-of-line 1) (skip-chars-backward " \r\n\t") @@ -4325,7 +4538,7 @@ With prefix arg, also recompute table." (t (let (orgtbl-mode) (call-interactively (key-binding "\C-c\C-c"))))))) -(defun orgtbl-create-or-convert-from-region (arg) +(defun orgtbl-create-or-convert-from-region (_arg) "Create table or convert region to table, if no conflicting binding. This installs the table binding `C-c |', but only if there is no conflicting binding to this key outside orgtbl-mode." @@ -4369,11 +4582,9 @@ overwritten, and the table is not marked as requiring realignment." (org-table-blank-field)) t) (eq N 1) - (looking-at "[^|\n]* +|")) + (looking-at "[^|\n]* \\( \\)|")) (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (org-delete-backward-char 1) - (goto-char (match-beginning 0)) + (delete-region (match-beginning 1) (match-end 1)) (self-insert-command N)) (setq org-table-may-need-update t) (let* (orgtbl-mode @@ -4398,6 +4609,7 @@ overwritten, and the table is not marked as requiring realignment." (setq org-self-insert-command-undo-counter (1+ org-self-insert-command-undo-counter)))))))) +;;;###autoload (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" "Regular expression matching exponentials as produced by calc.") @@ -4418,23 +4630,24 @@ a radio table." (beginning-of-line 0))) rtn))) -(defun orgtbl-send-replace-tbl (name txt) - "Find and replace table NAME with TXT." +(defun orgtbl-send-replace-tbl (name text) + "Find and replace table NAME with TEXT." (save-excursion (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (user-error "Don't know where to insert translated table")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (save-excursion - (let ((beg (point))) - (unless (re-search-forward - (concat "END +RECEIVE +ORGTBL +" name) nil t) - (user-error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)))) - (insert txt "\n"))) + (let* ((location-flag nil) + (name (regexp-quote name)) + (begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)) + (end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))) + (while (re-search-forward begin-re nil t) + (unless location-flag (setq location-flag t)) + (let ((beg (line-beginning-position 2))) + (unless (re-search-forward end-re nil t) + (user-error "Cannot find end of receiver location at %d" beg)) + (beginning-of-line) + (delete-region beg (point)) + (insert text "\n"))) + (unless location-flag + (user-error "No valid receiver location found in the buffer"))))) ;;;###autoload (defun org-table-to-lisp (&optional txt) @@ -4442,76 +4655,43 @@ a radio table." The structure will be a list. Each item is either the symbol `hline' for a horizontal separator line, or a list of field values as strings. The table is taken from the parameter TXT, or from the buffer at point." - (unless txt - (unless (org-at-table-p) - (user-error "No table at point"))) - (let* ((txt (or txt - (buffer-substring-no-properties (org-table-begin) - (org-table-end)))) - (lines (org-split-string txt "[ \t]*\n[ \t]*"))) - - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines))) + (unless (or txt (org-at-table-p)) (user-error "No table at point")) + (let ((txt (or txt + (buffer-substring-no-properties (org-table-begin) + (org-table-end))))) + (mapcar (lambda (x) + (if (string-match org-table-hline-regexp x) 'hline + (org-split-string (org-trim x) "\\s-*|\\s-*"))) + (org-split-string txt "[ \t]*\n[ \t]*")))) (defun orgtbl-send-table (&optional maybe) - "Send a transformed version of this table to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this table." + "Send a transformed version of table at point to the receiver position. +With argument MAYBE, fail quietly if no transformation is defined +for this table." (interactive) (catch 'exit (unless (org-at-table-p) (user-error "Not at a table")) ;; when non-interactive, we assume align has just happened. - (when (org-called-interactively-p 'any) (org-table-align)) + (when (called-interactively-p 'any) (org-table-align)) (let ((dests (orgtbl-gather-send-defs)) - (txt (buffer-substring-no-properties (org-table-begin) - (org-table-end))) + (table (org-table-to-lisp + (buffer-substring-no-properties (org-table-begin) + (org-table-end)))) (ntbl 0)) - (unless dests (if maybe (throw 'exit nil) - (user-error "Don't know how to transform this table"))) + (unless dests + (if maybe (throw 'exit nil) + (user-error "Don't know how to transform this table"))) (dolist (dest dests) - (let* ((name (plist-get dest :name)) - (transform (plist-get dest :transform)) - (params (plist-get dest :params)) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (no-escape (plist-get params :no-escape)) - beg - (lines (org-table-clean-before-export - (nthcdr (or skip 0) - (org-split-string txt "[ \t]*\n[ \t]*")))) - (i0 (if org-table-clean-did-remove-column 2 1)) - (lines (if no-escape lines - (mapcar (lambda(l) (replace-regexp-in-string - "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines))) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0)) - (txt (if (fboundp transform) - (funcall transform table params) - (user-error "No such transformation function %s" transform)))) - (orgtbl-send-replace-tbl name txt)) - (setq ntbl (1+ ntbl))) + (let ((name (plist-get dest :name)) + (transform (plist-get dest :transform)) + (params (plist-get dest :params))) + (unless (fboundp transform) + (user-error "No such transformation function %s" transform)) + (orgtbl-send-replace-tbl name (funcall transform table params))) + (cl-incf ntbl)) (message "Table converted and installed at %d receiver location%s" ntbl (if (> ntbl 1) "s" "")) - (if (> ntbl 0) - ntbl - nil)))) + (and (> ntbl 0) ntbl)))) (defun org-remove-by-index (list indices &optional i0) "Remove the elements in LIST with indices in INDICES. @@ -4561,356 +4741,512 @@ First element has index 0, or I0 if given." (insert txt) (goto-char pos))) -;; Dynamically bound input and output for table formatting. -(defvar *orgtbl-table* nil - "Carries the current table through formatting routines.") -(defvar *orgtbl-rtn* nil - "Formatting routines push the output lines here.") -;; Formatting parameters for the current table section. -(defvar *orgtbl-hline* nil "Text used for horizontal lines.") -(defvar *orgtbl-sep* nil "Text used as a column separator.") -(defvar *orgtbl-default-fmt* nil "Default format for each entry.") -(defvar *orgtbl-fmt* nil "Format for each entry.") -(defvar *orgtbl-efmt* nil "Format for numbers.") -(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") -(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") -(defvar *orgtbl-lstart* nil "Text starting a row.") -(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") -(defvar *orgtbl-lend* nil "Text ending a row.") -(defvar *orgtbl-llend* nil "Specializes lend for the last row.") - -(defsubst orgtbl-get-fmt (fmt i) - "Retrieve the format from FMT corresponding to the Ith column." - (if (and (not (functionp fmt)) (consp fmt)) - (plist-get fmt i) - fmt)) - -(defsubst orgtbl-apply-fmt (fmt &rest args) - "Apply format FMT to arguments ARGS. -When FMT is nil, return the first argument from ARGS." - (cond ((functionp fmt) (apply fmt args)) - (fmt (apply 'format fmt args)) - (args (car args)) - (t args))) - -(defsubst orgtbl-eval-str (str) - "If STR is a function, evaluate it with no arguments." - (if (functionp str) - (funcall str) - str)) - -(defun orgtbl-format-line (line) - "Format LINE as a table row." - (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*)) - (let* ((i 0) - (line - (mapcar - (lambda (f) - (setq i (1+ i)) - (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i)) - (f (if (and efmt (string-match orgtbl-exp-regexp f)) - (orgtbl-apply-fmt efmt (match-string 1 f) - (match-string 2 f)) - f))) - (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i) - *orgtbl-default-fmt*) - f))) - line))) - (push (if *orgtbl-lfmt* - (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) - (concat (orgtbl-eval-str *orgtbl-lstart*) - (mapconcat 'identity line *orgtbl-sep*) - (orgtbl-eval-str *orgtbl-lend*))) - *orgtbl-rtn*)))) - -(defun orgtbl-format-section (section-stopper) - "Format lines until the first occurrence of SECTION-STOPPER." - (let (prevline) - (progn - (while (not (eq (car *orgtbl-table*) section-stopper)) - (if prevline (orgtbl-format-line prevline)) - (setq prevline (pop *orgtbl-table*))) - (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*) - (*orgtbl-lend* *orgtbl-llend*) - (*orgtbl-lfmt* *orgtbl-llfmt*)) - (orgtbl-format-line prevline)))))) - ;;;###autoload -(defun orgtbl-to-generic (table params &optional backend) +(defun orgtbl-to-generic (table params) "Convert the orgtbl-mode TABLE to some other format. + This generic routine can be used for many standard cases. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -A third optional argument BACKEND can be used to convert the content of -the cells using a specific export back-end. -For the generic converter, some parameters are obligatory: you need to -specify either :lfmt, or all of (:lstart :lend :sep). +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that +line. PARAMS is a property list of parameters that can +influence the conversion. Valid parameters are: -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. When :splice - is non-nil, this also means that the exporter should not look - for and interpret header and footer sections. +:backend, :raw + + Export back-end used as a basis to transcode elements of the + table, when no specific parameter applies to it. It is also + used to translate cells contents. You can prevent this by + setting :raw property to a non-nil value. -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. +:splice -:sep Separator between two fields -:remove-nil-lines Do not include lines that evaluate to nil. + When non-nil, only convert rows, not the table itself. This is + equivalent to setting to the empty string both :tstart + and :tend, which see. + +:skip + + When set to an integer N, skip the first N lines of the table. + Horizontal separation lines do count for this parameter! + +:skipcols + + List of columns that should be skipped. If the table has + a column with calculation marks, that column is automatically + discarded beforehand. + +:hline + + String to be inserted on horizontal separation lines. May be + nil to ignore these lines altogether. + +:sep + + Separator between two fields, as a string. Each in the following group may be either a string or a function of no arguments returning a string: -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. -:lstart String to start a new table line. -:llstart String to start the last table line, defaults to :lstart. -:lend String to end a table line -:llend String to end the last table line, defaults to :lend. - -Each in the following group may be a string, a function of one -argument (the field or line) returning a string, or a plist -mapping columns to either of the above: - -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:llfmt Format for the entire last line, defaults to :lfmt. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") -:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. +:tstart, :tend + + Strings to start and end the table. Ignored when :splice is t. + +:lstart, :lend + + Strings to start and end a new table line. + +:llstart, :llend + + Strings to start and end the last table line. Default, + respectively, to :lstart and :lend. + +Each in the following group may be a string or a function of one +argument (either the cells in the current row, as a list of +strings, or the current cell) returning a string: + +:lfmt + + Format string for an entire row, with enough %s to capture all + fields. When non-nil, :lstart, :lend, and :sep are ignored. + +:llfmt + + Format for the entire last line, defaults to :lfmt. + +:fmt + + A format to be used to wrap the field, should contain %s for + the original field value. For example, to wrap everything in + dollars, you could use :fmt \"$%s$\". This may also be + a property list with column numbers and format strings, or + functions, e.g., + + (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c)))) + +:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt + + Same as above, specific for the header lines in the table. + All lines before the first hline are treated as header. If + any of these is not present, the data line value is used. This may be either a string or a function of two arguments: -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual." - (let* ((splicep (plist-get params :splice)) - (hline (plist-get params :hline)) - (skipheadrule (plist-get params :skipheadrule)) - (remove-nil-linesp (plist-get params :remove-nil-lines)) - (remove-newlines (plist-get params :remove-newlines)) - (*orgtbl-hline* hline) - (*orgtbl-table* table) - (*orgtbl-sep* (plist-get params :sep)) - (*orgtbl-efmt* (plist-get params :efmt)) - (*orgtbl-lstart* (plist-get params :lstart)) - (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*)) - (*orgtbl-lend* (plist-get params :lend)) - (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*)) - (*orgtbl-lfmt* (plist-get params :lfmt)) - (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) - (*orgtbl-fmt* (plist-get params :fmt)) - *orgtbl-rtn*) - ;; Convert cells content to backend BACKEND - (when backend - (setq *orgtbl-table* - (mapcar - (lambda(r) - (if (listp r) - (mapcar - (lambda (c) - (org-trim (org-export-string-as c backend t '(:with-tables t)))) - r) - r)) - *orgtbl-table*))) - ;; Put header - (unless splicep - (when (plist-member params :tstart) - (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) - (if tstart (push tstart *orgtbl-rtn*))))) - ;; If we have a heading, format it and handle the trailing hline. - (if (and (not splicep) - (or (consp (car *orgtbl-table*)) - (consp (nth 1 *orgtbl-table*))) - (memq 'hline (cdr *orgtbl-table*))) - (progn - (when (eq 'hline (car *orgtbl-table*)) - ;; There is a hline before the first data line - (and hline (push hline *orgtbl-rtn*)) - (pop *orgtbl-table*)) - (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) - *orgtbl-lstart*)) - (*orgtbl-llstart* (or (plist-get params :hllstart) - *orgtbl-llstart*)) - (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*)) - (*orgtbl-llend* (or (plist-get params :hllend) - (plist-get params :hlend) *orgtbl-llend*)) - (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*)) - (*orgtbl-llfmt* (or (plist-get params :hllfmt) - (plist-get params :hlfmt) *orgtbl-llfmt*)) - (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*)) - (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*))) - (orgtbl-format-section 'hline)) - (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) - (pop *orgtbl-table*))) - ;; Now format the main section. - (orgtbl-format-section nil) - (unless splicep - (when (plist-member params :tend) - (let ((tend (orgtbl-eval-str (plist-get params :tend)))) - (if tend (push tend *orgtbl-rtn*))))) - (mapconcat (if remove-newlines - (lambda (tend) - (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) - 'identity) - (nreverse (if remove-nil-linesp - (remq nil *orgtbl-rtn*) - *orgtbl-rtn*)) "\n"))) +:efmt + + Use this format to print numbers with exponential. The format + should have %s twice for inserting mantissa and exponent, for + example \"%s\\\\times10^{%s}\". This may also be a property + list with column numbers and format strings or functions. + :fmt will still be applied after :efmt." + ;; Make sure `org-export-create-backend' is available. + (require 'ox) + (let* ((backend (plist-get params :backend)) + (custom-backend + ;; Build a custom back-end according to PARAMS. Before + ;; defining a translator, check if there is anything to do. + ;; When there isn't, let BACKEND handle the element. + (org-export-create-backend + :parent (or backend 'org) + :transcoders + `((table . ,(org-table--to-generic-table params)) + (table-row . ,(org-table--to-generic-row params)) + (table-cell . ,(org-table--to-generic-cell params)) + ;; Macros are not going to be expanded. However, no + ;; regular back-end has a transcoder for them. We + ;; provide one so they are not ignored, but displayed + ;; as-is instead. + (macro . (lambda (m c i) (org-element-macro-interpreter m nil)))))) + data info) + ;; Store TABLE as Org syntax in DATA. Tolerate non-string cells. + ;; Initialize communication channel in INFO. + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (let ((standard-output (current-buffer))) + (dolist (e table) + (cond ((eq e 'hline) (princ "|--\n")) + ((consp e) + (princ "| ") (dolist (c e) (princ c) (princ " |")) + (princ "\n"))))) + ;; Add back-end specific filters, but not user-defined ones. In + ;; particular, make sure to call parse-tree filters on the + ;; table. + (setq info + (let ((org-export-filters-alist nil)) + (org-export-install-filters + (org-combine-plists + (org-export-get-environment backend nil params) + `(:back-end ,(org-export-get-backend backend)))))) + (setq data + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + (org-element-map (org-element-parse-buffer) 'table + #'identity nil t) + info))) + (when (and backend (symbolp backend) (not (org-export-get-backend backend))) + (user-error "Unknown :backend value")) + (when (or (not backend) (plist-get info :raw)) (require 'ox-org)) + ;; Handle :skip parameter. + (let ((skip (plist-get info :skip))) + (when skip + (unless (wholenump skip) (user-error "Wrong :skip value")) + (let ((n 0)) + (org-element-map data 'table-row + (lambda (row) + (if (>= n skip) t + (org-element-extract-element row) + (cl-incf n) + nil)) + nil t)))) + ;; Handle :skipcols parameter. + (let ((skipcols (plist-get info :skipcols))) + (when skipcols + (unless (consp skipcols) (user-error "Wrong :skipcols value")) + (org-element-map data 'table + (lambda (table) + (let ((specialp (org-export-table-has-special-column-p table))) + (dolist (row (org-element-contents table)) + (when (eq (org-element-property :type row) 'standard) + (let ((c 1)) + (dolist (cell (nthcdr (if specialp 1 0) + (org-element-contents row))) + (when (memq c skipcols) + (org-element-extract-element cell)) + (cl-incf c)))))))))) + ;; Since we are going to export using a low-level mechanism, + ;; ignore special column and special rows manually. + (let ((special? (org-export-table-has-special-column-p data)) + ignore) + (org-element-map data (if special? '(table-cell table-row) 'table-row) + (lambda (datum) + (when (if (eq (org-element-type datum) 'table-row) + (org-export-table-row-is-special-p datum nil) + (org-export-first-sibling-p datum nil)) + (push datum ignore)))) + (setq info (plist-put info :ignore-list ignore))) + ;; We use a low-level mechanism to export DATA so as to skip all + ;; usual pre-processing and post-processing, i.e., hooks, Babel + ;; code evaluation, include keywords and macro expansion. Only + ;; back-end specific filters are retained. + (let ((output (org-export-data-with-backend data custom-backend info))) + ;; Remove final newline. + (if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) + +(defun org-table--generic-apply (value name &optional with-cons &rest args) + (cond ((null value) nil) + ((functionp value) `(funcall ',value ,@args)) + ((stringp value) + (cond ((consp (car args)) `(apply #'format ,value ,@args)) + (args `(format ,value ,@args)) + (t value))) + ((and with-cons (consp value)) + `(let ((val (cadr (memq column ',value)))) + (cond ((null val) contents) + ((stringp val) (format val ,@args)) + ((functionp val) (funcall val ,@args)) + (t (user-error "Wrong %s value" ,name))))) + (t (user-error "Wrong %s value" name)))) + +(defun org-table--to-generic-table (params) + "Return custom table transcoder according to PARAMS. +PARAMS is a plist. See `orgtbl-to-generic' for more +information." + (let ((backend (plist-get params :backend)) + (splice (plist-get params :splice)) + (tstart (plist-get params :tstart)) + (tend (plist-get params :tend))) + `(lambda (table contents info) + (concat + ,(and tstart (not splice) + `(concat ,(org-table--generic-apply tstart ":tstart") "\n")) + ,(if (or (not backend) tstart tend splice) 'contents + `(org-export-with-backend ',backend table contents info)) + ,(org-table--generic-apply (and (not splice) tend) ":tend"))))) + +(defun org-table--to-generic-row (params) + "Return custom table row transcoder according to PARAMS. +PARAMS is a plist. See `orgtbl-to-generic' for more +information." + (let* ((backend (plist-get params :backend)) + (lstart (plist-get params :lstart)) + (llstart (plist-get params :llstart)) + (hlstart (plist-get params :hlstart)) + (hllstart (plist-get params :hllstart)) + (lend (plist-get params :lend)) + (llend (plist-get params :llend)) + (hlend (plist-get params :hlend)) + (hllend (plist-get params :hllend)) + (lfmt (plist-get params :lfmt)) + (llfmt (plist-get params :llfmt)) + (hlfmt (plist-get params :hlfmt)) + (hllfmt (plist-get params :hllfmt))) + `(lambda (row contents info) + (if (eq (org-element-property :type row) 'rule) + ,(cond + ((plist-member params :hline) + (org-table--generic-apply (plist-get params :hline) ":hline")) + (backend `(org-export-with-backend ',backend row nil info))) + (let ((headerp (org-export-table-row-in-header-p row info)) + (lastp (not (org-export-get-next-element row info))) + (last-header-p (org-export-table-row-ends-header-p row info))) + (when contents + ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or + ;; `:hllfmt' to CONTENTS. Otherwise, fallback on + ;; `:lstart', `:lend' and their relatives. + ,(let ((cells + '(org-element-map row 'table-cell + (lambda (cell) + ;; Export all cells, without separators. + ;; + ;; Use `org-export-data-with-backend' + ;; instead of `org-export-data' to eschew + ;; cached values, which + ;; ignore :orgtbl-ignore-sep parameter. + (org-export-data-with-backend + cell + (plist-get info :back-end) + (org-combine-plists info '(:orgtbl-ignore-sep t)))) + info))) + `(cond + ,(and hllfmt + `(last-header-p ,(org-table--generic-apply + hllfmt ":hllfmt" nil cells))) + ,(and hlfmt + `(headerp ,(org-table--generic-apply + hlfmt ":hlfmt" nil cells))) + ,(and llfmt + `(lastp ,(org-table--generic-apply + llfmt ":llfmt" nil cells))) + (t + ,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells) + `(concat + (cond + ,(and + (or hllstart hllend) + `(last-header-p + (concat + ,(org-table--generic-apply hllstart ":hllstart") + contents + ,(org-table--generic-apply hllend ":hllend")))) + ,(and + (or hlstart hlend) + `(headerp + (concat + ,(org-table--generic-apply hlstart ":hlstart") + contents + ,(org-table--generic-apply hlend ":hlend")))) + ,(and + (or llstart llend) + `(lastp + (concat + ,(org-table--generic-apply llstart ":llstart") + contents + ,(org-table--generic-apply llend ":llend")))) + (t + ,(cond + ((or lstart lend) + `(concat + ,(org-table--generic-apply lstart ":lstart") + contents + ,(org-table--generic-apply lend ":lend"))) + (backend + `(org-export-with-backend + ',backend row contents info)) + (t 'contents))))))))))))))) + +(defun org-table--to-generic-cell (params) + "Return custom table cell transcoder according to PARAMS. +PARAMS is a plist. See `orgtbl-to-generic' for more +information." + (let* ((backend (plist-get params :backend)) + (efmt (plist-get params :efmt)) + (fmt (plist-get params :fmt)) + (hfmt (plist-get params :hfmt)) + (sep (plist-get params :sep)) + (hsep (plist-get params :hsep))) + `(lambda (cell contents info) + (let ((headerp (org-export-table-row-in-header-p + (org-export-get-parent-element cell) info)) + (column (1+ (cdr (org-export-table-cell-address cell info))))) + ;; Make sure that contents are exported as Org data when :raw + ;; parameter is non-nil. + ,(when (and backend (plist-get params :raw)) + `(setq contents + ;; Since we don't know what are the pseudo object + ;; types defined in backend, we cannot pass them to + ;; `org-element-interpret-data'. As a consequence, + ;; they will be treated as pseudo elements, and + ;; will have newlines appended instead of spaces. + ;; Therefore, we must make sure :post-blank value + ;; is really turned into spaces. + (replace-regexp-in-string + "\n" " " + (org-trim + (org-element-interpret-data + (org-element-contents cell)))))) + (when contents + ;; Check if we can apply `:efmt' on CONTENTS. + ,(when efmt + `(when (string-match orgtbl-exp-regexp contents) + (let ((mantissa (match-string 1 contents)) + (exponent (match-string 2 contents))) + (setq contents ,(org-table--generic-apply + efmt ":efmt" t 'mantissa 'exponent))))) + ;; Check if we can apply FMT (or HFMT) on CONTENTS. + (cond + ,(and hfmt `(headerp (setq contents ,(org-table--generic-apply + hfmt ":hfmt" t 'contents)))) + ,(and fmt `(t (setq contents ,(org-table--generic-apply + fmt ":fmt" t 'contents)))))) + ;; If a separator is provided, use it instead of BACKEND's. + ;; Separators are ignored when LFMT (or equivalent) is + ;; provided. + ,(cond + ((or hsep sep) + `(if (or ,(and (not sep) '(not headerp)) + (plist-get info :orgtbl-ignore-sep) + (not (org-export-get-next-element cell info))) + ,(if (not backend) 'contents + `(org-export-with-backend ',backend cell contents info)) + (concat contents + ,(if (and sep hsep) `(if headerp ,hsep ,sep) + (or hsep sep))))) + (backend `(org-export-with-backend ',backend cell contents info)) + (t 'contents)))))) ;;;###autoload (defun orgtbl-to-tsv (table params) "Convert the orgtbl-mode table to TAB separated material." (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params))) + ;;;###autoload (defun orgtbl-to-csv (table params) "Convert the orgtbl-mode table to CSV material. This does take care of the proper quoting of fields with comma or quotes." - (orgtbl-to-generic table (org-combine-plists - '(:sep "," :fmt org-quote-csv-field) - params))) + (orgtbl-to-generic table + (org-combine-plists '(:sep "," :fmt org-quote-csv-field) + params))) ;;;###autoload (defun orgtbl-to-latex (table params) "Convert the orgtbl-mode TABLE to LaTeX. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") - The format may also be a function that formats its one argument. - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - The format may also be a function that formats its two arguments. - -:llend If you find too much space below the last line of a table, - pass a value of \"\" for :llend to suppress the final \\\\. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) - org-table-last-alignment "")) - (params2 - (list - :tstart (concat "\\begin{tabular}{" alignment "}") - :tend "\\end{tabular}" - :lstart "" :lend " \\\\" :sep " & " - :efmt "%s\\,(%s)" :hline "\\hline"))) - (require 'ox-latex) - (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) + +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported. It is also possible to use the following ones: + +:booktabs + + When non-nil, use formal \"booktabs\" style. + +:environment + + Specify environment to use, as a string. If you use + \"longtable\", you may also want to specify :language property, + as a string, to get proper continuation strings." + (require 'ox-latex) + (orgtbl-to-generic + table + (org-combine-plists + ;; Provide sane default values. + (list :backend 'latex + :latex-default-table-mode 'table + :latex-tables-centered nil + :latex-tables-booktabs (plist-get params :booktabs) + :latex-table-scientific-notation nil + :latex-default-table-environment + (or (plist-get params :environment) "tabular")) + params))) ;;;###autoload (defun orgtbl-to-html (table params) "Convert the orgtbl-mode TABLE to HTML. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Currently this function recognizes the following parameters: -:splice When set to t, return only table body lines, don't wrap - them into a environment. Default is nil. +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported. It is also possible to use the following one: -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it." +:attributes + + Attributes and values, as a plist, which will be used in +
    tag." (require 'ox-html) - (let ((output (org-export-string-as - (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) - (if (not (plist-get params :splice)) output - (org-trim - (replace-regexp-in-string - "\\`
    \n" "" - (replace-regexp-in-string "
    \n*\\'" "" output)))))) + (orgtbl-to-generic + table + (org-combine-plists + ;; Provide sane default values. + (list :backend 'html + :html-table-data-tags '("" . "") + :html-table-use-header-tags-for-first-column nil + :html-table-align-individual-fields t + :html-table-row-tags '("" . "") + :html-table-attributes + (if (plist-member params :attributes) + (plist-get params :attributes) + '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" + :frame "hsides"))) + params))) ;;;###autoload (defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to TeXInfo. -TABLE is a list, each entry either the symbol `hline' for a horizontal -separator line, or a list of fields for that line. -PARAMS is a property list of parameters that can influence the conversion. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - Each format also may be a function that formats its one - argument. - -:cf \"f1 f2..\" The column fractions for the table. By default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((total (float (apply '+ org-table-last-column-widths))) - (colfrac (or (plist-get params :cf) - (mapconcat - (lambda (x) (format "%.3f" (/ (float x) total))) - org-table-last-column-widths " "))) - (params2 - (list - :tstart (concat "@multitable @columnfractions " colfrac) - :tend "@end multitable" - :lstart "@item " :lend "" :sep " @tab " - :hlstart "@headitem "))) - (require 'ox-texinfo) - (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) + "Convert the orgtbl-mode TABLE to Texinfo. + +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported. It is also possible to use the following one: + +:columns + + Column widths, as a string. When providing column fractions, + \"@columnfractions\" command can be omitted." + (require 'ox-texinfo) + (let ((output + (orgtbl-to-generic + table + (org-combine-plists + (list :backend 'texinfo + :texinfo-tables-verbatim nil + :texinfo-table-scientific-notation nil) + params))) + (columns (let ((w (plist-get params :columns))) + (cond ((not w) nil) + ((string-match-p "{\\|@columnfractions " w) w) + (t (concat "@columnfractions " w)))))) + (if (not columns) output + (replace-regexp-in-string + "@multitable \\(.*\\)" columns output t nil 1)))) ;;;###autoload (defun orgtbl-to-orgtbl (table params) "Convert the orgtbl-mode TABLE into another orgtbl-mode table. + +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported. + Useful when slicing one table into many. The :hline, :sep, -:lstart, and :lend provide orgtbl framing. The default nil :tstart -and :tend suppress strings without splicing; they can be set to -provide ORGTBL directives for the generated table." - (let* ((params2 - (list - :remove-newlines t - :tstart nil :tend nil - :hline "|---" - :sep " | " - :lstart "| " - :lend " |")) - (params (org-combine-plists params2 params))) - (with-temp-buffer - (insert (orgtbl-to-generic table params)) - (goto-char (point-min)) - (while (re-search-forward org-table-hline-regexp nil t) - (org-table-align)) - (buffer-substring 1 (buffer-size))))) +:lstart, and :lend provide orgtbl framing. :tstart and :tend can +be set to provide ORGTBL directives for the generated table." + (require 'ox-org) + (orgtbl-to-generic table (org-combine-plists params (list :backend 'org)))) (defun orgtbl-to-table.el (table params) - "Convert the orgtbl-mode TABLE into a table.el table." + "Convert the orgtbl-mode TABLE into a table.el table. +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported." (with-temp-buffer (insert (orgtbl-to-orgtbl table params)) (org-table-align) @@ -4920,19 +5256,137 @@ provide ORGTBL directives for the generated table." (defun orgtbl-to-unicode (table params) "Convert the orgtbl-mode TABLE into a table with unicode characters. -You need the ascii-art-to-unicode.el package for this. You can download -it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." - (with-temp-buffer - (insert (orgtbl-to-table.el table params)) - (goto-char (point-min)) - (if (or (featurep 'ascii-art-to-unicode) - (require 'ascii-art-to-unicode nil t)) - (aa2u) - (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) - (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" - "Link to ascii-art-to-unicode.el") org-stored-links)) - (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) - (buffer-string))) + +TABLE is a list, each entry either the symbol `hline' for +a horizontal separator line, or a list of fields for that line. +PARAMS is a property list of parameters that can influence the +conversion. All parameters from `orgtbl-to-generic' are +supported. It is also possible to use the following ones: + +:ascii-art + + When non-nil, use \"ascii-art-to-unicode\" package to translate + the table. You can download it here: + http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el. + +:narrow + + When non-nil, narrow columns width than provided width cookie, + using \"=>\" as an ellipsis, just like in an Org mode buffer." + (require 'ox-ascii) + (orgtbl-to-generic + table + (org-combine-plists + (list :backend 'ascii + :ascii-charset 'utf-8 + :ascii-table-widen-columns (not (plist-get params :narrow)) + :ascii-table-use-ascii-art (plist-get params :ascii-art)) + params))) + +;; Put the cursor in a column containing numerical values +;; of an Org table, +;; type C-c " a +;; A new column is added with a bar plot. +;; When the table is refreshed (C-u C-c *), +;; the plot is updated to reflect the new values. + +(defun orgtbl-ascii-draw (value min max &optional width characters) + "Draw an ascii bar in a table. +VALUE is the value to plot, it determines the width of the bar to draw. +MIN is the value that will be displayed as empty (zero width bar). +MAX is the value that will draw a bar filling all the WIDTH. +WIDTH is the span in characters from MIN to MAX. +CHARACTERS is a string that will compose the bar, with shades of grey +from pure white to pure black. It defaults to a 10 characters string +of regular ascii characters." + (let* ((width (ceiling (or width 12))) + (characters (or characters " .:;c!lhVHW")) + (len (1- (length characters))) + (value (float (if (numberp value) + value (string-to-number value)))) + (relative (/ (- value min) (- max min))) + (steps (round (* relative width len)))) + (cond ((< steps 0) "too small") + ((> steps (* width len)) "too large") + (t (let* ((int-division (/ steps len)) + (remainder (- steps (* int-division len)))) + (concat (make-string int-division (elt characters len)) + (string (elt characters remainder)))))))) + +;;;###autoload +(defun orgtbl-ascii-plot (&optional ask) + "Draw an ASCII bar plot in a column. + +With cursor in a column containing numerical values, this function +will draw a plot in a new column. + +ASK, if given, is a numeric prefix to override the default 12 +characters width of the plot. ASK may also be the `\\[universal-argument]' \ +prefix, +which will prompt for the width." + (interactive "P") + (let ((col (org-table-current-column)) + (min 1e999) ; 1e999 will be converted to infinity + (max -1e999) ; which is the desired result + (table (org-table-to-lisp)) + (length + (cond ((consp ask) + (read-number "Length of column " 12)) + ((numberp ask) ask) + (t 12)))) + ;; Skip any hline a the top of table. + (while (eq (car table) 'hline) (setq table (cdr table))) + ;; Skip table header if any. + (dolist (x (or (cdr (memq 'hline table)) table)) + (when (consp x) + (setq x (nth (1- col) x)) + (when (string-match + "^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$" + x) + (setq x (string-to-number x)) + (when (> min x) (setq min x)) + (when (< max x) (setq max x))))) + (org-table-insert-column) + (org-table-move-column-right) + (org-table-store-formulas + (cons + (cons + (concat "$" (number-to-string (1+ col))) + (format "'(%s $%s %s %s %s)" + "orgtbl-ascii-draw" col min max length)) + (org-table-get-stored-formulas))) + (org-table-recalculate t))) + +;; Example of extension: unicode characters +;; Here are two examples of different styles. + +;; Unicode block characters are used to give a smooth effect. +;; See http://en.wikipedia.org/wiki/Block_Elements +;; Use one of those drawing functions +;; - orgtbl-ascii-draw (the default ascii) +;; - orgtbl-uc-draw-grid (unicode with a grid effect) +;; - orgtbl-uc-draw-cont (smooth unicode) + +;; This is best viewed with the "DejaVu Sans Mono" font +;; (use M-x set-default-font). + +(defun orgtbl-uc-draw-grid (value min max &optional width) + "Draw a bar in a table using block unicode characters. +It is a variant of orgtbl-ascii-draw with Unicode block +characters, for a smooth display. Bars appear as grids (to the +extent the font allows)." + ;; http://en.wikipedia.org/wiki/Block_Elements + ;; best viewed with the "DejaVu Sans Mono" font. + (orgtbl-ascii-draw value min max width + " \u258F\u258E\u258D\u258C\u258B\u258A\u2589")) + +(defun orgtbl-uc-draw-cont (value min max &optional width) + "Draw a bar in a table using block unicode characters. +It is a variant of orgtbl-ascii-draw with Unicode block +characters, for a smooth display. Bars are solid (to the extent +the font allows)." + (orgtbl-ascii-draw value min max width + " \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588")) (defun org-table-get-remote-range (name-or-id form) "Get a field value or a list of values in a range from table at ID. @@ -4949,57 +5403,74 @@ The return value is either a single string for a single field, or a list of the fields in the rectangle." (save-match-data (let ((case-fold-search t) (id-loc nil) - ;; Protect a bunch of variables from being overwritten - ;; by the context of the remote table + ;; Protect a bunch of variables from being overwritten by + ;; the context of the remote table. org-table-column-names org-table-column-name-regexp org-table-local-parameters org-table-named-field-locations - org-table-current-line-types org-table-current-begin-line + org-table-current-line-types org-table-current-begin-pos org-table-dlines org-table-current-ncol org-table-hlines org-table-last-alignment org-table-last-column-widths org-table-last-alignment - org-table-last-column-widths tbeg + org-table-last-column-widths buffer loc) (setq form (org-table-convert-refs-to-rc form)) - (save-excursion - (save-restriction - (widen) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward - (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" - (regexp-quote name-or-id) "[ \t]*$") - nil t) - (setq buffer (current-buffer) loc (match-beginning 0)) - (setq id-loc (org-id-find name-or-id 'marker)) - (unless (and id-loc (markerp id-loc)) - (user-error "Can't find remote table \"%s\"" name-or-id)) - (setq buffer (marker-buffer id-loc) - loc (marker-position id-loc)) - (move-marker id-loc nil))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (user-error "Cannot find a table at NAME or ID %s" name-or-id)) - (setq tbeg (point-at-bol)) - (org-table-get-specials) - (setq form (org-table-formula-substitute-names - (org-table-formula-handle-first/last-rc form))) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) tbeg 1)) - form))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (if (re-search-forward + (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" + (regexp-quote name-or-id) "[ \t]*$") + nil t) + (setq buffer (current-buffer) loc (match-beginning 0)) + (setq id-loc (org-id-find name-or-id 'marker)) + (unless (and id-loc (markerp id-loc)) + (user-error "Can't find remote table \"%s\"" name-or-id)) + (setq buffer (marker-buffer id-loc) + loc (marker-position id-loc)) + (move-marker id-loc nil)) + (with-current-buffer buffer + (org-with-wide-buffer + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t) + (not (match-beginning 1))) + (user-error "Cannot find a table at NAME or ID %s" name-or-id)) + (org-table-analyze) + (setq form (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc form))) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (org-table-get-range + (match-string 0 form) org-table-current-begin-pos 1) + form))))))) + +(defun org-table-remote-reference-indirection (form) + "Return formula with table remote references substituted by indirection. +For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\". +This indirection works only with the format @ROW$COLUMN. The +format \"B3\" is not supported because it can not be +distinguished from a plain table name or ID." + (let ((regexp + ;; Same as in `org-table-eval-formula'. + (concat "\\")) (force-mode-line-update))) -(defun org-timer-cancel-timer () - "Cancel the current timer." - (interactive) - (when (eval org-timer-current-timer) - (run-hooks 'org-timer-cancel-hook) - (cancel-timer org-timer-current-timer) - (setq org-timer-current-timer nil) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off)) - (message "Last timer canceled")) - (defun org-timer-show-remaining-time () "Display the remaining time before the timer ends." (interactive) (require 'time) - (if (not org-timer-current-timer) + (if (not org-timer-countdown-timer) (message "No timer set") (let* ((rtime (decode-time - (time-subtract (timer--time org-timer-current-timer) + (time-subtract (timer--time org-timer-countdown-timer) (current-time)))) (rsecs (nth 0 rtime)) (rmins (nth 1 rtime))) (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) -(defvar org-clock-sound) - ;;;###autoload (defun org-timer-set-timer (&optional opt) - "Prompt for a duration and set a timer. + "Prompt for a duration in minutes or hh:mm:ss and set a timer. -If `org-timer-default-timer' is not zero, suggest this value as +If `org-timer-default-timer' is not \"0\", suggest this value as the default duration for the timer. If a timer is already set, prompt the user if she wants to replace it. Called with a numeric prefix argument, use this numeric value as -the duration of the timer. +the duration of the timer in minutes. Called with a `C-u' prefix arguments, use `org-timer-default-timer' without prompting the user for a duration. With two `C-u' prefix arguments, use `org-timer-default-timer' without prompting the user for a duration and automatically -replace any running timer." +replace any running timer. + +By default, the timer duration will be set to the number of +minutes in the Effort property, if any. You can ignore this by +using three `C-u' prefix arguments." (interactive "P") - (let ((minutes (or (and (numberp opt) (number-to-string opt)) - (and (listp opt) (not (null opt)) - (number-to-string org-timer-default-timer)) - (read-from-minibuffer - "How many minutes left? " - (if (not (eq org-timer-default-timer 0)) - (number-to-string org-timer-default-timer)))))) + (when (and org-timer-start-time + (not org-timer-countdown-timer)) + (user-error "Relative timer is running. Stop first")) + (let* ((default-timer + ;; `org-timer-default-timer' used to be a number, don't choke: + (if (numberp org-timer-default-timer) + (number-to-string org-timer-default-timer) + org-timer-default-timer)) + (effort-minutes (ignore-errors (org-get-at-eol 'effort-minutes 1))) + (minutes (or (and (numberp opt) (number-to-string opt)) + (and (not (equal opt '(64))) + effort-minutes + (number-to-string effort-minutes)) + (and (consp opt) default-timer) + (and (stringp opt) opt) + (read-from-minibuffer + "How much time left? (minutes or h:mm:ss) " + (and (not (string-equal default-timer "0")) default-timer))))) + (when (string-match "\\`[0-9]+\\'" minutes) + (setq minutes (concat minutes ":00"))) (if (not (string-match "[0-9]+" minutes)) (org-timer-show-remaining-time) - (let* ((mins (string-to-number (match-string 0 minutes))) - (secs (* mins 60)) - (hl (cond - ((string-match "Org Agenda" (buffer-name)) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) - (hdmarker (or (get-text-property (point) 'org-hd-marker) - marker)) - (pos (marker-position marker))) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-entry) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((derived-mode-p 'org-mode) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))) - (t (error "Not in an Org buffer")))) - timer-set) - (if (or (and org-timer-current-timer - (or (equal opt '(16)) - (y-or-n-p "Replace current timer? "))) - (not org-timer-current-timer)) - (progn - (require 'org-clock) - (when org-timer-current-timer - (cancel-timer org-timer-current-timer)) - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) ,org-clock-sound) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook) - (setq org-timer-timer-is-countdown t - org-timer-start-time - (time-add (current-time) (seconds-to-time (* mins 60)))) - (org-timer-set-mode-line 'on)) - (message "No timer set")))))) + (let ((secs (org-timer-hms-to-secs (org-timer-fix-incomplete minutes)))) + (if (and org-timer-countdown-timer + (not (or (equal opt '(16)) + (y-or-n-p "Replace current timer? ")))) + (message "No timer set") + (when (timerp org-timer-countdown-timer) + (cancel-timer org-timer-countdown-timer)) + (setq org-timer-countdown-timer-title + (org-timer--get-timer-title)) + (setq org-timer-countdown-timer + (org-timer--run-countdown-timer + secs org-timer-countdown-timer-title)) + (run-hooks 'org-timer-set-hook) + (setq org-timer-start-time + (time-add (current-time) (seconds-to-time secs))) + (setq org-timer-pause-time nil) + (org-timer-set-mode-line 'on)))))) + +(defun org-timer--run-countdown-timer (secs title) + "Start countdown timer that will last SECS. +TITLE will be appended to the notification message displayed when +time is up." + (let ((msg (format "%s: time out" title))) + (run-with-timer + secs nil `(lambda () + (setq org-timer-countdown-timer nil + org-timer-start-time nil) + (org-notify ,msg ,org-clock-sound) + (org-timer-set-mode-line 'off) + (run-hooks 'org-timer-done-hook))))) + +(defun org-timer--get-timer-title () + "Construct timer title from heading or file name of Org buffer." + (cond + ((derived-mode-p 'org-agenda-mode) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (hdmarker (or (get-text-property (point) 'org-hd-marker) + marker))) + (with-current-buffer (marker-buffer marker) + (org-with-wide-buffer + (goto-char hdmarker) + (org-show-entry) + (or (ignore-errors (org-get-heading)) + (buffer-name (buffer-base-buffer))))))) + ((derived-mode-p 'org-mode) + (or (ignore-errors (org-get-heading)) + (buffer-name (buffer-base-buffer)))) + (t (error "Not in an Org buffer")))) (provide 'org-timer) diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index aae65cc6d3..2db3eae2d8 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -3,15 +3,15 @@ ;;; Code: ;;;###autoload (defun org-release () - "The release version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-release "8.2.10")) + "The release version of Org. +Inserted by installing Org mode or when a release is made." + (let ((org-release "9.0.9")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-git-version "release_8.2.10")) +Inserted by installing Org or when a release is made." + (let ((org-git-version "release_9.0.9")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org-w3m.el b/lisp/org/org-w3m.el index 8360bd07fe..e9bbeff37c 100644 --- a/lisp/org/org-w3m.el +++ b/lisp/org/org-w3m.el @@ -1,4 +1,4 @@ -;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode +;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*- ;; Copyright (C) 2008-2017 Free Software Foundation, Inc. @@ -25,9 +25,9 @@ ;;; Commentary: ;; This file implements copying HTML content from a w3m buffer and -;; transforming the text on the fly so that it can be pasted into -;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have been washed with w3m. +;; transforming the text on the fly so that it can be pasted into an +;; Org buffer with hot links. It will also work for regions in gnus +;; buffers that have been washed with w3m. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -35,7 +35,7 @@ ;; Richard Riley ;; -;; The idea of transforming the HTML content with org-mode style is +;; The idea of transforming the HTML content with Org syntax is ;; proposed by Richard, I'm just coding it. ;; @@ -46,7 +46,7 @@ (defvar w3m-current-url) (defvar w3m-current-title) -(add-hook 'org-store-link-functions 'org-w3m-store-link) +(org-link-set-parameters "w3m" :store #'org-w3m-store-link) (defun org-w3m-store-link () "Store a link to a w3m buffer." (when (eq major-mode 'w3m-mode) @@ -60,7 +60,7 @@ "Copy current buffer content or active region with `org-mode' style links. This will encode `link-title' and `link-location' with `org-make-link-string', and insert the transformed test into the kill ring, -so that it can be yanked into an Org-mode buffer with links working correctly." +so that it can be yanked into an Org buffer with links working correctly." (interactive) (let* ((regionp (org-region-active-p)) (transform-start (point-min)) @@ -107,7 +107,7 @@ so that it can be yanked into an Org-mode buffer with links working correctly." (concat return-content (buffer-substring (point) transform-end)))) (org-kill-new return-content) - (message "Transforming links...done, use C-y to insert text into Org-mode file") + (message "Transforming links...done, use C-y to insert text into Org file") (message "Copy with link transformation complete.")))) (defun org-w3m-get-anchor-start () diff --git a/lisp/org/org.el b/lisp/org/org.el index 02a7a0c09a..22b7dbfdaf 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -1,4 +1,4 @@ -;;; org.el --- Outline-based notes management and organizer +;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- ;; Carstens outline-mode for keeping track of everything. ;; Copyright (C) 2004-2017 Free Software Foundation, Inc. @@ -25,23 +25,24 @@ ;; ;;; Commentary: ;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing +;; Org is a mode for keeping notes, maintaining ToDo lists, and doing ;; project planning with a fast and effective plain-text system. ;; -;; Org-mode develops organizational tasks around NOTES files that contain -;; information about projects as plain text. Org-mode is implemented on -;; top of outline-mode, which makes it possible to keep the content of -;; large files well structured. Visibility cycling and structure editing -;; help to work with the tree. Tables are easily created with a built-in -;; table editor. Org-mode supports ToDo items, deadlines, time stamps, -;; and scheduling. It dynamically compiles entries into an agenda that -;; utilizes and smoothly integrates much of the Emacs calendar and diary. -;; Plain text URL-like links connect to websites, emails, Usenet -;; messages, BBDB entries, and any files related to the projects. For -;; printing and sharing of notes, an Org-mode file can be exported as a -;; structured ASCII file, as HTML, or (todo and agenda items only) as an -;; iCalendar file. It can also serve as a publishing tool for a set of -;; linked webpages. +;; Org mode develops organizational tasks around NOTES files that +;; contain information about projects as plain text. Org mode is +;; implemented on top of outline-mode, which makes it possible to keep +;; the content of large files well structured. Visibility cycling and +;; structure editing help to work with the tree. Tables are easily +;; created with a built-in table editor. Org mode supports ToDo +;; items, deadlines, time stamps, and scheduling. It dynamically +;; compiles entries into an agenda that utilizes and smoothly +;; integrates much of the Emacs calendar and diary. Plain text +;; URL-like links connect to websites, emails, Usenet messages, BBDB +;; entries, and any files related to the projects. For printing and +;; sharing of notes, an Org file can be exported as a structured ASCII +;; file, as HTML, or (todo and agenda items only) as an iCalendar +;; file. It can also serve as a publishing tool for a set of linked +;; webpages. ;; ;; Installation and Activation ;; --------------------------- @@ -51,11 +52,11 @@ ;; ;; Documentation ;; ------------- -;; The documentation of Org-mode can be found in the TeXInfo file. The +;; The documentation of Org mode can be found in the TeXInfo file. The ;; distribution also contains a PDF version of it. At the homepage of -;; Org-mode, you can read the same text online as HTML. There is also an +;; Org mode, you can read the same text online as HTML. There is also an ;; excellent reference card made by Philip Rooke. This card can be found -;; in the etc/ directory of Emacs 22. +;; in the doc/ directory. ;; ;; A list of recent changes can be found at ;; http://orgmode.org/Changes.html @@ -63,21 +64,29 @@ ;;; Code: (defvar org-inhibit-highlight-removal nil) ; dynamically scoped param -(defvar org-table-formula-constants-local nil +(defvar-local org-table-formula-constants-local nil "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) ;;;; Require other packages -(eval-when-compile - (require 'cl) - (require 'gnus-sum)) +(require 'cl-lib) + +(eval-when-compile (require 'gnus-sum)) (require 'calendar) (require 'find-func) (require 'format-spec) -(load "org-loaddefs.el" t t t) +(or (eq this-command 'eval-buffer) + (condition-case nil + (load (concat (file-name-directory load-file-name) + "org-loaddefs.el") + nil t t t) + (error + (message "WARNING: No org-loaddefs.el file could be found from where org.el is loaded.") + (sit-for 3) + (message "You need to run \"make\" or \"make autoloads\" from Org lisp directory") + (sit-for 3)))) (require 'org-macs) (require 'org-compat) @@ -101,75 +110,87 @@ sure that we are at the beginning of the line.") "Matches a headline, putting stars and text into groups. Stars are put in group 1 and the trimmed body in group 2.") -;; Emacs 22 calendar compatibility: Make sure the new variables are available -(unless (boundp 'calendar-view-holidays-initially-flag) - (org-defvaralias 'calendar-view-holidays-initially-flag - 'view-calendar-holidays-initially)) -(unless (boundp 'calendar-view-diary-initially-flag) - (org-defvaralias 'calendar-view-diary-initially-flag - 'view-diary-entries-initially)) -(unless (boundp 'diary-fancy-buffer) - (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) - +(declare-function calendar-check-holidays "holidays" (date)) +(declare-function cdlatex-environment "ext:cdlatex" (environment item)) +(declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) (declare-function org-add-archive-files "org-archive" (files)) - -(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) -(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) +(declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) +(declare-function org-agenda-redo "org-agenda" (&optional all)) +(declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t) +(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) +(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) (declare-function org-clock-get-last-clock-out-time "org-clock" ()) -(declare-function org-clock-timestamps-up "org-clock" (&optional n)) -(declare-function org-clock-timestamps-down "org-clock" (&optional n)) +(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) (declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) +(declare-function org-clock-sum "org-clock" (&optional tstart tend headline-filter propname)) (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) +(declare-function org-clock-timestamps-down "org-clock" (&optional n)) +(declare-function org-clock-timestamps-up "org-clock" (&optional n)) (declare-function org-clock-update-time-maybe "org-clock" ()) (declare-function org-clocktable-shift "org-clock" (dir n)) - -(declare-function orgtbl-mode "org-table" (&optional arg)) -(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) -(declare-function org-beamer-mode "ox-beamer" (&optional prefix) t) -(declare-function org-table-edit-field "org-table" (arg)) -(declare-function org-table-justify-field-maybe "org-table" (&optional new)) -(declare-function org-table-set-constants "org-table" ()) -(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) -(declare-function org-id-get-create "org-id" (&optional force)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-cache-refresh "org-element" (pos)) +(declare-function org-element-cache-reset "org-element" (&optional all)) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-copy "org-element" (datum)) +(declare-function org-element-interpret-data "org-element" (data)) +(declare-function org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-link-parser "org-element" ()) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" (element property value)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-element-update-syntax "org-element" ()) (declare-function org-id-find-id-file "org-id" (id)) -(declare-function org-tags-view "org-agenda" (&optional todo-only match)) -(declare-function org-agenda-list "org-agenda" - (&optional arg start-day span with-hour)) -(declare-function org-agenda-redo "org-agenda" (&optional all)) +(declare-function org-id-get-create "org-id" (&optional force)) +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) +(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) +(declare-function org-plot/gnuplot "org-plot" (&optional params)) (declare-function org-table-align "org-table" ()) (declare-function org-table-begin "org-table" (&optional table-type)) +(declare-function org-table-beginning-of-field "org-table" (&optional n)) (declare-function org-table-blank-field "org-table" ()) +(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) +(declare-function org-table-copy-region "org-table" (beg end &optional cut)) +(declare-function org-table-cut-region "org-table" (beg end)) +(declare-function org-table-edit-field "org-table" (arg)) (declare-function org-table-end "org-table" (&optional table-type)) +(declare-function org-table-end-of-field "org-table" (&optional n)) (declare-function org-table-insert-row "org-table" (&optional arg)) -(declare-function org-table-paste-rectangle "org-table" ()) +(declare-function org-table-justify-field-maybe "org-table" (&optional new)) (declare-function org-table-maybe-eval-formula "org-table" ()) (declare-function org-table-maybe-recalculate-line "org-table" ()) +(declare-function org-table-next-row "org-table" ()) +(declare-function org-table-paste-rectangle "org-table" ()) +(declare-function org-table-recalculate "org-table" (&optional all noalign)) +(declare-function org-table-wrap-region "org-table" (arg)) +(declare-function org-tags-view "org-agenda" (&optional todo-only match)) +(declare-function orgtbl-ascii-plot "org-table" (&optional ask)) +(declare-function orgtbl-mode "org-table" (&optional arg)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) +(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) -(declare-function org-element--parse-objects "org-element" - (beg end acc restriction)) -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-interpret-data "org-element" - (data &optional parent)) -(declare-function org-element-map "org-element" - (data types fun &optional - info first-match no-recursion with-affiliated)) -(declare-function org-element-nested-p "org-element" (elem-a elem-b)) -(declare-function org-element-parse-buffer "org-element" - (&optional granularity visible-only)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-put-property "org-element" - (element property value)) -(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) -(declare-function org-element--parse-objects "org-element" - (beg end acc restriction)) -(declare-function org-element-parse-buffer "org-element" - (&optional granularity visible-only)) -(declare-function org-element-restriction "org-element" (element)) -(declare-function org-element-type "org-element" (element)) +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + +(defsubst org-get-at-bol (property) + "Get text property PROPERTY at the beginning of line." + (get-text-property (point-at-bol) property)) + +(defsubst org-trim (s &optional keep-lead) + "Remove whitespace at the beginning and the end of string S. +When optional argument KEEP-LEAD is non-nil, removing blank lines +at the beginning of the string does not affect leading indentation." + (replace-regexp-in-string + (if keep-lead "\\`\\([ \t]*\n\\)+" "\\`[ \t\n\r]+") "" + (replace-regexp-in-string "[ \t\n\r]+\\'" "" s))) ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -178,28 +199,24 @@ Stars are put in group 1 and the trimmed body in group 2.") (defun org-babel-do-load-languages (sym value) "Load the languages defined in `org-babel-load-languages'." (set-default sym value) - (mapc (lambda (pair) - (let ((active (cdr pair)) (lang (symbol-name (car pair)))) - (if active - (progn - (require (intern (concat "ob-" lang)))) - (progn - (funcall 'fmakunbound - (intern (concat "org-babel-execute:" lang))) - (funcall 'fmakunbound - (intern (concat "org-babel-expand-body:" lang))))))) - org-babel-load-languages)) + (dolist (pair org-babel-load-languages) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (require (intern (concat "ob-" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) ;;;###autoload (defun org-babel-load-file (file &optional compile) - "Load Emacs Lisp source code blocks in the Org-mode FILE. + "Load Emacs Lisp source code blocks in the Org FILE. This function exports the source code using `org-babel-tangle' and then loads the resulting file using `load-file'. With prefix arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp file to byte-code before it is loaded." (interactive "fFile to load: \nP") - (require 'ob-core) (let* ((age (lambda (file) (float-time (time-subtract (current-time) @@ -207,11 +224,13 @@ file to byte-code before it is loaded." (file-attributes file))))))) (base-name (file-name-sans-extension file)) (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file + ;; tangle if the Org file is newer than the elisp file (unless (and (file-exists-p exported-file) (> (funcall age file) (funcall age exported-file))) + ;; Tangle-file traversal returns reversed list of tangled files + ;; and we want to evaluate the first target. (setq exported-file - (car (org-babel-tangle-file file exported-file "emacs-lisp")))) + (car (last (org-babel-tangle-file file exported-file "emacs-lisp"))))) (message "%s %s" (if compile (progn (byte-compile-file exported-file 'load) @@ -220,7 +239,7 @@ file to byte-code before it is loaded." exported-file))) (defcustom org-babel-load-languages '((emacs-lisp . t)) - "Languages which can be evaluated in Org-mode buffers. + "Languages which can be evaluated in Org buffers. This list can be used to load support for any of the languages below, note that each language will depend on a different set of system executables and/or Emacs modes. When a language is @@ -246,10 +265,12 @@ requirements) is loaded." (const :tag "Ditaa" ditaa) (const :tag "Dot" dot) (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Forth" forth) (const :tag "Fortran" fortran) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) (const :tag "IO" io) + (const :tag "J" J) (const :tag "Java" java) (const :tag "Javascript" js) (const :tag "LaTeX" latex) @@ -272,10 +293,12 @@ requirements) is loaded." (const :tag "Scala" scala) (const :tag "Scheme" scheme) (const :tag "Screen" screen) - (const :tag "Shell Script" sh) + (const :tag "Shell Script" shell) (const :tag "Shen" shen) (const :tag "Sql" sql) - (const :tag "Sqlite" sqlite)) + (const :tag "Sqlite" sqlite) + (const :tag "Stan" stan) + (const :tag "ebnf2ps" ebnf2ps)) :value-type (boolean :tag "Activate" :value t))) ;;;; Customization variables @@ -293,41 +316,318 @@ identifier." ;;;###autoload (defun org-version (&optional here full message) - "Show the org-mode version in the echo area. -With prefix argument HERE, insert it at point. -When FULL is non-nil, use a verbose version string. -When MESSAGE is non-nil, display a message with the version." - (interactive "P") - (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) - (load-suffixes (list ".el")) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) - (org-trash (or - (and (fboundp 'org-release) (fboundp 'org-git-version)) - (org-load-noerror-mustsuffix (concat org-dir "org-version")))) - (load-suffixes save-load-suffixes) - (org-version (org-release)) - (git-version (org-git-version)) - (version (format "Org-mode version %s (%s @ %s)" - org-version - git-version - (if org-install-dir - (if (string= org-dir org-install-dir) - org-install-dir - (concat "mixed installation! " org-install-dir " and " org-dir)) - "org-loaddefs.el can not be found!"))) - (version1 (if full version org-version))) - (if (org-called-interactively-p 'interactive) - (if here - (insert version) - (message version)) - (if message (message version1)) + "Show the Org version. +Interactively, or when MESSAGE is non-nil, show it in echo area. +With prefix argument, or when HERE is non-nil, insert it at point. +In non-interactive uses, a reduced version string is output unless +FULL is given." + (interactive (list current-prefix-arg t (not current-prefix-arg))) + (let ((org-dir (ignore-errors (org-find-library-dir "org"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir + (ignore-errors (org-find-library-dir "org-loaddefs")))) + (unless (and (fboundp 'org-release) (fboundp 'org-git-version)) + (org-load-noerror-mustsuffix (concat org-dir "org-version"))) + (let* ((load-suffixes save-load-suffixes) + (release (org-release)) + (git-version (org-git-version)) + (version (format "Org mode version %s (%s @ %s)" + release + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " + org-install-dir + " and " + org-dir)) + "org-loaddefs.el can not be found!"))) + (version1 (if full version release))) + (when here (insert version1)) + (when message (message "%s" version1)) version1))) (defconst org-version (org-version)) -;;; Compatibility constants + +;;; Syntax Constants + +;;;; Block + +(defconst org-block-regexp + "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" + "Regular expression for hiding blocks.") + +(defconst org-dblock-start-re + "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" + "Matches the start line of a dynamic block, with parameters.") + +(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" + "Matches the end of a dynamic block.") + +;;;; Clock and Planning + +(defconst org-clock-string "CLOCK:" + "String used as prefix for timestamps clocking work hours on an item.") + +(defvar org-closed-string "CLOSED:" + "String used as the prefix for timestamps logging closing a TODO entry.") + +(defvar org-deadline-string "DEADLINE:" + "String to mark deadline entries. +\\ +A deadline is this string, followed by a time stamp. It must be +a word, terminated by a colon. You can insert a schedule keyword +and a timestamp with `\\[org-deadline]'.") + +(defvar org-scheduled-string "SCHEDULED:" + "String to mark scheduled TODO entries. +\\ +A schedule is this string, followed by a time stamp. It must be +a word, terminated by a colon. You can insert a schedule keyword +and a timestamp with `\\[org-schedule]'.") + +(defconst org-ds-keyword-length + (+ 2 + (apply #'max + (mapcar #'length + (list org-deadline-string org-scheduled-string + org-clock-string org-closed-string)))) + "Maximum length of the DEADLINE and SCHEDULED keywords.") + +(defconst org-planning-line-re + (concat "^[ \t]*" + (regexp-opt + (list org-closed-string org-deadline-string org-scheduled-string) + t)) + "Matches a line with planning info. +Matched keyword is in group 1.") + +(defconst org-clock-line-re + (concat "^[ \t]*" org-clock-string) + "Matches a line with clock info.") + +(defconst org-deadline-regexp (concat "\\<" org-deadline-string) + "Matches the DEADLINE keyword.") + +(defconst org-deadline-time-regexp + (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") + "Matches the DEADLINE keyword together with a time stamp.") + +(defconst org-deadline-time-hour-regexp + (concat "\\<" org-deadline-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") + "Matches the DEADLINE keyword together with a time-and-hour stamp.") + +(defconst org-deadline-line-regexp + (concat "\\<\\(" org-deadline-string "\\).*") + "Matches the DEADLINE keyword and the rest of the line.") + +(defconst org-scheduled-regexp (concat "\\<" org-scheduled-string) + "Matches the SCHEDULED keyword.") + +(defconst org-scheduled-time-regexp + (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + "Matches the SCHEDULED keyword together with a time stamp.") + +(defconst org-scheduled-time-hour-regexp + (concat "\\<" org-scheduled-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") + "Matches the SCHEDULED keyword together with a time-and-hour stamp.") + +(defconst org-closed-time-regexp + (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") + "Matches the CLOSED keyword together with a time stamp.") + +(defconst org-keyword-time-regexp + (concat "\\<" + (regexp-opt + (list org-scheduled-string org-deadline-string org-closed-string + org-clock-string) + t) + " *[[<]\\([^]>]+\\)[]>]") + "Matches any of the 4 keywords, together with the time stamp.") + +(defconst org-keyword-time-not-clock-regexp + (concat + "\\<" + (regexp-opt + (list org-scheduled-string org-deadline-string org-closed-string) t) + " *[[<]\\([^]>]+\\)[]>]") + "Matches any of the 3 keywords, together with the time stamp.") + +(defconst org-maybe-keyword-time-regexp + (concat "\\(\\<" + (regexp-opt + (list org-scheduled-string org-deadline-string org-closed-string + org-clock-string) + t) + "\\)?" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]" + "\\|" + "<%%([^\r\n>]*>\\)") + "Matches a timestamp, possibly preceded by a keyword.") + +(defconst org-all-time-keywords + (mapcar (lambda (w) (substring w 0 -1)) + (list org-scheduled-string org-deadline-string + org-clock-string org-closed-string)) + "List of time keywords.") + +;;;; Drawer + +(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" + "Matches first or last line of a hidden block. +Group 1 contains drawer's name or \"END\".") + +(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the last line of a property drawer.") + +(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" + "Regular expression matching the first line of a clock drawer.") + +(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the last line of a clock drawer.") + +(defconst org-property-drawer-re + (concat "^[ \t]*:PROPERTIES:[ \t]*\n" + "\\(?:[ \t]*:\\S-+:\\(?: .*\\)?[ \t]*\n\\)*?" + "[ \t]*:END:[ \t]*$") + "Matches an entire property drawer.") + +(defconst org-clock-drawer-re + (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" + org-clock-drawer-end-re "\\)\n?") + "Matches an entire clock drawer.") + +;;;; Headline + +(defconst org-heading-keyword-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline with some keyword. +This regexp will match the headline of any node which has the +exact keyword that is put into the format. The keyword isn't in +any group by default, but the stars and the body are.") + +(defconst org-heading-keyword-maybe-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline, possibly with some keyword. +This regexp can match any headline with the specified keyword, or +without a keyword. The keyword isn't in any group by default, +but the stars and the body are.") + +(defconst org-archive-tag "ARCHIVE" + "The tag that marks a subtree as archived. +An archived subtree does not open during visibility cycling, and does +not contribute to the agenda listings.") + +(defconst org-comment-string "COMMENT" + "Entries starting with this keyword will never be exported. +\\ +An entry can be toggled between COMMENT and normal with +`\\[org-toggle-comment]'.") + + +;;;; LaTeX Environments and Fragments + +(defconst org-latex-regexps + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil) + ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) + "Regular expressions for matching embedded LaTeX.") + +;;;; Node Property + +(defconst org-effort-property "Effort" + "The property that is being used to keep track of effort estimates. +Effort estimates given in this property need to have the format H:MM.") + +;;;; Table + +(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" + "Detect an org-type or table-type table.") + +(defconst org-table-line-regexp "^[ \t]*|" + "Detect an org-type table line.") + +(defconst org-table-dataline-regexp "^[ \t]*|[^-]" + "Detect an org-type table line.") + +(defconst org-table-hline-regexp "^[ \t]*|-" + "Detect an org-type table hline.") + +(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" + "Detect a table-type table hline.") + +(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" + "Detect the first line outside a table when searching from within it. +This works for both table types.") + +(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " + "Detect a #+TBLFM line.") + +;;;; Timestamp + +(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" + "Regular expression for fast time stamp matching.") + +(defconst org-ts-regexp-inactive + "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]" + "Regular expression for fast inactive time stamp matching.") + +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" + "Regular expression for fast time stamp matching.") + +(defconst org-ts-regexp0 + "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis. +This one does not require the space after the date, so it can be used +on a string that terminates immediately after the date.") + +(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis.") + +(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") + "Regular expression matching time stamps, with groups.") + +(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") + "Regular expression matching time stamps (also [..]), with groups.") + +(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) + "Regular expression matching a time stamp range.") + +(defconst org-tr-regexp-both + (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) + "Regular expression matching a time stamp range.") + +(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" + org-ts-regexp "\\)?") + "Regular expression matching a time stamp or time stamp range.") + +(defconst org-tsr-regexp-both + (concat org-ts-regexp-both "\\(--?-?" + org-ts-regexp-both "\\)?") + "Regular expression matching a time stamp or time stamp range. +The time stamps may be either active or inactive.") +(defconst org-repeat-re + "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" + "Regular expression for specifying repeated events. +After a match, group 1 contains the repeat expression.") + +(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") + "Formats for `format-time-string' which are used for time stamps.") + + ;;; The custom variables (defgroup org nil @@ -337,7 +637,7 @@ When MESSAGE is non-nil, display a message with the version." :group 'calendar) (defcustom org-mode-hook nil - "Mode hook for Org-mode, run after the mode was turned on." + "Mode hook for Org mode, run after the mode was turned on." :group 'org :type 'hook) @@ -359,17 +659,17 @@ When MESSAGE is non-nil, display a message with the version." (defun org-load-modules-maybe (&optional force) "Load all extensions listed in `org-modules'." (when (or force (not org-modules-loaded)) - (mapc (lambda (ext) - (condition-case nil (require ext) - (error (message "Problems while trying to load feature `%s'" ext)))) - org-modules) + (dolist (ext org-modules) + (condition-case nil (require ext) + (error (message "Problems while trying to load feature `%s'" ext)))) (setq org-modules-loaded t))) (defun org-set-modules (var value) "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." (set var value) (when (featurep 'org) - (org-load-modules-maybe 'force))) + (org-load-modules-maybe 'force) + (org-element-cache-reset 'all))) (defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) "Modules that should always be loaded together with org.el. @@ -397,6 +697,7 @@ For export specific modules, see also `org-export-backends'." (const :tag " crypt: Encryption of subtrees" org-crypt) (const :tag " ctags: Access to Emacs tags with links" org-ctags) (const :tag " docview: Links to doc-view buffers" org-docview) + (const :tag " eww: Store link to url of eww" org-eww) (const :tag " gnus: Links to GNUS folders/messages" org-gnus) (const :tag " habit: Track your consistency with habits" org-habit) (const :tag " id: Global IDs for identifying entries" org-id) @@ -407,52 +708,50 @@ For export specific modules, see also `org-export-backends'." (const :tag " mouse: Additional mouse support" org-mouse) (const :tag " protocol: Intercept calls from emacsclient" org-protocol) (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) - (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) + (const :tag " w3m: Special cut/paste from w3m to Org mode." org-w3m) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) - (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) + (const :tag "C bookmark: Org links to bookmarks" org-bookmark) (const :tag "C bullets: Add overlays to headlines stars" org-bullets) (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) (const :tag "C collector: Collect properties into tables" org-collector) - (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) - (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) - (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) + (const :tag "C depend: TODO dependencies for Org mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) + (const :tag "C drill: Flashcards and spaced repetition for Org mode" org-drill) + (const :tag "C elisp-symbol: Org links to emacs-lisp symbols" org-elisp-symbol) (const :tag "C eshell Support for links to working directories in eshell" org-eshell) (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) (const :tag "C eval: Include command output as text" org-eval) - (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) + (const :tag "C expiry: Expiry mechanism for Org entries" org-expiry) (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) (const :tag "C git-link: Provide org links to specific file version" org-git-link) (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) - (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) - (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) + (const :tag "C invoice: Help manage client invoices in Org mode" org-invoice) (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) - (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) - (const :tag "C man: Support for links to manpages in Org-mode" org-man) + (const :tag "C mairix: Hook mairix search into Org for different MUAs" org-mairix) + (const :tag "C man: Support for links to manpages in Org mode" org-man) (const :tag "C mew: Links to Mew folders/messages" org-mew) (const :tag "C mtags: Support for muse-like tags" org-mtags) (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) (const :tag "C panel: Simple routines for us with bad memory" org-panel) - (const :tag "C registry: A registry for Org-mode links" org-registry) - (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) + (const :tag "C registry: A registry for Org links" org-registry) + (const :tag "C screen: Visit screen sessions through Org links" org-screen) (const :tag "C secretary: Team management with org-mode" org-secretary) - (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) - (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) - (const :tag "C track: Keep up with Org-mode development" org-track) + (const :tag "C sqlinsert: Convert Org tables to SQL insertions" orgtbl-sqlinsert) + (const :tag "C toc: Table of contents for Org buffer" org-toc) + (const :tag "C track: Keep up with Org mode development" org-track) (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) (const :tag "C vm: Links to VM folders/messages" org-vm) (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) -(defvar org-export--registered-backends) ; From ox.el. +(defvar org-export-registered-backends) ; From ox.el. (declare-function org-export-derived-backend-p "ox" (backend &rest backends)) (declare-function org-export-backend-name "ox" (backend) t) -(declare-function org-export-backend-options "ox" (cl-x) t) -(defcustom org-export-backends '(ascii html icalendar latex) +(defcustom org-export-backends '(ascii html icalendar latex odt) "List of export back-ends that should be always available. If a description starts with , the file is not part of Emacs @@ -469,8 +768,8 @@ interface or run the following code, where VAL stands for the new value of the variable, after updating it: (progn - (setq org-export--registered-backends - (org-remove-if-not + (setq org-export-registered-backends + (cl-remove-if-not (lambda (backend) (let ((name (org-export-backend-name backend))) (or (memq name val) @@ -478,9 +777,9 @@ value of the variable, after updating it: (dolist (b val) (and (org-export-derived-backend-p b name) (throw \\='parentp t))))))) - org-export--registered-backends)) - (let ((new-list (mapcar \\='org-export-backend-name - org-export--registered-backends))) + org-export-registered-backends)) + (let ((new-list (mapcar #\\='org-export-backend-name + org-export-registered-backends))) (dolist (backend val) (cond ((not (load (format \"ox-%s\" backend) t t)) @@ -493,16 +792,16 @@ Adding a back-end to this list will also pull the back-end it depends on, if any." :group 'org :group 'org-export - :version "24.4" - :package-version '(Org . "8.0") + :version "26.1" + :package-version '(Org . "9.0") :initialize 'custom-initialize-set :set (lambda (var val) (if (not (featurep 'ox)) (set-default var val) ;; Any back-end not required anymore (not present in VAL and not ;; a parent of any back-end in the new value) is removed from the ;; list of registered back-ends. - (setq org-export--registered-backends - (org-remove-if-not + (setq org-export-registered-backends + (cl-remove-if-not (lambda (backend) (let ((name (org-export-backend-name backend))) (or (memq name val) @@ -510,11 +809,11 @@ depends on, if any." (dolist (b val) (and (org-export-derived-backend-p b name) (throw 'parentp t))))))) - org-export--registered-backends)) + org-export-registered-backends)) ;; Now build NEW-LIST of both new back-ends and required ;; parents. - (let ((new-list (mapcar 'org-export-backend-name - org-export--registered-backends))) + (let ((new-list (mapcar #'org-export-backend-name + org-export-registered-backends))) (dolist (backend val) (cond ((not (load (format "ox-%s" backend) t t)) @@ -544,19 +843,18 @@ depends on, if any." (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) (eval-after-load 'ox - '(mapc - (lambda (backend) - (condition-case nil (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s'" - backend)))) - org-export-backends)) + '(dolist (backend org-export-backends) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend))))) (defcustom org-support-shift-select nil "Non-nil means make shift-cursor commands select text when possible. +\\\ In Emacs 23, when `shift-select-mode' is on, shifted cursor keys start selecting a region, or enlarge regions started in this way. -In Org-mode, in special contexts, these same keys are used for +In Org mode, in special contexts, these same keys are used for other purposes, important enough to compete with shift selection. Org tries to balance these needs by supporting `shift-select-mode' outside these special contexts, under control of this variable. @@ -571,7 +869,7 @@ cursor keys will then execute Org commands in the following contexts: Outside these contexts, the commands will throw an error. When this variable is t and the cursor is not in a special -context, Org-mode will support shift-selection for making and +context, Org mode will support shift-selection for making and enlarging regions. To make this more effective, the bullet cycling will no longer happen anywhere in an item line, but only if the cursor is exactly on the bullet. @@ -579,16 +877,16 @@ if the cursor is exactly on the bullet. If you set this variable to the symbol `always', then the keys will not be special in headlines, property lines, and item lines, to make shift selection work there as well. If this is what you -want, you can use the following alternative commands: `C-c C-t' -and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t' -can be used to switch TODO sets, `C-c -' to cycle item bullet -types, and properties can be edited by hand or in column view. +want, you can use the following alternative commands: +`\\[org-todo]' and `\\[org-priority]' \ +to change TODO state and priority, +`\\[universal-argument] \\[universal-argument] \\[org-todo]' \ +can be used to switch TODO sets, +`\\[org-ctrl-c-minus]' to cycle item bullet types, +and properties can be edited by hand or in column view. However, when the cursor is on a timestamp, shift-cursor commands -will still edit the time stamp - this is just too good to give up. - -XEmacs user should have this variable set to nil, because -`shift-select-mode' is in Emacs 23 or later only." +will still edit the time stamp - this is just too good to give up." :group 'org :type '(choice (const :tag "Never" nil) @@ -622,12 +920,13 @@ already archived entries." :group 'org-archive) (defgroup org-startup nil - "Options concerning startup of Org-mode." + "Options concerning startup of Org mode." :tag "Org Startup" :group 'org) (defcustom org-startup-folded t - "Non-nil means entering Org-mode will switch to OVERVIEW. + "Non-nil means entering Org mode will switch to OVERVIEW. + This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: @@ -636,9 +935,9 @@ the following lines anywhere in the buffer: #+STARTUP: content #+STARTUP: showeverything -By default, this option is ignored when Org opens agenda files -for the first time. If you want the agenda to honor the startup -option, set `org-agenda-inhibit-startup' to nil." +Set `org-agenda-inhibit-startup' to a non-nil value if you want +to ignore this option when Org opens agenda files for the first +time." :group 'org-startup :type '(choice (const :tag "nofold: show all" nil) @@ -647,9 +946,18 @@ option, set `org-agenda-inhibit-startup' to nil." (const :tag "show everything, even drawers" showeverything))) (defcustom org-startup-truncated t - "Non-nil means entering Org-mode will set `truncate-lines'. + "Non-nil means entering Org mode will set `truncate-lines'. This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." +uninteresting. Also tables look terrible when wrapped. + +The variable `org-startup-truncated' allows to configure +truncation for Org mode different to the other modes that use the +variable `truncate-lines' and as a shortcut instead of putting +the variable `truncate-lines' into the `org-mode-hook'. If one +wants to configure truncation for Org mode not statically but +dynamically e. g. in a hook like `ediff-prepare-buffer-hook' then +the variable `truncate-lines' has to be used because in such a +case it is too late to set the variable `org-startup-truncated'." :group 'org-startup :type 'boolean) @@ -742,26 +1050,26 @@ the following lines anywhere in the buffer: :type 'boolean) (defcustom org-insert-mode-line-in-empty-file nil - "Non-nil means insert the first line setting Org-mode in empty files. + "Non-nil means insert the first line setting Org mode in empty files. When the function `org-mode' is called interactively in an empty file, this -normally means that the file name does not automatically trigger Org-mode. -To ensure that the file will always be in Org-mode in the future, a -line enforcing Org-mode will be inserted into the buffer, if this option +normally means that the file name does not automatically trigger Org mode. +To ensure that the file will always be in Org mode in the future, a +line enforcing Org mode will be inserted into the buffer, if this option has been set." :group 'org-startup :type 'boolean) (defcustom org-replace-disputed-keys nil "Non-nil means use alternative key bindings for some keys. -Org-mode uses S- keys for changing timestamps and priorities. +Org mode uses S- keys for changing timestamps and priorities. These keys are also used by other packages like shift-selection-mode' \(built into Emacs 23), `CUA-mode' or `windmove.el'. -If you want to use Org-mode together with one of these other modes, -or more generally if you would like to move some Org-mode commands to +If you want to use Org mode together with one of these other modes, +or more generally if you would like to move some Org mode commands to other keys, set this variable and configure the keys with the variable `org-disputed-keys'. -This option is only relevant at load-time of Org-mode, and must be set +This option is only relevant at load-time of Org mode, and must be set *before* org.el is loaded. Changing it requires a restart of Emacs to become effective." :group 'org-startup @@ -769,18 +1077,13 @@ become effective." (defcustom org-use-extra-keys nil "Non-nil means use extra key sequence definitions for certain commands. -This happens automatically if you run XEmacs or if `window-system' -is nil. This variable lets you do the same manually. You must -set it before loading org. - -Example: on Carbon Emacs 22 running graphically, with an external -keyboard on a Powerbook, the default way of setting M-left might -not work for either Alt or ESC. Setting this variable will make -it work for ESC." +This happens automatically if `window-system' is nil. This +variable lets you do the same manually. You must set it before +loading Org." :group 'org-startup :type 'boolean) -(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) +(defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) (defcustom org-disputed-keys '(([(shift up)] . [(meta p)]) @@ -789,90 +1092,52 @@ it work for ESC." ([(shift right)] . [(meta +)]) ([(control shift right)] . [(meta shift +)]) ([(control shift left)] . [(meta shift -)])) - "Keys for which Org-mode and other modes compete. + "Keys for which Org mode and other modes compete. This is an alist, cars are the default keys, second element specifies the alternative to use when `org-replace-disputed-keys' is t. Keys can be specified in any syntax supported by `define-key'. -The value of this option takes effect only at Org-mode's startup, +The value of this option takes effect only at Org mode startup, therefore you'll have to restart Emacs to apply it after changing." :group 'org-startup :type 'alist) (defun org-key (key) "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed. -Also apply the translations defined in `org-xemacs-key-equivalents'." +Or return the original if not disputed." (when org-replace-disputed-keys (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) + (x (cl-find-if (lambda (x) (equal (key-description (car x)) nkey)) + org-disputed-keys))) (setq key (if x (cdr x) key)))) - (when (featurep 'xemacs) - (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) key) -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - (defun org-defkey (keymap key def) "Define a key, possibly translated, as returned by `org-key'." (define-key keymap (org-key key) def)) (defcustom org-ellipsis nil - "The ellipsis to use in the Org-mode outline. + "The ellipsis to use in the Org mode outline. + When nil, just use the standard three dots. When a string, use that string instead. -When a face, use the standard 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). + +The change affects only Org mode (which will then use its own display table). Changing this requires executing `\\[org-mode]' in a buffer to become effective." :group 'org-startup :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) + (string :tag "String" :value "...#")) + :safe #'string-or-null-p) (defvar org-display-table nil "The display table for org-mode, in case `org-ellipsis' is non-nil.") (defgroup org-keywords nil - "Keywords in Org-mode." + "Keywords in Org mode." :tag "Org Keywords" :group 'org) -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - (defcustom org-closed-keep-when-no-todo nil "Remove CLOSED: time-stamp when switching back to a non-todo state?" :group 'org-todo @@ -881,37 +1146,8 @@ Changes become only effective after restarting Emacs." :package-version '(Org . "8.0") :type 'boolean) -(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" - org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string "\\|" - org-clock-string "\\)") - "Matches a line with planning or clock info.") - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-repeat-re - "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - (defgroup org-structure nil - "Options concerning the general structure of Org-mode files." + "Options concerning the general structure of Org files." :tag "Org Structure" :group 'org) @@ -920,92 +1156,88 @@ After a match, group 1 contains the repeat expression.") :tag "Org Reveal Location" :group 'org-structure) -(defconst org-context-choice - '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean)))) - "Contexts for the reveal options.") - -(defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means show full hierarchy when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the hierarchy of headings -above the exposed location is shown. -Turning this off for example for sparse trees makes them very compact. -Instead of t, this can also be an alist specifying this option for different -contexts. Valid contexts are +(defcustom org-show-context-detail '((agenda . local) + (bookmark-jump . lineage) + (isearch . lineage) + (default . ancestors)) + "Alist between context and visibility span when revealing a location. + +\\Some actions may move point into invisible +locations. As a consequence, Org always expose a neighborhood +around point. How much is shown depends on the initial action, +or context. Valid contexts are + agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' on key C-c C-j - occur-tree when using the command `org-occur' on key C-c / + org-goto when using the command `org-goto' (`\\[org-goto]') + occur-tree when using the command `org-occur' (`\\[org-sparse-tree] /') tags-tree when constructing a sparse tree based on tags matches link-search when exposing search matches associated with a link mark-goto when exposing the jump goal of a mark bookmark-jump when exposing a bookmark location isearch when exiting from an incremental search - default default for all contexts not set explicitly" - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-following-heading '((default . nil)) - "Non-nil means show following heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the heading following the -match is shown. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t)) - "Non-nil means show all sibling heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the sibling of the current entry -heading are all made visible. If `org-show-hierarchy-above' is t, -the same happens on each level of the hierarchy above the current entry. - -By default this is on for the isearch context, off for all other contexts. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice - :version "24.4" - :package-version '(Org . "8.0")) + default default for all contexts not set explicitly + +Allowed visibility spans are + + minimal show current headline; if point is not on headline, + also show entry -(defcustom org-show-entry-below '((default . nil)) - "Non-nil means show the entry below a headline when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the text below the headline that is -exposed is also shown. + local show current headline, entry and next headline -By default this is off for all contexts. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." + ancestors show current headline and its direct ancestors; if + point is not on headline, also show entry + + lineage show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and first child + + tree show current headline, its direct ancestors and all + their children; if point is not on headline, also show + entry and all children + + canonical show current headline, its direct ancestors along with + their entries and children; if point is not located on + the headline, also show current entry and all children + +As special cases, a nil or t value means show all contexts in +`minimal' or `canonical' view, respectively. + +Some views can make displayed information very compact, but also +make it harder to edit the location of the match. In such +a case, use the command `org-reveal' (`\\[org-reveal]') to show +more context." :group 'org-reveal-location - :type org-context-choice) + :version "26.1" + :package-version '(Org . "9.0") + :type '(choice + (const :tag "Canonical" t) + (const :tag "Minimal" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const agenda) + (const org-goto) + (const occur-tree) + (const tags-tree) + (const link-search) + (const mark-goto) + (const bookmark-jump) + (const isearch) + (const default)) + (choice :tag "Detail level" + (const minimal) + (const local) + (const ancestors) + (const lineage) + (const tree) + (const canonical)))))) (defcustom org-indirect-buffer-display 'other-window "How should indirect tree buffers be displayed? + This applies to indirect buffers created with the commands -\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. +`org-tree-to-indirect-buffer' and `org-agenda-tree-to-indirect-buffer'. + Valid values are: current-window Display in the current window other-window Just display in another window. @@ -1024,7 +1256,13 @@ new-frame Make a new frame each time. Note that in this case (defcustom org-use-speed-commands nil "Non-nil means activate single letter commands at beginning of a headline. This may also be a function to test for appropriate locations where speed -commands should be active." +commands should be active. + +For example, to activate speed commands when the point is on any +star at the beginning of the headline, you can do this: + + (setq org-use-speed-commands + (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))" :group 'org-structure :type '(choice (const :tag "Never" nil) @@ -1054,10 +1292,10 @@ commands in the Help buffer using the `?' speed command." (sexp)))))) (defcustom org-bookmark-names-plist - '(:last-capture "org-capture-last-stored" - :last-refile "org-refile-last-stored" - :last-capture-marker "org-capture-last-stored-marker") - "Names for bookmarks automatically set by some Org commands. + '(:last-capture "org-capture-last-stored" + :last-refile "org-refile-last-stored" + :last-capture-marker "org-capture-last-stored-marker") + "Names for bookmarks automatically set by some Org commands. This can provide strings as names for a number of bookmarks Org sets automatically. The following keys are currently implemented: :last-capture @@ -1065,11 +1303,11 @@ automatically. The following keys are currently implemented: :last-refile When a key does not show up in the property list, the corresponding bookmark is not set." - :group 'org-structure - :type 'plist) + :group 'org-structure + :type 'plist) (defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." + "Options concerning visibility cycling in Org mode." :tag "Org Cycle" :group 'org-structure) @@ -1093,25 +1331,8 @@ than its value." (const :tag "No limit" nil) (integer :tag "Maximum level"))) -(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :group 'org-cycle - :type '(repeat (string :tag "Drawer Name"))) - (defcustom org-hide-block-startup nil - "Non-nil means entering Org-mode will fold all blocks. + "Non-nil means entering Org mode will fold all blocks. This can also be set in on a per-file basis with #+STARTUP: hideblocks @@ -1122,12 +1343,17 @@ This can also be set in on a per-file basis with (defcustom org-cycle-global-at-bob nil "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -\\[universal-argument] TAB. For this special case to work, the first line -of the buffer must not be a headline -- it may be empty or some other text. + +This makes it possible to do global cycling without having to use `S-TAB' +or `\\[universal-argument] TAB'. For this special case to work, the first \ +line of the buffer +must not be a headline -- it may be empty or some other text. + When used in this way, `org-cycle-hook' is disabled temporarily to make -sure the cursor stays at the beginning of the buffer. When this option is -nil, don't do anything special at the beginning of the buffer." +sure the cursor stays at the beginning of the buffer. + +When this option is nil, don't do anything special at the beginning of +the buffer." :group 'org-cycle :type 'boolean) @@ -1166,7 +1392,7 @@ visibility is cycled." "Number of empty lines needed to keep an empty line between collapsed trees. If you leave an empty line between the end of a subtree and the following headline, this empty line is hidden when the subtree is folded. -Org-mode will leave (exactly) one empty line visible if the number of +Org mode will leave (exactly) one empty line visible if the number of empty lines is equal or larger to the number given in this variable. So the default 2 means at least 2 empty lines after the end of a subtree are needed to produce free space between a collapsed subtree and the @@ -1192,7 +1418,6 @@ the values `folded', `children', or `subtree'." (defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees org-cycle-hide-drawers - org-cycle-hide-inline-tasks org-cycle-show-empty-lines org-optimize-window-after-visibility-change) "Hook that is run after `org-cycle' has changed the buffer visibility. @@ -1202,10 +1427,12 @@ argument is a symbol. After a global state change, it can have the values `overview', `contents', or `all'. After a local state change, it can have the values `folded', `children', or `subtree'." :group 'org-cycle - :type 'hook) + :type 'hook + :version "26.1" + :package-version '(Org . "8.3")) (defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." + "Options concerning structure editing in Org mode." :tag "Org Edit Structure" :group 'org-structure) @@ -1229,23 +1456,25 @@ lines to the buffer: "Non-nil means adapt indentation to outline node level. When this variable is set, Org assumes that you write outlines by -indenting text in each node to align with the headline (after the stars). -The following issues are influenced by this variable: +indenting text in each node to align with the headline (after the +stars). The following issues are influenced by this variable: -- When this is set and the *entire* text in an entry is indented, the - indentation is increased by one space in a demotion command, and - decreased by one in a promotion command. If any line in the entry - body starts with text at column 0, indentation is not changed at all. +- The indentation is increased by one space in a demotion + command, and decreased by one in a promotion command. However, + in the latter case, if shifting some line in the entry body + would alter document structure (e.g., insert a new headline), + indentation is not changed at all. -- Property drawers and planning information is inserted indented when - this variable s set. When nil, they will not be indented. +- Property drawers and planning information is inserted indented + when this variable is set. When nil, they will not be indented. -- TAB indents a line relative to context. The lines below a headline - will be indented when this variable is set. +- TAB indents a line relative to current level. The lines below + a headline will be indented when this variable is set. -Note that this is all about true indentation, by adding and removing -space characters. See also `org-indent.el' which does level-dependent -indentation in a virtual way, i.e. at display time in Emacs." +Note that this is all about true indentation, by adding and +removing space characters. See also `org-indent.el' which does +level-dependent indentation in a virtual way, i.e. at display +time in Emacs." :group 'org-edit-structure :type 'boolean) @@ -1286,7 +1515,7 @@ This may also be a cons cell where the behavior for `C-a' and (const :tag "off" nil) (const :tag "on: before tags first" t) (const :tag "reversed: after tags first" reversed))))) -(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) +(defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) (defcustom org-special-ctrl-k nil "Non-nil means `C-k' will behave specially in headlines. @@ -1386,9 +1615,11 @@ default the value to be used for all contexts not explicitly (defcustom org-insert-heading-respect-content nil "Non-nil means insert new headings after the current subtree. +\\ When nil, the new heading is created directly after the current line. -The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn -this variable on for the duration of the command." +The commands `\\[org-insert-heading-respect-content]' and \ +`\\[org-insert-todo-heading-respect-content]' turn this variable on +for the duration of the command." :group 'org-structure :type 'boolean) @@ -1398,11 +1629,7 @@ this variable on for the duration of the command." The value is an alist, with `heading' and `plain-list-item' as CAR, and a boolean flag as CDR. The cdr may also be the symbol `auto', in which case Org will look at the surrounding headings/items and try to -make an intelligent decision whether to insert a blank line or not. - -For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, -the setting here is ignored and no empty line is inserted to avoid breaking -the list structure." +make an intelligent decision whether to insert a blank line or not." :group 'org-edit-structure :type '(list (cons (const heading) @@ -1422,8 +1649,7 @@ the list structure." (defcustom org-enable-fixed-width-editor t "Non-nil means lines starting with \":\" are treated as fixed-width. This currently only means they are never auto-wrapped. -When nil, such lines will be treated like ordinary lines. -See also the QUOTE keyword." +When nil, such lines will be treated like ordinary lines." :group 'org-edit-structure :type 'boolean) @@ -1441,7 +1667,7 @@ When nil, you can use these keybindings to navigate the buffer: :type 'boolean) (defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." + "Options concerning sparse trees in Org mode." :tag "Org Sparse Trees" :group 'org-structure) @@ -1454,14 +1680,26 @@ changed by an edit command." (defcustom org-remove-highlights-with-change t "Non-nil means any change to the buffer will remove temporary highlights. +\\\ Such highlights are created by `org-occur' and `org-clock-display'. -When nil, `C-c C-c' needs to be used to get rid of the highlights. -The highlights created by `org-preview-latex-fragment' always need -`C-c C-c' to be removed." +When nil, `\\[org-ctrl-c-ctrl-c]' needs to be used \ +to get rid of the highlights. +The highlights created by `org-toggle-latex-fragment' always need +`\\[org-toggle-latex-fragment]' to be removed." :group 'org-sparse-trees :group 'org-time :type 'boolean) +(defcustom org-occur-case-fold-search t + "Non-nil means `org-occur' should be case-insensitive. +If set to `smart' the search will be case-insensitive only if it +doesn't specify any upper case character." + :group 'org-sparse-trees + :version "26.1" + :type '(choice + (const :tag "Case-sensitive" nil) + (const :tag "Case-insensitive" t) + (const :tag "Case-insensitive for lower case searches only" 'smart))) (defcustom org-occur-hook '(org-first-headline-recenter) "Hook that is run after `org-occur' has constructed a sparse tree. @@ -1471,18 +1709,18 @@ as possible." :type 'hook) (defgroup org-imenu-and-speedbar nil - "Options concerning imenu and speedbar in Org-mode." + "Options concerning imenu and speedbar in Org mode." :tag "Org Imenu and Speedbar" :group 'org-structure) (defcustom org-imenu-depth 2 - "The maximum level for Imenu access to Org-mode headlines. + "The maximum level for Imenu access to Org headlines. This also applied for speedbar access." :group 'org-imenu-and-speedbar :type 'integer) (defgroup org-table nil - "Options concerning tables in Org-mode." + "Options concerning tables in Org mode." :tag "Org Table" :group 'org) @@ -1499,12 +1737,12 @@ do the following: TAB or RET are pressed to move to another field. With optimization this happens only if changes to a field might have changed the column width. Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. +`delete-char', and `backward-delete-char' in Org buffers, with a +slight (in fact: unnoticeable) speed impact for normal typing. Org is very +good at guessing when a re-align will be necessary, but you can always +force one with `\\[org-ctrl-c-ctrl-c]'. -If you would like to use the optimized version in Org-mode, but the +If you would like to use the optimized version in Org mode, but the un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. This variable can be used to turn on and off the table editor during a session, @@ -1517,8 +1755,7 @@ See also the variable `org-table-auto-blank-field'." (const :tag "on" t) (const :tag "on, optimized" optimized))) -(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) - (version<= emacs-version "24.1")) +(defcustom org-self-insert-cluster-for-undo nil "Non-nil means cluster self-insert commands for undo when possible. If this is set, then, like in the Emacs command loop, 20 consecutive characters will be undone together. @@ -1534,24 +1771,95 @@ calls `table-recognize-table'." :type 'boolean) (defgroup org-link nil - "Options concerning links in Org-mode." + "Options concerning links in Org mode." :tag "Org Link" :group 'org) -(defvar org-link-abbrev-alist-local nil +(defvar-local org-link-abbrev-alist-local nil "Buffer-local version of `org-link-abbrev-alist', which see. The value of this is taken from the #+LINK lines.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) + +(defcustom org-link-parameters + '(("doi" :follow org--open-doi-link) + ("elisp" :follow org--open-elisp-link) + ("file" :complete org-file-complete-link) + ("ftp" :follow (lambda (path) (browse-url (concat "ftp:" path)))) + ("help" :follow org--open-help-link) + ("http" :follow (lambda (path) (browse-url (concat "http:" path)))) + ("https" :follow (lambda (path) (browse-url (concat "https:" path)))) + ("mailto" :follow (lambda (path) (browse-url (concat "mailto:" path)))) + ("message" :follow (lambda (path) (browse-url (concat "message:" path)))) + ("news" :follow (lambda (path) (browse-url (concat "news:" path)))) + ("shell" :follow org--open-shell-link)) + "An alist of properties that defines all the links in Org mode. +The key in each association is a string of the link type. +Subsequent optional elements make up a p-list of link properties. + +:follow - A function that takes the link path as an argument. + +:export - A function that takes the link path, description and +export-backend as arguments. + +:store - A function responsible for storing the link. See the +function `org-store-link-functions'. + +:complete - A function that inserts a link with completion. The +function takes one optional prefix arg. + +:face - A face for the link, or a function that returns a face. +The function takes one argument which is the link path. The +default face is `org-link'. + +:mouse-face - The mouse-face. The default is `highlight'. + +:display - `full' will not fold the link in descriptive +display. Default is `org-link'. + +:help-echo - A string or function that takes (window object position) +as arguments and returns a string. + +:keymap - A keymap that is active on the link. The default is +`org-mouse-map'. + +:htmlize-link - A function for the htmlize-link. Defaults +to (list :uri \"type:path\") + +:activate-func - A function to run at the end of font-lock +activation. The function must accept (link-start link-end path bracketp) +as arguments." + :group 'org-link + :type '(alist :tag "Link display parameters" + :value-type plist)) + +(defun org-link-get-parameter (type key) + "Get TYPE link property for KEY. +TYPE is a string and KEY is a plist keyword." + (plist-get + (cdr (assoc type org-link-parameters)) + key)) + +(defun org-link-set-parameters (type &rest parameters) + "Set link TYPE properties to PARAMETERS. + PARAMETERS should be :key val pairs." + (let ((data (assoc type org-link-parameters))) + (if data (setcdr data (org-combine-plists (cdr data) parameters)) + (push (cons type parameters) org-link-parameters) + (org-make-link-regexps) + (org-element-update-syntax)))) + +(defun org-link-types () + "Return a list of known link types." + (mapcar #'car org-link-parameters)) (defcustom org-link-abbrev-alist nil "Alist of link abbreviations. The car of each element is a string, to be replaced at the start of a link. The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated -links in Org-mode buffers can have an optional tag after a double colon, e.g. +links in Org buffers can have an optional tag after a double colon, e.g., [[linkkey:tag][description]] -The `linkkey' must be a word word, starting with a letter, followed +The `linkkey' must be a single word, starting with a letter, followed by letters, numbers, `-' or `_'. If REPLACE is a string, the tag will simply be appended to create the link. @@ -1603,11 +1911,18 @@ adaptive Use relative path for files in the current directory and sub- (const noabbrev) (const adaptive))) -(defcustom org-activate-links '(bracket angle plain radio tag date footnote) - "Types of links that should be activated in Org-mode files. -This is a list of symbols, each leading to the activation of a certain link -type. In principle, it does not hurt to turn on most link types - there may -be a small gain when turning off unused link types. The types are: +(defvaralias 'org-activate-links 'org-highlight-links) +(defcustom org-highlight-links '(bracket angle plain radio tag date footnote) + "Types of links that should be highlighted in Org files. + +This is a list of symbols, each one of them leading to the +highlighting of a certain link type. + +You can still open links that are not highlighted. + +In principle, it does not hurt to turn on highlighting for all +link types. There may be a small gain when turning off unused +link types. The types are: bracket The recommended [[link][description]] or [[link]] links with hiding. angle Links in angular brackets that may contain whitespace like @@ -1618,8 +1933,10 @@ tag Tag settings in a headline (link to tag search). date Time stamps (link to calendar). footnote Footnote labels. -Changing this variable requires a restart of Emacs to become effective." +If you set this variable during an Emacs session, use `org-mode-restart' +in the Org buffer so that the change takes effect." :group 'org-link + :group 'org-appearance :type '(set :greedy t (const :tag "Double bracket links" bracket) (const :tag "Angular bracket links" angle) @@ -1639,7 +1956,7 @@ return the description to use." :type '(choice (const nil) (function))) (defgroup org-link-store nil - "Options concerning storing links in Org-mode." + "Options concerning storing links in Org mode." :tag "Org Store Link" :group 'org-link) @@ -1684,32 +2001,36 @@ It should match if the message is from the user him/herself." (defcustom org-context-in-file-links t "Non-nil means file links from `org-store-link' contain context. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command +\\ +A search string will be added to the file name with :: as separator +and used to find the context when the link is activated by the command `org-open-at-point'. When this option is t, the entire active region will be placed in the search string of the file link. If set to a positive integer, only the first n lines of context will be stored. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') +Using a prefix arg to the command `org-store-link' (`\\[universal-argument] \ +\\[org-store-link]') negates this setting for the duration of the command." :group 'org-link-store :type '(choice boolean integer)) (defcustom org-keep-stored-link-after-insertion nil "Non-nil means keep link in list for entire session. - +\\ The command `org-store-link' adds a link pointing to the current location to an internal list. These links accumulate during a session. The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." +Org file (offering completion for all stored links). + +When this option is nil, every link which has been inserted once using +`\\[org-insert-link]' will be removed from the list, to make completing the \ +unused +links more efficient." :group 'org-link-store :type 'boolean) (defgroup org-link-follow nil - "Options concerning following links in Org-mode." + "Options concerning following links in Org mode." :tag "Org Follow Link" :group 'org-link) @@ -1749,8 +2070,8 @@ In tables, the special behavior of RET has precedence." (defcustom org-mouse-1-follows-link (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) "Non-nil means mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." +A longer mouse click will still set point. Needs to be set +before org.el is loaded." :group 'org-link-follow :version "24.4" :package-version '(Org . "8.3") @@ -1766,16 +2087,22 @@ Changing this requires a restart of Emacs to work correctly." :type 'integer) (defcustom org-link-search-must-match-exact-headline 'query-to-create - "Non-nil means internal links in Org files must exactly match a headline. -When nil, the link search tries to match a phrase with all words -in the search text." + "Non-nil means internal fuzzy links can only match headlines. + +When nil, the a fuzzy link may point to a target or a named +construct in the document. When set to the special value +`query-to-create', offer to create a new headline when none +matched. + +Spaces and statistics cookies are ignored during heading searches." :group 'org-link-follow :version "24.1" :type '(choice (const :tag "Use fuzzy text search" nil) (const :tag "Match only exact headline" t) (const :tag "Match exact headline or query to create it" - query-to-create))) + query-to-create)) + :safe #'symbolp) (defcustom org-link-frame-setup '((vm . vm-visit-folder-other-frame) @@ -1836,7 +2163,7 @@ another window." "Non-nil means use indirect buffer to display infile links. Activating internal links (from one location in a file to another location in the same file) normally just jumps to the location. When the link is -activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +activated with a `\\[universal-argument]' prefix (or with mouse-3), the link \ is displayed in another window. When this option is set, the other window actually displays an indirect buffer clone of the current buffer, to avoid any visibility @@ -1860,26 +2187,13 @@ window on that directory." :group 'org-link-follow :type 'boolean) -(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") - "Function and arguments to call for following mailto links. -This is a list with the first element being a Lisp function, and the -remaining elements being arguments to the function. In string arguments, -%a will be replaced by the address, and %s will be replaced by the subject -if one was given like in ." - :group 'org-link-follow - :type '(choice - (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) - (const :tag "compose-mail" (compose-mail "%a" "%s")) - (const :tag "message-mail" (message-mail "%a" "%s")) - (cons :tag "other" (function) (repeat :tag "argument" sexp)))) - (defcustom org-confirm-shell-link-function 'yes-or-no-p "Non-nil means ask for confirmation before executing shell links. Shell links can be dangerous: just think about a link [[shell:rm -rf ~/*][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. Just change it to `y-or-n-p' if you want to confirm with a @@ -1891,7 +2205,7 @@ single keystroke rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (put 'org-confirm-shell-link-function 'safe-local-variable - #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defcustom org-confirm-shell-link-not-regexp "" "A regexp to skip confirmation for shell links." @@ -1905,7 +2219,7 @@ Elisp links can be dangerous: just think about a link [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] -This link would show up in your Org-mode document as \"Google Search\", +This link would show up in your Org document as \"Google Search\", but really it would remove your entire home directory. Therefore we advise against setting this variable to nil. Just change it to `y-or-n-p' if you want to confirm with a @@ -1917,7 +2231,7 @@ single keystroke rather than having to type \"yes\"." (const :tag "no confirmation (dangerous)" nil))) (put 'org-confirm-shell-link-function 'safe-local-variable - #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + (lambda (x) (member x '(yes-or-no-p y-or-n-p)))) (defcustom org-confirm-elisp-link-not-regexp "" "A regexp to skip confirmation for Elisp links." @@ -1934,30 +2248,23 @@ See `org-file-apps'.") (defconst org-file-apps-defaults-macosx '((remote . emacs) - (t . "open %s") (system . "open %s") ("ps.gz" . "gv %s") ("eps.gz" . "gv %s") ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) + ("fig" . "xfig %s") + (t . "open %s")) "Default file applications on a macOS system. The system \"open\" is known as a default, but we use X11 applications for some files for which the OS does not have a good default. See `org-file-apps'.") (defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file)) - (cons 'system - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) + (list '(remote . emacs) + (cons 'system (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file)))) + (cons t (lambda (file _path) + (with-no-warnings (w32-shell-execute "open" file))))) "Default file applications on a Windows NT system. The system \"open\" is used for most files. See `org-file-apps'.") @@ -1968,11 +2275,15 @@ See `org-file-apps'.") ("\\.x?html?\\'" . default) ("\\.pdf\\'" . default)) "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but +\\\ + +Org mode uses system defaults for different file types, but you can use this variable to set the application for a given file extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are +files and the cdr the corresponding command. + +Possible values for the file identifier are: + \"string\" A string as a file identifier can be interpreted in different ways, depending on its contents: @@ -1985,8 +2296,8 @@ file identifier are filename matches the regexp. If you want to use groups here, use shy groups. - Example: (\"\\.x?html\\\\='\" . \"firefox %s\") - (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + Example: (\"\\\\.x?html\\\\\\='\" . \"firefox %s\") + (\"\\\\(?:xhtml\\\\|html\\\\)\\\\\\='\" . \"firefox %s\") to open *.html and *.xhtml with firefox. - Regular expression which contains (non-shy) groups: @@ -1998,10 +2309,11 @@ file identifier are that does not use any of the group matches, this case is handled identically to the second one (i.e. match against file name only). - In a custom lisp form, you can access the group matches with + In a custom function, you can access the group matches with (match-string n link). - Example: (\"\\.pdf::\\(\\d+\\)\\\\='\" . \"evince -p %1 %s\") + Example: (\"\\\\.pdf::\\\\(\\\\d+\\\\)\\\\\\='\" . \ +\"evince -p %1 %s\") to open [[file:document.pdf::5]] with evince at page 5. `directory' Matches a directory @@ -2013,28 +2325,32 @@ file identifier are command `emacs' will open most files in Emacs. Beware that this will also open html files inside Emacs, unless you add (\"html\" . default) to the list as well. - t Default for files not matched by any of the other options. `system' The system command to open files, like `open' on Windows and macOS, and mailcap under GNU/Linux. This is the command - that will be selected if you call `C-c C-o' with a double - \\[universal-argument] \\[universal-argument] prefix. + that will be selected if you call `org-open-at-point' with a + double prefix argument (`\\[universal-argument] \ +\\[universal-argument] \\[org-open-at-point]'). + t Default for files not matched by any of the other options. Possible values for the command are: + `emacs' The file will be visited by the current Emacs process. `default' Use the default application for this file type, which is the association for t in the list, most likely in the system-specific - part. - This can be used to overrule an unwanted setting in the + part. This can be used to overrule an unwanted setting in the system-specific variable. `system' Use the system command for opening files, like \"open\". This command is specified by the entry whose car is `system'. Most likely, the system-specific version of this variable does define this command, but you can overrule/replace it here. +`mailcap' Use command specified in the mailcaps. string A command to be executed by a shell; %s will be replaced by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. + function A Lisp function, which will be called with two arguments: + the file path and the original link string, without the + \"file:\" prefix. + For more examples, see the system specific constants `org-file-apps-defaults-macosx' `org-file-apps-defaults-windowsnt' @@ -2054,7 +2370,7 @@ For more examples, see the system specific constants (const :tag "Use default" default) (const :tag "Use the system command" system) (string :tag "Command") - (sexp :tag "Lisp form"))))) + (function :tag "Function"))))) (defcustom org-doi-server-url "http://dx.doi.org/" "The URL of the DOI server." @@ -2063,22 +2379,22 @@ For more examples, see the system specific constants :group 'org-link-follow) (defgroup org-refile nil - "Options concerning refiling entries in Org-mode." + "Options concerning refiling entries in Org mode." :tag "Org Refile" :group 'org) (defcustom org-directory "~/org" - "Directory with org files. + "Directory with Org files. This is just a default location to look for Org files. There is no need -at all to put your files into this directory. It is only used in the +at all to put your files into this directory. It is used in the following situations: 1. When a capture template specifies a target file that is not an absolute path. The path will then be interpreted relative to `org-directory' -2. When a capture note is filed away in an interactive way (when exiting the - note buffer with `C-1 C-c C-c'. The user is prompted for an org file, - with `org-directory' as the default path." +2. When the value of variable `org-agenda-files' is a single file, any + relative paths in this file will be taken as relative to + `org-directory'." :group 'org-refile :group 'org-capture :type 'directory) @@ -2089,9 +2405,7 @@ Used as a fall back file for org-capture.el, for templates that do not specify a target file." :group 'org-refile :group 'org-capture - :type '(choice - (const :tag "Default from remember-data-file" nil) - file)) + :type 'file) (defcustom org-goto-interface 'outline "The default interface to be used for `org-goto'. @@ -2154,7 +2468,7 @@ will temporarily be changed to `time'." (const :tag "Record timestamp with note." note))) (defcustom org-refile-targets nil - "Targets for refiling entries with \\[org-refile]. + "Targets for refiling entries with `\\[org-refile]'. This is a list of cons cells. Each cell contains: - a specification of the files to be considered, either a list of files, or a symbol whose function or variable value will be used to retrieve @@ -2218,12 +2532,15 @@ of the subtree." (defcustom org-refile-use-cache nil "Non-nil means cache refile targets to speed up the process. +\\\ The cache for a particular file will be updated automatically when the buffer has been killed, or when any of the marker used for flagging refile targets no longer points at a live buffer. If you have added new entries to a buffer that might themselves be targets, -you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you -find that easier, `C-u C-u C-u C-c C-w'." +you need to clear the cache manually by pressing `C-0 \\[org-refile]' or, +if you find that easier, \ +`\\[universal-argument] \\[universal-argument] \\[universal-argument] \ +\\[org-refile]'." :group 'org-refile :version "24.1" :type 'boolean) @@ -2246,13 +2563,13 @@ When `full-file-path', include the full file path." (defcustom org-outline-path-complete-in-steps t "Non-nil means complete the outline path in hierarchical steps. -When Org-mode uses the refile interface to select an outline path -\(see variable `org-refile-use-outline-path'), the completion of -the path can be done is a single go, or if can be done in steps down -the headline hierarchy. Going in steps is probably the best if you -do not use a special completion package like `ido' or `icicles'. -However, when using these packages, going in one step can be very -fast, while still showing the whole path to the entry." +When Org uses the refile interface to select an outline path (see +`org-refile-use-outline-path'), the completion of the path can be +done in a single go, or it can be done in steps down the headline +hierarchy. Going in steps is probably the best if you do not use +a special completion package like `ido' or `icicles'. However, +when using these packages, going in one step can be very fast, +while still showing the whole path to the entry." :group 'org-refile :type 'boolean) @@ -2285,12 +2602,12 @@ converted to a headline before refiling." :type 'boolean) (defgroup org-todo nil - "Options concerning TODO items in Org-mode." + "Options concerning TODO items in Org mode." :tag "Org TODO" :group 'org) (defgroup org-progress nil - "Options concerning Progress logging in Org-mode." + "Options concerning Progress logging in Org mode." :tag "Org Progress" :group 'org-time) @@ -2308,12 +2625,12 @@ Each sequence starts with a symbol, either `sequence' or `type', indicating if the keywords should be interpreted as a sequence of action steps, or as different types of TODO items. The first keywords are states requiring action - these states will select a headline -for inclusion into the global TODO list Org-mode produces. If one of -the \"keywords\" is the vertical bar, \"|\", the remaining keywords +for inclusion into the global TODO list Org produces. If one of the +\"keywords\" is the vertical bar, \"|\", the remaining keywords signify that no further action is necessary. If \"|\" is not found, the last keyword is treated as the only DONE state of the sequence. -The command \\[org-todo] cycles an entry through these states, and one +The command `\\[org-todo]' cycles an entry through these states, and one additional state where no keyword is present. For details about this cycling, see the manual. @@ -2356,44 +2673,37 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (lambda (widget) (widget-put widget :args (mapcar - #'(lambda (x) - (widget-convert - (cons 'const x))) + (lambda (x) + (widget-convert + (cons 'const x))) org-todo-interpretation-widgets)) widget)) (repeat (string :tag "Keyword")))))) -(defvar org-todo-keywords-1 nil +(defvar-local org-todo-keywords-1 nil "All TODO and DONE keywords active in a buffer.") -(make-variable-buffer-local 'org-todo-keywords-1) (defvar org-todo-keywords-for-agenda nil) (defvar org-done-keywords-for-agenda nil) -(defvar org-drawers-for-agenda nil) (defvar org-todo-keyword-alist-for-agenda nil) (defvar org-tag-alist-for-agenda nil "Alist of all tags from all agenda files.") (defvar org-tag-groups-alist-for-agenda nil "Alist of all groups tags from all current agenda files.") -(defvar org-tag-groups-alist nil) -(make-variable-buffer-local 'org-tag-groups-alist) +(defvar-local org-tag-groups-alist nil) (defvar org-agenda-contributing-files nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) +(defvar-local org-current-tag-alist nil + "Alist of all tag groups in current buffer. +This variable takes into consideration `org-tag-alist', +`org-tag-persistent-alist' and TAGS keywords in the buffer.") +(defvar-local org-not-done-keywords nil) +(defvar-local org-done-keywords nil) +(defvar-local org-todo-heads nil) +(defvar-local org-todo-sets nil) +(defvar-local org-todo-log-states nil) +(defvar-local org-todo-kwd-alist nil) +(defvar-local org-todo-key-alist nil) +(defvar-local org-todo-key-trigger nil) (defcustom org-todo-interpretation 'sequence "Controls how TODO keywords are interpreted. @@ -2407,7 +2717,8 @@ more information." (const type))) (defcustom org-use-fast-todo-selection t - "Non-nil means use the fast todo selection scheme with C-c C-t. + "\\\ +Non-nil means use the fast todo selection scheme with `\\[org-todo]'. This variable describes if and under what circumstances the cycling mechanism for TODO keywords will be replaced by a single-key, direct selection scheme. @@ -2415,8 +2726,9 @@ selection scheme. When nil, fast selection is never used. When the symbol `prefix', it will be used when `org-todo' is called -with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and -`C-u t' in an agenda buffer. +with a prefix argument, i.e. `\\[universal-argument] \\[org-todo]' \ +in an Org buffer, and +`\\[universal-argument] t' in an agenda buffer. When t, fast selection is used by default. In this case, the prefix argument forces cycling instead. @@ -2436,6 +2748,9 @@ ALL-HEADLINES means update todo statistics by including headlines with no TODO keyword as well, counting them as not done. A list of TODO keywords means the same, but skip keywords that are not in this list. +When set to a list of two lists, the first list contains keywords +to consider as TODO keywords, the second list contains keywords +to consider as DONE keywords. When this is set, todo statistics is updated in the parent of the current entry each time a todo state is changed." @@ -2445,6 +2760,9 @@ current entry each time a todo state is changed." (const :tag "Yes, including all entries" all-headlines) (repeat :tag "Yes, for TODOs in this list" (string :tag "TODO keyword")) + (list :tag "Yes, for TODOs and DONEs in these lists" + (repeat (string :tag "TODO keyword")) + (repeat (string :tag "DONE keyword"))) (other :tag "No TODO statistics" nil))) (defcustom org-hierarchical-todo-statistics t @@ -2529,7 +2847,7 @@ to change is while Emacs is running is through the customize interface." (defcustom org-treat-insert-todo-heading-as-state-change nil "Non-nil means inserting a TODO heading is treated as state change. -So when the command \\[org-insert-todo-heading] is used, state change +So when the command `\\[org-insert-todo-heading]' is used, state change logging will apply if appropriate. When nil, the new TODO item will be inserted directly, and no logging will take place." :group 'org-todo @@ -2667,20 +2985,23 @@ When nil, only the date will be recorded." (refile . "Refiled on %t") (clock-out . "")) "Headings for notes added to entries. -The value is an alist, with the car being a symbol indicating the note -context, and the cdr is the heading to be used. The heading may also be the -empty string. -%t in the heading will be replaced by a time stamp. -%T will be an active time stamp instead the default inactive one -%d will be replaced by a short-format time stamp. -%D will be replaced by an active short-format time stamp. -%s will be replaced by the new TODO state, in double quotes. -%S will be replaced by the old TODO state, in double quotes. -%u will be replaced by the user name. -%U will be replaced by the full user name. - -In fact, it is not a good idea to change the `state' entry, because -agenda log mode depends on the format of these entries." + +The value is an alist, with the car being a symbol indicating the +note context, and the cdr is the heading to be used. The heading +may also be the empty string. The following placeholders can be +used: + + %t a time stamp. + %T an active time stamp instead the default inactive one + %d a short-format time stamp. + %D an active short-format time stamp. + %s the new TODO state or time stamp (inactive), in double quotes. + %S the old TODO state or time stamp (inactive), in double quotes. + %u the user name. + %U full user name. + +In fact, it is not a good idea to change the `state' entry, +because Agenda Log mode depends on the format of these entries." :group 'org-todo :group 'org-progress :type '(list :greedy t @@ -2719,7 +3040,10 @@ If this variable is set, `org-log-state-notes-insert-after-drawers' will be ignored. You can set the property LOG_INTO_DRAWER to overrule this setting for -a subtree." +a subtree. + +Do not check directly this variable in a Lisp program. Call +function `org-log-into-drawer' instead." :group 'org-todo :group 'org-progress :type '(choice @@ -2727,18 +3051,20 @@ a subtree." (const :tag "LOGBOOK" t) (string :tag "Other"))) -(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) +(defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) (defun org-log-into-drawer () - "Return the value of `org-log-into-drawer', but let properties overrule. -If the current entry has or inherits a LOG_INTO_DRAWER property, it will be -used instead of the default value." + "Name of the log drawer, as a string, or nil. +This is the value of `org-log-into-drawer'. However, if the +current entry has or inherits a LOG_INTO_DRAWER property, it will +be used instead of the default value." (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t))) - (cond - ((not p) org-log-into-drawer) - ((equal p "nil") nil) - ((equal p "t") "LOGBOOK") - (t p)))) + (cond ((equal p "nil") nil) + ((equal p "t") "LOGBOOK") + ((stringp p) p) + (p "LOGBOOK") + ((stringp org-log-into-drawer) org-log-into-drawer) + (org-log-into-drawer "LOGBOOK")))) (defcustom org-log-state-notes-insert-after-drawers nil "Non-nil means insert state change notes after any drawers in entry. @@ -2804,7 +3130,7 @@ property to one or more of these keywords." (defgroup org-priorities nil - "Priorities in Org-mode." + "Priorities in Org mode." :tag "Org Priorities" :group 'org-todo) @@ -2862,24 +3188,13 @@ as an argument and return the numeric priority." (function))) (defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." + "Options concerning time stamps and deadlines in Org mode." :tag "Org Time" :group 'org) -(defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point. -When nil, these labeled time stamps are forces into the second line of an -entry, just after the headline. When scheduling from the global TODO list, -the time stamp will always be forced into the second line." - :group 'org-time - :type 'boolean) - -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - (defcustom org-time-stamp-rounding-minutes '(0 5) "Number of minutes to round time stamps to. +\\\ These are two values, the first applies when first creating a time stamp. The second applies when changing it with the commands `S-up' and `S-down'. When changing the time stamp, this means that it will change in steps @@ -2889,14 +3204,15 @@ When a setting is 0 or 1, insert the time unmodified. Useful rounding numbers should be factors of 60, so for example 5, 10, 15. When this is larger than 1, you can still force an exact time stamp by using -a double prefix argument to a time stamp command like `C-c .' or `C-c !', +a double prefix argument to a time stamp command like \ +`\\[org-time-stamp]' or `\\[org-time-stamp-inactive], and by using a prefix arg to `S-up/down' to specify the exact number of minutes to shift." :group 'org-time - :get #'(lambda (var) ; Make sure both elements are there - (if (integerp (default-value var)) - (list (default-value var) 5) - (default-value var))) + :get (lambda (var) ; Make sure both elements are there + (if (integerp (default-value var)) + (list (default-value var) 5) + (default-value var))) :type '(list (integer :tag "when inserting times") (integer :tag "when modifying times"))) @@ -3013,7 +3329,7 @@ in minutes (even for durations longer than an hour)." (const t))))) (defcustom org-time-clocksum-use-fractional nil - "When non-nil, \\[org-clock-display] uses fractional times. + "When non-nil, `\\[org-clock-display]' uses fractional times. See `org-time-clocksum-format' for more on time clock formats." :group 'org-time :group 'org-clock @@ -3021,7 +3337,7 @@ See `org-time-clocksum-format' for more on time clock formats." :type 'boolean) (defcustom org-time-clocksum-use-effort-durations nil - "When non-nil, \\[org-clock-display] uses effort durations. + "When non-nil, `\\[org-clock-display]' uses effort durations. E.g. by default, one day is considered to be a 8 hours effort, so a task that has been clocked for 16 hours will be displayed as during 2 days in the clock display or in the clocktable. @@ -3052,9 +3368,9 @@ is used." :group 'org-time :type '(choice (string :tag "Format string") (set (group :inline t (const :tag "Years" :years) - (string :tag "Format string")) + (string :tag "Format string")) (group :inline t (const :tag "Months" :months) - (string :tag "Format string")) + (string :tag "Format string")) (group :inline t (const :tag "Weeks" :weeks) (string :tag "Format string")) (group :inline t (const :tag "Days" :days) @@ -3097,8 +3413,8 @@ This affects the following situations: For example, if it is April and you enter \"feb 2\", this will be read as Feb 2, *next* year. \"May 5\", however, will be this year. 2. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", + For example, if today is the 15th, and you enter \"3\", Org will read + this as the third of *next* month. However, if you enter \"17\", it will be considered as *this* month. If you set this variable to the symbol `time', then also the following @@ -3176,22 +3492,9 @@ In the calendar, the date can be selected with mouse-1. However, the minibuffer will also be active, and you can simply enter the date as well. When nil, only the minibuffer will be available." :group 'org-time - :type 'boolean) -(org-defvaralias 'org-popup-calendar-for-date-prompt - 'org-read-date-popup-calendar) - -(make-obsolete-variable - 'org-read-date-minibuffer-setup-hook - "Set `org-read-date-minibuffer-local-map' instead." "24.4") -(defcustom org-read-date-minibuffer-setup-hook nil - "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a -temporary copy. - -WARNING: This option is obsolete, you should use -`org-read-date-minibuffer-local-map' to set up keys." - :group 'org-time - :type 'hook) + :type 'boolean) +(defvaralias 'org-popup-calendar-for-date-prompt + 'org-read-date-popup-calendar) (defcustom org-extend-today-until 0 "The hour when your day really ends. Must be an integer. @@ -3240,52 +3543,76 @@ moved to the new date." :type 'boolean) (defgroup org-tags nil - "Options concerning tags in Org-mode." + "Options concerning tags in Org mode." :tag "Org Tags" :group 'org) (defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." + "Default tags available in Org files. + +The value of this variable is an alist. Associations either: + + (TAG) + (TAG . SELECT) + (SPECIAL) + +where TAG is a tag as a string, SELECT is character, used to +select that tag through the fast tag selection interface, and +SPECIAL is one of the following keywords: `:startgroup', +`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or +`:newline'. These keywords are used to define a hierarchy of +tags. See manual for details. + +When this variable is nil, Org mode bases tag input on what is +already in the buffer. The value can be overridden locally by +using a TAGS keyword, e.g., + + #+TAGS: tag1 tag2 + +See also `org-tag-persistent-alist' to sidestep this behavior." :group 'org-tags :type '(repeat (choice (cons (string :tag "Tag name") (character :tag "Access char")) - (list :tag "Start radio group" - (const :startgroup) - (option (string :tag "Group description"))) - (list :tag "Group tags delimiter" - (const :grouptags)) - (list :tag "End radio group" - (const :endgroup) - (option (string :tag "Group description"))) + (const :tag "Start radio group" (:startgroup)) + (const :tag "Start tag group, non distinct" (:startgrouptag)) + (const :tag "Group tags delimiter" (:grouptags)) + (const :tag "End radio group" (:endgroup)) + (const :tag "End tag group, non distinct" (:endgrouptag)) (const :tag "New line" (:newline))))) (defcustom org-tag-persistent-alist nil - "List of tags that will always appear in all Org-mode files. -This is in addition to any in buffer settings or customizations -of `org-tag-alist'. -When this list is nil, Org-mode will base TAG input on `org-tag-alist'. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details. -To disable these tags on a per-file basis, insert anywhere in the file: - #+STARTUP: noptag" + "Tags always available in Org files. + +The value of this variable is an alist. Associations either: + + (TAG) + (TAG . SELECT) + (SPECIAL) + +where TAG is a tag as a string, SELECT is a character, used to +select that tag through the fast tag selection interface, and +SPECIAL is one of the following keywords: `:startgroup', +`:startgrouptag', `:grouptags', `:engroup', `:endgrouptag' or +`:newline'. These keywords are used to define a hierarchy of +tags. See manual for details. + +Unlike to `org-tag-alist', tags defined in this variable do not +depend on a local TAGS keyword. Instead, to disable these tags +on a per-file basis, insert anywhere in the file: + + #+STARTUP: noptag" :group 'org-tags :type '(repeat (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) + (cons (string :tag "Tag name") + (character :tag "Access char")) (const :tag "Start radio group" (:startgroup)) + (const :tag "Start tag group, non distinct" (:startgrouptag)) (const :tag "Group tags delimiter" (:grouptags)) (const :tag "End radio group" (:endgroup)) + (const :tag "End tag group, non distinct" (:endgrouptag)) (const :tag "New line" (:newline))))) (defcustom org-complete-tags-always-offer-all-agenda-tags nil @@ -3296,9 +3623,7 @@ tags in that file can be created dynamically (there are none). (add-hook \\='org-capture-mode-hook (lambda () - (set (make-local-variable - \\='org-complete-tags-always-offer-all-agenda-tags) - t)))" + (setq-local org-complete-tags-always-offer-all-agenda-tags t)))" :group 'org-tags :version "24.1" :type 'boolean) @@ -3340,7 +3665,7 @@ displaying the tags menu is not even shown, until you press C-c again." "Non-nil means fast tags selection interface will also offer TODO states. This is an undocumented feature, you should not rely on it.") -(defcustom org-tags-column (if (featurep 'xemacs) -76 -77) +(defcustom org-tags-column -77 "The column to which tags should be indented in a headline. If this number is positive, it specifies the column. If it is negative, it means that the tags should be flushright to that column. For example, @@ -3437,7 +3762,7 @@ is better to limit inheritance to certain tags using the variables "Hook that is run after the tags in a line have changed.") (defgroup org-properties nil - "Options concerning properties in Org-mode." + "Options concerning properties in Org mode." :tag "Org Properties" :group 'org) @@ -3504,14 +3829,14 @@ in this variable)." (regexp :tag "Properties matched by regexp"))) (defun org-property-inherit-p (property) - "Check if PROPERTY is one that should be inherited." + "Return a non-nil value if PROPERTY should be inherited." (cond ((eq org-use-property-inheritance t) t) ((not org-use-property-inheritance) nil) ((stringp org-use-property-inheritance) (string-match org-use-property-inheritance property)) ((listp org-use-property-inheritance) - (member property org-use-property-inheritance)) + (member-ignore-case property org-use-property-inheritance)) (t (error "Invalid setting of `org-use-property-inheritance'")))) (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" @@ -3532,26 +3857,6 @@ ellipses string, only part of the ellipses string will be shown." :group 'org-properties :type 'string) -(defcustom org-columns-modify-value-for-display-function nil - "Function that modifies values for display in column view. -For example, it can be used to cut out a certain part from a time stamp. -The function must take 2 arguments: - -column-title The title of the column (*not* the property name) -value The value that should be modified. - -The function should return the value that should be displayed, -or nil if the normal value should be used." - :group 'org-properties - :type '(choice (const nil) (function))) - -(defcustom org-effort-property "Effort" - "The property that is being used to keep track of effort estimates. -Effort estimates given in this property need to have the format H:MM." - :group 'org-properties - :group 'org-progress - :type '(string :tag "Property")) - (defconst org-global-properties-fixed '(("VISIBILITY_ALL" . "folded children content all") ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) @@ -3582,18 +3887,17 @@ You can set buffer-local values for the same purpose in the variable (cons (string :tag "Property") (string :tag "Value")))) -(defvar org-file-properties nil +(defvar-local org-file-properties nil "List of property/value pairs that can be inherited by any entry. Valid for the current buffer. This variable is populated from #+PROPERTY lines.") -(make-variable-buffer-local 'org-file-properties) (defgroup org-agenda nil - "Options concerning agenda views in Org-mode." + "Options concerning agenda views in Org mode." :tag "Org Agenda" :group 'org) -(defvar org-category nil +(defvar-local org-category nil "Variable used by org files to set a category for agenda display. Such files should use a file variable to set it, for example @@ -3605,22 +3909,22 @@ or contain a special line If the file does not specify a category, then file's base name is used instead.") -(make-variable-buffer-local 'org-category) -(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x)))) +(put 'org-category 'safe-local-variable (lambda (x) (or (symbolp x) (stringp x)))) (defcustom org-agenda-files nil "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. -If an entry is a directory, all files in that directory that are matched by -`org-agenda-file-regexp' will be part of the file list. +If an entry is a directory, all files in that directory that are matched +by `org-agenda-file-regexp' will be part of the file list. If the value of the variable is not a list but a single file name, then -the list of agenda files is actually stored and maintained in that file, one -agenda file per line. In this file paths can be given relative to +the list of agenda files is actually stored and maintained in that file, +one agenda file per line. In this file paths can be given relative to `org-directory'. Tilde expansion and environment variable substitution -are also made." +are also made. + +Entries may be added to this list with `\\[org-agenda-file-to-front]' +and removed with `\\[org-remove-file]'." :group 'org-agenda :type '(choice (repeat :tag "List of files and directories" file) @@ -3637,7 +3941,8 @@ regular expression will be included." (defcustom org-agenda-text-search-extra-files nil "List of extra files to be searched by text search commands. These files will be searched in addition to the agenda files by the -commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. +commands `org-search-view' (`\\[org-agenda] s') \ +and `org-occur-in-agenda-files'. Note that these files will only be searched for text search commands, not for the other agenda views like todo lists, tag searches or the weekly agenda. This variable is intended to list notes and possibly archive files @@ -3650,7 +3955,7 @@ scope." (const :tag "Agenda Archives" agenda-archives) (repeat :inline t (file)))) -(org-defvaralias 'org-agenda-multi-occur-extra-files +(defvaralias 'org-agenda-multi-occur-extra-files 'org-agenda-text-search-extra-files) (defcustom org-agenda-skip-unavailable-files nil @@ -3670,7 +3975,7 @@ forth between agenda and calendar." (defcustom org-calendar-insert-diary-entry-key [?i] "The key to be installed in `calendar-mode-map' for adding diary entries. This option is irrelevant until `org-agenda-diary-file' has been configured -to point to an Org-mode file. When that is the case, the command +to point to an Org file. When that is the case, the command `org-agenda-diary-entry' will be bound to the key given here, by default `i'. In the calendar, `i' normally adds entries to `diary-file'. So if you want to continue doing this, you need to change this to a different @@ -3700,7 +4005,7 @@ points to a file, `org-agenda-diary-entry' will be used instead." 'org-agenda-diary-entry)))))) (defgroup org-latex nil - "Options for embedding LaTeX code into Org-mode." + "Options for embedding LaTeX code into Org mode." :tag "Org LaTeX" :group 'org) @@ -3755,39 +4060,131 @@ Replace format-specifiers in the command as noted below and use `shell-command' to convert LaTeX to MathML. %j: Executable file in fully expanded form as specified by `org-latex-to-mathml-jar-file'. -%I: Input LaTeX file in fully expanded form -%o: Output MathML file +%I: Input LaTeX file in fully expanded form. +%i: The latex fragment to be converted. +%o: Output MathML file. + This command is used by `org-create-math-formula'. -When using MathToWeb as the converter, set this to -\"java -jar %j -unicode -force -df %o %I\"." +When using MathToWeb as the converter, set this option to +\"java -jar %j -unicode -force -df %o %I\". + +When using LaTeXML set this option to +\"latexmlmath \"%i\" --presentationmathml=%o\"." :group 'org-latex :version "24.1" :type '(choice (const :tag "None" nil) (string :tag "\nShell command"))) -(defcustom org-latex-create-formula-image-program 'dvipng - "Program to convert LaTeX fragments with. - -dvipng Process the LaTeX fragments to dvi file, then convert - dvi files to png files using dvipng. - This will also include processing of non-math environments. -imagemagick Convert the LaTeX fragments to pdf files and use imagemagick - to convert pdf files to png files" +(defcustom org-preview-latex-default-process 'dvipng + "The default process to convert LaTeX fragments to image files. +All available processes and theirs documents can be found in +`org-preview-latex-process-alist', which see." :group 'org-latex - :version "24.1" - :type '(choice - (const :tag "dvipng" dvipng) - (const :tag "imagemagick" imagemagick))) + :version "26.1" + :package-version '(Org . "9.0") + :type 'symbol) + +(defcustom org-preview-latex-process-alist + '((dvipng + :programs ("latex" "dvipng") + :description "dvi > png" + :message "you need to install the programs: latex and dvipng." + :image-input-type "dvi" + :image-output-type "png" + :image-size-adjust (1.0 . 1.0) + :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") + :image-converter ("dvipng -fg %F -bg %B -D %D -T tight -o %O %f")) + (dvisvgm + :programs ("latex" "dvisvgm") + :description "dvi > svg" + :message "you need to install the programs: latex and dvisvgm." + :use-xcolor t + :image-input-type "dvi" + :image-output-type "svg" + :image-size-adjust (1.7 . 1.5) + :latex-compiler ("latex -interaction nonstopmode -output-directory %o %f") + :image-converter ("dvisvgm %f -n -b min -c %S -o %O")) + (imagemagick + :programs ("latex" "convert") + :description "pdf > png" + :message "you need to install the programs: latex and imagemagick." + :use-xcolor t + :image-input-type "pdf" + :image-output-type "png" + :image-size-adjust (1.0 . 1.0) + :latex-compiler ("pdflatex -interaction nonstopmode -output-directory %o %f") + :image-converter + ("convert -density %D -trim -antialias %f -quality 100 %O"))) + "Definitions of external processes for LaTeX previewing. +Org mode can use some external commands to generate TeX snippet's images for +previewing or inserting into HTML files, e.g., \"dvipng\". This variable tells +`org-create-formula-image' how to call them. + +The value is an alist with the pattern (NAME . PROPERTIES). NAME is a symbol. +PROPERTIES accepts the following attributes: + + :programs list of strings, required programs. + :description string, describe the process. + :message string, message it when required programs cannot be found. + :image-input-type string, input file type of image converter (e.g., \"dvi\"). + :image-output-type string, output file type of image converter (e.g., \"png\"). + :use-xcolor boolean, when non-nil, LaTeX \"xcolor\" macro is used to + deal with background and foreground color of image. + Otherwise, dvipng style background and foregroud color + format are generated. You may then refer to them in + command options with \"%F\" and \"%B\". + :image-size-adjust cons of numbers, the car element is used to adjust LaTeX + image size showed in buffer and the cdr element is for + HTML file. This option is only useful for process + developers, users should use variable + `org-format-latex-options' instead. + :post-clean list of strings, files matched are to be cleaned up once + the image is generated. When nil, the files with \".dvi\", + \".xdv\", \".pdf\", \".tex\", \".aux\", \".log\", \".svg\", + \".png\", \".jpg\", \".jpeg\" or \".out\" extension will + be cleaned up. + :latex-header list of strings, the LaTeX header of the snippet file. + When nil, the fallback value is used instead, which is + controlled by `org-format-latex-header', + `org-latex-default-packages-alist' and + `org-latex-packages-alist', which see. + :latex-compiler list of LaTeX commands, as strings. Each of them is given + to the shell. Place-holders \"%t\", \"%b\" and \"%o\" are + replaced with values defined below. + :image-converter list of image converter commands strings. Each of them is + given to the shell and supports any of the following + place-holders defined below. + +Place-holders used by `:image-converter' and `:latex-compiler': + + %f input file name + %b base name of input file + %o base directory of input file + %O absolute output file name + +Place-holders only used by `:image-converter': + + %F foreground of image + %B background of image + %D dpi, which is used to adjust image size by some processing commands. + %S the image size scale ratio, which is used to adjust image size by some + processing commands." + :group 'org-latex + :version "26.1" + :package-version '(Org . "9.0") + :type '(alist :tag "LaTeX to image backends" + :value-type (plist))) -(defcustom org-latex-preview-ltxpng-directory "ltxpng/" +(defcustom org-preview-latex-image-directory "ltximg/" "Path to store latex preview images. A relative path here creates many directories relative to the processed org files paths. An absolute path puts all preview images at the same place." :group 'org-latex - :version "24.3" + :version "26.1" + :package-version '(Org . "9.0") :type 'string) (defun org-format-latex-mathml-available-p () @@ -3805,8 +4202,8 @@ images at the same place." (defcustom org-format-latex-header "\\documentclass{article} \\usepackage[usenames]{color} -[PACKAGES] -[DEFAULT-PACKAGES] +\[PACKAGES] +\[DEFAULT-PACKAGES] \\pagestyle{empty} % do not remove % The settings below are copied from fullpage.sty \\setlength{\\textwidth}{\\paperwidth} @@ -3847,22 +4244,19 @@ header, or they will be appended." (default-value var))) (defcustom org-latex-default-packages-alist - '(("AUTO" "inputenc" t) - ("T1" "fontenc" t) - ("" "fixltx2e" nil) + '(("AUTO" "inputenc" t ("pdflatex")) + ("T1" "fontenc" t ("pdflatex")) ("" "graphicx" t) + ("" "grffile" t) ("" "longtable" nil) - ("" "float" nil) ("" "wrapfig" nil) ("" "rotating" nil) ("normalem" "ulem" t) ("" "amsmath" t) ("" "textcomp" t) - ("" "marvosym" t) - ("" "wasysym" t) ("" "amssymb" t) - ("" "hyperref" nil) - "\\tolerance=1000") + ("" "capt-of" nil) + ("" "hyperref" nil)) "Alist of default packages to be inserted in the header. Change this only if one of the packages here causes an @@ -3872,16 +4266,17 @@ The packages in this list are needed by one part or another of Org mode to function properly: - inputenc, fontenc: for basic font and character selection -- fixltx2e: Important patches of LaTeX itself - graphicx: for including images +- grffile: allow periods and spaces in graphics file names - longtable: For multipage tables -- float, wrapfig: for figure placement +- wrapfig: for figure placement - rotating: for sideways figures and tables - ulem: for underline and strike-through - amsmath: for subscript and superscript and math environments -- textcomp, marvosymb, wasysym, amssymb: for various symbols used +- textcomp, amssymb: for various symbols used for interpreting the entities in `org-entities'. You can skip some of these packages if you don't use any of their symbols. +- capt-of: for captions outside of floats - hyperref: for cross references Therefore you should not modify this variable unless you know @@ -3890,20 +4285,24 @@ you might be loading some other package that conflicts with one of the default packages. Each element is either a cell or a string. -A cell is of the format: +A cell is of the format - ( \"options\" \"package\" SNIPPET-FLAG). + (\"options\" \"package\" SNIPPET-FLAG COMPILERS) If SNIPPET-FLAG is non-nil, the package also needs to be included when compiling LaTeX snippets into images for inclusion into -non-LaTeX output. +non-LaTeX output. COMPILERS is a list of compilers that should +include the package, see `org-latex-compiler'. If the document +compiler is not in the list, and the list is non-nil, the package +will not be inserted in the final document. A string will be inserted as-is in the header of the document." :group 'org-latex :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist - :version "24.1" + :version "26.1" + :package-version '(Org . "8.3") :type '(repeat (choice (list :tag "options/package pair" @@ -3947,7 +4346,7 @@ Make sure that you only list packages here which: (string :tag "A line of LaTeX")))) (defgroup org-appearance nil - "Settings for Org-mode appearance." + "Settings for Org mode appearance." :tag "Org Appearance" :group 'org) @@ -4038,6 +4437,11 @@ following symbols: :group 'org-appearance :type 'boolean) +(defcustom org-hide-macro-markers nil + "Non-nil mean font-lock should hide the brackets marking macro calls." + :group 'org-appearance + :type 'boolean) + (defcustom org-pretty-entities nil "Non-nil means show entities as UTF8 characters. When nil, the \\name form remains in the buffer." @@ -4124,7 +4528,7 @@ After a match, the match groups contain these elements: ;; set this option proved cumbersome. See this message/thread: ;; http://article.gmane.org/gmane.emacs.orgmode/68681 (defvar org-emphasis-regexp-components - '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) + '(" \t('\"{" "- \t.,:!?;'\")}\\[" " \t\r\n" "." 1) "Components used to build the regular expression for emphasis. This is a list with five entries. Terminology: In an emphasis string like \" *strong word* \", we call the initial space PREMATCH, the final @@ -4142,17 +4546,17 @@ newline The maximum number of newlines allowed in an emphasis exp. You need to reload Org or to restart Emacs after customizing this.") (defcustom org-emphasis-alist - `(("*" bold) + '(("*" bold) ("/" italic) ("_" underline) ("=" org-verbatim verbatim) ("~" org-code verbatim) - ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) + ("+" (:strike-through t))) "Alist of characters and faces to emphasize text. Text starting and ending with a special character will be emphasized, for example *bold*, _underlined_ and /italic/. This variable sets the marker characters and the face to be used by font-lock for highlighting -in Org-mode Emacs buffers. +in Org buffers. You need to reload Org or to restart Emacs after customizing this." :group 'org-appearance @@ -4167,122 +4571,68 @@ You need to reload Org or to restart Emacs after customizing this." (plist :tag "Face property list")) (option (const verbatim))))) -(defvar org-protecting-blocks - '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") +(defvar org-protecting-blocks '("src" "example" "export") "Blocks that contain text that is quoted, i.e. not processed as Org syntax. This is needed for font-lock setup.") -;;; Miscellaneous options - -(defgroup org-completion nil - "Completion in Org-mode." - :tag "Org Completion" - :group 'org) - -(defcustom org-completion-use-ido nil - "Non-nil means use ido completion wherever possible. -Note that `ido-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -See also `org-completion-use-iswitchb'." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-use-iswitchb nil - "Non-nil means use iswitchb completion wherever possible. -Note that `iswitchb-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -Note that this variable has only an effect if `org-completion-use-ido' is nil." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[pcomplete] in normal context. -Normal means, no org-mode-specific context." - :group 'org-completion - :type 'function) - ;;; Functions and variables from their packages ;; Declared here to avoid compiler warnings - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only (defvar mark-active) ;; Various packages -(declare-function calendar-iso-to-absolute "cal-iso" (date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-iso-from-absolute "cal-iso" (date)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function cdlatex-tab "ext:cdlatex" ()) +(declare-function calc-eval "calc" (str &optional separator &rest args)) +(declare-function calendar-forward-day "cal-move" (arg)) +(declare-function calendar-goto-date "cal-move" (date)) +(declare-function calendar-goto-today "cal-move" ()) +(declare-function calendar-iso-from-absolute "cal-iso" (date)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) (declare-function cdlatex-compute-tables "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(defvar font-lock-unfontify-region-function) -(declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional - default require-match _predicate start matches-set)) -(defvar iswitchb-temp-buflist) -(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) -(defvar org-agenda-tags-todo-honor-ignore-options) -(declare-function org-agenda-skip "org-agenda" ()) -(declare-function - org-agenda-format-item "org-agenda" - (extra txt &optional level category tags dotime remove-re habitp)) -(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) -(declare-function org-agenda-change-all-lines "org-agenda" +(declare-function cdlatex-tab "ext:cdlatex" ()) +(declare-function dired-get-filename + "dired" + (&optional localp no-error-if-not-filep)) +(declare-function iswitchb-read-buffer + "iswitchb" + (prompt &optional + default require-match _predicate start matches-set)) +(declare-function org-agenda-change-all-lines + "org-agenda" (newhead hdmarker &optional fixface just-this)) -(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) +(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + "org-agenda" + (&optional end)) +(declare-function org-agenda-copy-local-variable "org-agenda" (var)) +(declare-function org-agenda-format-item + "org-agenda" + (extra txt &optional level category tags dotime + remove-re habitp)) (declare-function org-agenda-maybe-redo "org-agenda" ()) -(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" +(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) +(declare-function org-agenda-save-markers-for-cut-and-paste + "org-agenda" (beg end)) -(declare-function org-agenda-copy-local-variable "org-agenda" (var)) -(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item - "org-agenda" (&optional end)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) +(declare-function org-agenda-skip "org-agenda" ()) +(declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) +(declare-function org-indent-mode "org-indent" (&optional arg)) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-indent-mode "org-indent" (&optional arg)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) (declare-function orgtbl-send-table "org-table" (&optional maybe)) -(defvar remember-data-file) -(defvar texmathp-why) +(declare-function parse-time-string "parse-time" (string)) (declare-function speedbar-line-directory "speedbar" (&optional depth)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) - -(defvar org-latex-regexps) - -;;; Autoload and prepare some org modules - -;; Some table stuff that needs to be defined here, because it is used -;; by the functions setting up org-mode or checking for table context. - -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detect an org-type or table-type table.") -(defconst org-table-line-regexp "^[ \t]*|" - "Detect an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detect an org-type table line.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detect an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detect a table-type table hline.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Detect the first line outside a table when searching from within it. -This works for both table types.") -(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " - "Detect a #+TBLFM line.") +(defvar align-mode-rules-list) +(defvar calc-embedded-close-formula) +(defvar calc-embedded-open-formula) +(defvar calc-embedded-open-mode) +(defvar font-lock-unfontify-region-function) +(defvar iswitchb-temp-buflist) +(defvar org-agenda-tags-todo-honor-ignore-options) +(defvar remember-data-file) +(defvar texmathp-why) ;;;###autoload (defun turn-on-orgtbl () @@ -4291,75 +4641,50 @@ This works for both table types.") (orgtbl-mode 1)) (defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table. -If TABLE-TYPE is non-nil, also check for table.el-type tables." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at (if table-type org-table-any-line-regexp - org-table-line-regexp))) - nil)) -(defsubst org-table-p () (org-at-table-p)) + "Non-nil if the cursor is inside an Org table. +If TABLE-TYPE is non-nil, also check for table.el-type tables. +If `org-enable-table-editor' is nil, return nil unconditionally." + (and + org-enable-table-editor + (save-excursion + (beginning-of-line) + (looking-at-p (if table-type "[ \t]*[|+]" "[ \t]*|"))) + (or (not (derived-mode-p 'org-mode)) + (let ((e (org-element-lineage (org-element-at-point) '(table) t))) + (and e (or table-type (eq (org-element-property :type e) 'org))))))) (defun org-at-table.el-p () - "Return t if and only if we are at a table.el table." - (and (org-at-table-p 'any) - (save-excursion - (goto-char (org-table-begin 'any)) - (looking-at org-table1-hline-regexp)))) - -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (if org-table-tab-recognizes-table.el - (if (org-at-table.el-p) - (progn - (beginning-of-line 1) - (if (looking-at org-table-dataline-regexp) - nil - (if (looking-at org-table1-hline-regexp) - (progn - (beginning-of-line 2) - (if (looking-at org-table-any-border-regexp) - (beginning-of-line -1))))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) - t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen")) - t) - nil) - nil)) + "Non-nil when point is at a table.el table." + (and (save-excursion (beginning-of-line) (looking-at "[ \t]*[|+]")) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'table) + (eq (org-element-property :type element) 'table.el))))) (defun org-at-table-hline-p () - "Return t if the cursor is inside a hline in a table." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at org-table-hline-regexp)) - nil)) + "Non-nil when point is inside a hline in a table. +Assume point is already in a table. If `org-enable-table-editor' +is nil, return nil unconditionally." + (and org-enable-table-editor + (save-excursion + (beginning-of-line) + (looking-at org-table-hline-regexp)))) (defun org-table-map-tables (function &optional quietly) "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (unless quietly - (message "Mapping tables: %d%%" - (floor (* 100.0 (point)) (buffer-size)))) - (beginning-of-line 1) - (when (and (looking-at org-table-line-regexp) - ;; Exclude tables in src/example/verbatim/clocktable blocks - (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) - (save-excursion (funcall function)) - (or (looking-at org-table-line-regexp) - (forward-char 1))) - (re-search-forward org-table-any-border-regexp nil 1)))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-table-any-line-regexp nil t) + (unless quietly + (message "Mapping tables: %d%%" + (floor (* 100.0 (point)) (buffer-size)))) + (beginning-of-line 1) + (when (and (looking-at org-table-line-regexp) + ;; Exclude tables in src/example/verbatim/clocktable blocks + (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) + (save-excursion (funcall function)) + (or (looking-at org-table-line-regexp) + (forward-char 1))) + (re-search-forward org-table-any-border-regexp nil 1))) (unless quietly (message "Mapping tables: done"))) (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) @@ -4368,12 +4693,12 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (&optional also-non-dangling-p prompt last-valid)) (defun org-at-TBLFM-p (&optional pos) - "Return t when point (or POS) is in #+TBLFM line." + "Non-nil when point (or POS) is in #+TBLFM line." (save-excursion - (let ((pos pos))) (goto-char (or pos (point))) - (beginning-of-line 1) - (looking-at org-TBLFM-regexp))) + (beginning-of-line) + (and (let ((case-fold-search t)) (looking-at org-TBLFM-regexp)) + (eq (org-element-type (org-element-at-point)) 'table)))) (defvar org-clock-start-time) (defvar org-clock-marker (make-marker) @@ -4410,7 +4735,7 @@ If yes, offer to stop it and to save the buffer with the changes." (add-hook 'kill-emacs-hook 'org-clock-save)) (defgroup org-archive nil - "Options concerning archiving in Org-mode." + "Options concerning archiving in Org mode." :tag "Org Archive" :group 'org-structure) @@ -4425,7 +4750,7 @@ When the filename is omitted, archiving happens in the same file. %s in the filename will be replaced by the current file name (without the directory part). Archiving to a different file is useful to keep archived entries from contributing to the -Org-mode Agenda. +Org Agenda. The archived entries will be filed as subtrees of the specified headline. When the headline is omitted, the subtrees are simply @@ -4473,16 +4798,6 @@ the hierarchy, it will be used." :group 'org-archive :type 'string) -(defcustom org-archive-tag "ARCHIVE" - "The tag that marks a subtree as archived. -An archived subtree does not open during visibility cycling, and does -not contribute to the agenda listings. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :type 'string) - (defcustom org-agenda-skip-archived-trees t "Non-nil means the agenda will skip any items located in archived trees. An archived tree is a tree marked with the tag ARCHIVE. The use of this @@ -4515,24 +4830,25 @@ collapsed state." :group 'org-sparse-trees :type 'boolean) -(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline +(defcustom org-sparse-tree-default-date-type nil "The default date type when building a sparse tree. When this is nil, a date is a scheduled or a deadline timestamp. Otherwise, these types are allowed: all: all timestamps active: only active timestamps (<...>) - inactive: only inactive timestamps (<...) + inactive: only inactive timestamps ([...]) scheduled: only scheduled timestamps deadline: only deadline timestamps" - :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline) + :type '(choice (const :tag "Scheduled or deadline" nil) (const :tag "All timestamps" all) (const :tag "Only active timestamps" active) (const :tag "Only inactive timestamps" inactive) (const :tag "Only scheduled timestamps" scheduled) (const :tag "Only deadline timestamps" deadline) (const :tag "Only closed timestamps" closed)) - :version "24.3" + :version "26.1" + :package-version '(Org . "8.3") :group 'org-sparse-trees) (defun org-cycle-hide-archived-subtrees (state) @@ -4545,9 +4861,10 @@ Otherwise, these types are allowed: (end (if globalp (point-max) (org-end-of-subtree t)))) (org-hide-archived-subtrees beg end) (goto-char beg) - (if (looking-at (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) + (when (looking-at-p (concat ".*:" org-archive-tag ":")) + (message "%s" (substitute-command-keys + "Subtree is archived and stays closed. Use \ +`\\[org-force-cycle-archived]' to cycle it anyway."))))))) (defun org-force-cycle-archived () "Cycle subtree even if it is archived." @@ -4558,13 +4875,16 @@ Otherwise, these types are allowed: (defun org-hide-archived-subtrees (beg end) "Re-hide all archived subtrees after a visibility state change." - (save-excursion - (let* ((re (concat ":" org-archive-tag ":"))) - (goto-char beg) - (while (re-search-forward re end t) - (when (org-at-heading-p) - (org-flag-subtree t) - (org-end-of-subtree t)))))) + (org-with-wide-buffer + (let ((case-fold-search nil) + (re (concat org-outline-regexp-bol ".*:" org-archive-tag ":"))) + (goto-char beg) + ;; Include headline point is currently on. + (beginning-of-line) + (while (and (< (point) end) (re-search-forward re end t)) + (when (member org-archive-tag (org-get-tags)) + (org-flag-subtree t) + (org-end-of-subtree t)))))) (declare-function outline-end-of-heading "outline" ()) (declare-function outline-flag-region "outline" (from to flag)) @@ -4580,7 +4900,6 @@ Otherwise, these types are allowed: ;; Declare Column View Code -(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) (declare-function org-columns-get-format-and-top-level "org-colview" ()) (declare-function org-columns-compute "org-colview" (property)) @@ -4593,79 +4912,47 @@ Otherwise, these types are allowed: ;;; Variables for pre-computed regular expressions, all buffer local -(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) -(defvar org-todo-regexp nil - "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil - "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-not-done-heading-regexp nil - "Matches a TODO headline that is not done.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-todo-line-regexp nil - "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil +(defvar-local org-todo-regexp nil + "Matches any of the TODO state keywords. +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching against this regexp.") + +(defvar-local org-not-done-regexp nil + "Matches any of the TODO state keywords except the last one. +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching against this regexp.") + +(defvar-local org-not-done-heading-regexp nil + "Matches a TODO headline that is not done. +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching against this regexp.") + +(defvar-local org-todo-line-regexp nil + "Matches a headline and puts TODO state into group 2 if present. +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching against this regexp.") + +(defvar-local org-complex-heading-regexp nil "Matches a headline and puts everything into groups: -group 1: the stars -group 2: The todo keyword, maybe + +group 1: Stars +group 2: The TODO keyword, maybe group 3: Priority cookie group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil +group 5: Tags + +Since TODO keywords are case-sensitive, `case-fold-search' is +expected to be bound to nil when matching against this regexp.") + +(defvar-local org-complex-heading-regexp-format nil "Printf format to make regexp to match an exact headline. This regexp will match the headline of any node which has the exact headline text that is put into the format, but may have any TODO state, priority and tags.") -(make-variable-buffer-local 'org-complex-heading-regexp-format) -(defvar org-todo-line-tags-regexp nil + +(defvar-local org-todo-line-tags-regexp nil "Matches a headline and puts TODO state into group 2 if present. Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) -(defvar org-ds-keyword-length 12 - "Maximum length of the DEADLINE and SCHEDULED keywords.") -(make-variable-buffer-local 'org-ds-keyword-length) -(defvar org-deadline-regexp nil - "Matches the DEADLINE keyword.") -(make-variable-buffer-local 'org-deadline-regexp) -(defvar org-deadline-time-regexp nil - "Matches the DEADLINE keyword together with a time stamp.") -(make-variable-buffer-local 'org-deadline-time-regexp) -(defvar org-deadline-time-hour-regexp nil - "Matches the DEADLINE keyword together with a time-and-hour stamp.") -(make-variable-buffer-local 'org-deadline-time-hour-regexp) -(defvar org-deadline-line-regexp nil - "Matches the DEADLINE keyword and the rest of the line.") -(make-variable-buffer-local 'org-deadline-line-regexp) -(defvar org-scheduled-regexp nil - "Matches the SCHEDULED keyword.") -(make-variable-buffer-local 'org-scheduled-regexp) -(defvar org-scheduled-time-regexp nil - "Matches the SCHEDULED keyword together with a time stamp.") -(make-variable-buffer-local 'org-scheduled-time-regexp) -(defvar org-scheduled-time-hour-regexp nil - "Matches the SCHEDULED keyword together with a time-and-hour stamp.") -(make-variable-buffer-local 'org-scheduled-time-hour-regexp) -(defvar org-closed-time-regexp nil - "Matches the CLOSED keyword together with a time stamp.") -(make-variable-buffer-local 'org-closed-time-regexp) - -(defvar org-keyword-time-regexp nil - "Matches any of the 4 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-regexp) -(defvar org-keyword-time-not-clock-regexp nil - "Matches any of the 3 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) -(defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceded by a keyword.") -(make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-all-time-keywords nil - "List of time keywords.") -(make-variable-buffer-local 'org-all-time-keywords) (defconst org-plain-time-of-day-regexp (concat @@ -4771,32 +5058,6 @@ in the #+STARTUP line), the corresponding variable, and the value to set this variable to if the option is found. An optional forth element PUSH means to push this value onto the list in the variable.") -(defun org-update-property-plist (key val props) - "Update PROPS with KEY and VAL." - (let* ((appending (string= "+" (substring key (- (length key) 1)))) - (key (if appending (substring key 0 (- (length key) 1)) key)) - (remainder (org-remove-if (lambda (p) (string= (car p) key)) props)) - (previous (cdr (assoc key props)))) - (if appending - (cons (cons key (if previous (concat previous " " val) val)) remainder) - (cons (cons key val) remainder)))) - -(defconst org-block-regexp - "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" - "Regular expression for hiding blocks.") -(defconst org-heading-keyword-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline with some keyword. -This regexp will match the headline of any node which has the -exact keyword that is put into the format. The keyword isn't in -any group by default, but the stars and the body are.") -(defconst org-heading-keyword-maybe-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline, possibly with some keyword. -This regexp can match any headline with the specified keyword, or -without a keyword. The keyword isn't in any group by default, -but the stars and the body are.") - (defcustom org-group-tags t "When non-nil (the default), use group tags. This can be turned on/off through `org-toggle-tags-groups'." @@ -4820,386 +5081,378 @@ Support for group tags is controlled by the option (message "Groups tags support has been turned %s" (if org-group-tags "on" "off"))) -(defun org-set-regexps-and-options-for-tags () - "Precompute variables used for tags." - (when (derived-mode-p 'org-mode) - (org-set-local 'org-file-tags nil) - (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) - (splitre "[ \t]+") - (start 0) - tags ftags key value) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq key (upcase (org-match-string-no-properties 1)) - value (org-match-string-no-properties 2)) - (if (stringp value) (setq value (org-trim value))) - (cond - ((equal key "TAGS") - (setq tags (append tags (if tags '("\\n") nil) - (org-split-string value splitre)))) - ((equal key "FILETAGS") - (when (string-match "\\S-" value) - (setq ftags - (append - ftags - (apply 'append - (mapcar (lambda (x) (org-split-string x ":")) - (org-split-string value))))))))))) - ;; Process the file tags. - (and ftags (org-set-local 'org-file-tags - (mapcar 'org-add-prop-inherited ftags))) - (org-set-local 'org-tag-groups-alist nil) - ;; Process the tags. - (when (and (not tags) org-tag-alist) - (setq tags - (mapcar - (lambda (tg) (cond ((eq (car tg) :startgroup) "{") - ((eq (car tg) :endgroup) "}") - ((eq (car tg) :grouptags) ":") - ((eq (car tg) :newline) "\n") - (t (concat (car tg) - (if (characterp (cdr tg)) - (format "(%s)" (char-to-string (cdr tg))) ""))))) - org-tag-alist))) - (let (tgs g) - (dolist (e tags) - (cond - ((equal e "{") - (progn (push '(:startgroup) tgs) - (when (equal (nth 1 tags) ":") - (push (list (replace-regexp-in-string - "(.+)$" "" (nth 0 tags))) - org-tag-groups-alist) - (setq g 0)))) - ((equal e ":") (push '(:grouptags) tgs)) - ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) - ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) - tgs) - (if (and g (> g 0)) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) - (list (match-string 1 e))))) - (if g (setq g (1+ g)))) - (t (push (list e) tgs) - (if (and g (> g 0)) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) (list e)))) - (if g (setq g (1+ g)))))) - (org-set-local 'org-tag-alist nil) - (dolist (e tgs) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist))) - ;; Return a list with tag variables - (list org-file-tags org-tag-alist org-tag-groups-alist))))) - -(defvar org-ota nil) -(defun org-set-regexps-and-options () - "Precompute regular expressions used in the current buffer." +(defun org-set-regexps-and-options (&optional tags-only) + "Precompute regular expressions used in the current buffer. +When optional argument TAGS-ONLY is non-nil, only compute tags +related expressions." (when (derived-mode-p 'org-mode) - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (org-set-local 'org-file-properties nil) - (let ((re (org-make-options-regexp - '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" - "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" - "SETUPFILE" "OPTIONS") - "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) - (splitre "[ \t]+") - (scripts org-use-sub-superscripts) - kwds kws0 kwsa key log value cat arch const links hw dws - tail sep kws1 prio props drawers ext-setup-or-nil setup-contents - (start 0)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while - (or (and - ext-setup-or-nil - (not org-ota) - (let (ret) - (with-temp-buffer - (insert ext-setup-or-nil) - (let ((major-mode 'org-mode) org-ota) - (setq ret (save-match-data - (org-set-regexps-and-options-for-tags))))) - ;; Append setupfile tags to existing tags - (setq org-ota t) - (setq org-file-tags - (delq nil (append org-file-tags (nth 0 ret))) - org-tag-alist - (delq nil (append org-tag-alist (nth 1 ret))) - org-tag-groups-alist - (delq nil (append org-tag-groups-alist (nth 2 ret)))))) - (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) - (setq key (upcase (match-string 1 ext-setup-or-nil)) - value (org-match-string-no-properties 2 ext-setup-or-nil)) - (if (stringp value) (setq value (org-trim value))) - (cond - ((equal key "CATEGORY") - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) - ;; general TODO-like setup - (push (cons (intern (downcase (match-string 1 key))) - (org-split-string value splitre)) - kwds)) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (setq props (org-update-property-plist (match-string 1 value) - (match-string 2 value) - props)))) - ((equal key "DRAWERS") - (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) - ((equal key "CONSTANTS") - (org-table-set-constants)) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - var val) - (dolist (l opts) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (setq arch value) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch)) - ((equal key "OPTIONS") - (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) - (setq scripts (read (match-string 2 value))))) - ((and (equal key "SETUPFILE") - ;; Prevent checking in Gnus messages - (not buffer-read-only)) - (setq setup-contents (org-file-contents - (expand-file-name - (org-remove-double-quotes value)) - 'noerror)) - (if (not ext-setup-or-nil) - (setq ext-setup-or-nil setup-contents start 0) - (setq ext-setup-or-nil - (concat (substring ext-setup-or-nil 0 start) - "\n" setup-contents "\n" - (substring ext-setup-or-nil start))))))) - ;; search for property blocks - (goto-char (point-min)) - (while (re-search-forward org-block-regexp nil t) - (when (equal "PROPERTY" (upcase (match-string 1))) - (setq value (replace-regexp-in-string - "[\n\r]" " " (match-string 4))) - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (setq props (org-update-property-plist (match-string 1 value) - (match-string 2 value) - props))))))) - (org-set-local 'org-use-sub-superscripts scripts) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (org-set-local 'org-lowest-priority (nth 1 prio)) - (org-set-local 'org-default-priority (nth 2 prio))) - (and props (org-set-local 'org-file-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kw) - (dolist (kws kwds) - (let ((kws (or - (run-hook-with-args-until-success - 'org-todo-setup-filter-hook kws) - kws))) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - ;; 1 2 - (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) - (progn - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log (org-extract-log-state-settings x)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push log org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws)))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) + (let ((alist (org--setup-collect-keywords + (org-make-options-regexp + (append '("FILETAGS" "TAGS" "SETUPFILE") + (and (not tags-only) + '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" + "LINK" "OPTIONS" "PRIORITIES" "PROPERTY" + "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO"))))))) + ;; Startup options. Get this early since it does change + ;; behavior for other options (e.g., tags). + (let ((startup (cdr (assq 'startup alist)))) + (dolist (option startup) + (let ((entry (assoc-string option org-startup-options t))) + (when entry + (let ((var (nth 1 entry)) + (val (nth 2 entry))) + (if (not (nth 3 entry)) (set (make-local-variable var) val) + (unless (listp (symbol-value var)) + (set (make-local-variable var) nil)) + (add-to-list var val))))))) + (setq-local org-file-tags + (mapcar #'org-add-prop-inherited + (cdr (assq 'filetags alist)))) + (setq org-current-tag-alist + (append org-tag-persistent-alist + (let ((tags (cdr (assq 'tags alist)))) + (if tags (org-tag-string-to-alist tags) + org-tag-alist)))) + (setq org-tag-groups-alist + (org-tag-alist-to-groups org-current-tag-alist)) + (unless tags-only + ;; File properties. + (setq-local org-file-properties (cdr (assq 'property alist))) + ;; Archive location. + (let ((archive (cdr (assq 'archive alist)))) + (when archive (setq-local org-archive-location archive))) + ;; Category. + (let ((cat (org-string-nw-p (cdr (assq 'category alist))))) + (when cat + (setq-local org-category (intern cat)) + (setq-local org-file-properties + (org--update-property-plist + "CATEGORY" cat org-file-properties)))) + ;; Columns. + (let ((column (cdr (assq 'columns alist)))) + (when column (setq-local org-columns-default-format column))) + ;; Constants. + (setq org-table-formula-constants-local (cdr (assq 'constants alist))) + ;; Link abbreviations. + (let ((links (cdr (assq 'link alist)))) + (when links (setq org-link-abbrev-alist-local (nreverse links)))) + ;; Priorities. + (let ((priorities (cdr (assq 'priorities alist)))) + (when priorities + (setq-local org-highest-priority (nth 0 priorities)) + (setq-local org-lowest-priority (nth 1 priorities)) + (setq-local org-default-priority (nth 2 priorities)))) + ;; Scripts. + (let ((scripts (assq 'scripts alist))) + (when scripts + (setq-local org-use-sub-superscripts (cdr scripts)))) + ;; TODO keywords. + (setq-local org-todo-kwd-alist nil) + (setq-local org-todo-key-alist nil) + (setq-local org-todo-key-trigger nil) + (setq-local org-todo-keywords-1 nil) + (setq-local org-done-keywords nil) + (setq-local org-todo-heads nil) + (setq-local org-todo-sets nil) + (setq-local org-todo-log-states nil) + (let ((todo-sequences + (or (nreverse (cdr (assq 'todo alist))) + (let ((d (default-value 'org-todo-keywords))) + (if (not (stringp (car d))) d + ;; XXX: Backward compatibility code. + (list (cons org-todo-interpretation d))))))) + (dolist (sequence todo-sequences) + (let* ((sequence (or (run-hook-with-args-until-success + 'org-todo-setup-filter-hook sequence) + sequence)) + (sequence-type (car sequence)) + (keywords (cdr sequence)) + (sep (member "|" keywords)) + names alist) + (dolist (k (remove "|" keywords)) + (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" + k) + (error "Invalid TODO keyword %s" k)) + (let ((name (match-string 1 k)) + (key (match-string 2 k)) + (log (org-extract-log-state-settings k))) + (push name names) + (push (cons name (and key (string-to-char key))) alist) + (when log (push log org-todo-log-states)))) + (let* ((names (nreverse names)) + (done (if sep (org-remove-keyword-keys (cdr sep)) + (last names))) + (head (car names)) + (tail (list sequence-type head (car done) (org-last done)))) + (add-to-list 'org-todo-heads head 'append) + (push names org-todo-sets) + (setq org-done-keywords (append org-done-keywords done nil)) + (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil)) + (setq org-todo-key-alist + (append org-todo-key-alist + (and alist + (append '((:startgroup)) + (nreverse alist) + '((:endgroup)))))) + (dolist (k names) (push (cons k tail) org-todo-kwd-alist)))))) (setq org-todo-sets (nreverse org-todo-sets) org-todo-kwd-alist (nreverse org-todo-kwd-alist) - org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) - org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) - ;; Compute the regular expressions and other local variables. - ;; Using `org-outline-regexp-bol' would complicate them much, - ;; because of the fixed white space at the end of that string. - (if (not org-done-keywords) - (setq org-done-keywords (and org-todo-keywords-1 - (list (org-last org-todo-keywords-1))))) - (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) - (length org-scheduled-string) - (length org-clock-string) - (length org-closed-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") - org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)") - org-not-done-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)") - org-not-done-heading-regexp - (format org-heading-keyword-regexp-format org-not-done-regexp) - org-todo-line-regexp - (format org-heading-keyword-maybe-regexp-format org-todo-regexp) - org-complex-heading-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") - "[ \t]*$") - org-complex-heading-regexp-format - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +" - ;; Stats cookies can be stuck to body. - "\\(?:\\[[0-9%%/]+\\] *\\)*" - "\\(%s\\)" - "\\(?: *\\[[0-9%%/]+\\]\\)*" - "\\)" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") - "[ \t]*$") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") - "[ \t]*$") - org-deadline-regexp (concat "\\<" org-deadline-string) - org-deadline-time-regexp - (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") - org-deadline-time-hour-regexp - (concat "\\<" org-deadline-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") - org-deadline-line-regexp - (concat "\\<\\(" org-deadline-string "\\).*") - org-scheduled-regexp - (concat "\\<" org-scheduled-string) - org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") - org-scheduled-time-hour-regexp - (concat "\\<" org-scheduled-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") - org-closed-time-regexp - (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") - org-keyword-time-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-keyword-time-not-clock-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-maybe-keyword-time-regexp - (concat "\\(\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-all-time-keywords - (mapcar (lambda (w) (substring w 0 -1)) - (list org-scheduled-string org-deadline-string - org-clock-string org-closed-string))) - (setq org-ota nil) - (org-compute-latex-and-related-regexp)))) + org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist)) + org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)) + ;; Compute the regular expressions and other local variables. + ;; Using `org-outline-regexp-bol' would complicate them much, + ;; because of the fixed white space at the end of that string. + (unless org-done-keywords + (setq org-done-keywords + (and org-todo-keywords-1 (last org-todo-keywords-1)))) + (setq org-not-done-keywords + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1)) + org-todo-regexp (regexp-opt org-todo-keywords-1 t) + org-not-done-regexp (regexp-opt org-not-done-keywords t) + org-not-done-heading-regexp + (format org-heading-keyword-regexp-format org-not-done-regexp) + org-todo-line-regexp + (format org-heading-keyword-maybe-regexp-format org-todo-regexp) + org-complex-heading-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?" + "[ \t]*$") + org-complex-heading-regexp-format + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +" + ;; Stats cookies can be stuck to body. + "\\(?:\\[[0-9%%/]+\\] *\\)*" + "\\(%s\\)" + "\\(?: *\\[[0-9%%/]+\\]\\)*" + "\\)" + "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?" + "[ \t]*$") + org-todo-line-tags-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(.*?\\)\\)??" + "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?" + "[ \t]*$")) + (org-compute-latex-and-related-regexp))))) + +(defun org--setup-collect-keywords (regexp &optional files alist) + "Return setup keywords values as an alist. + +REGEXP matches a subset of setup keywords. FILES is a list of +file names already visited. It is used to avoid circular setup +files. ALIST, when non-nil, is the alist computed so far. + +Return value contains the following keys: `archive', `category', +`columns', `constants', `filetags', `link', `priorities', +`property', `scripts', `startup', `tags' and `todo'." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (value (org-element-property :value element))) + (cond + ((equal key "ARCHIVE") + (when (org-string-nw-p value) + (push (cons 'archive value) alist))) + ((equal key "CATEGORY") (push (cons 'category value) alist)) + ((equal key "COLUMNS") (push (cons 'columns value) alist)) + ((equal key "CONSTANTS") + (let* ((constants (assq 'constants alist)) + (store (cdr constants))) + (dolist (pair (org-split-string value)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" + pair) + (let* ((name (match-string 1 pair)) + (value (match-string 2 pair)) + (old (assoc name store))) + (if old (setcdr old value) + (push (cons name value) store))))) + (if constants (setcdr constants store) + (push (cons 'constants store) alist)))) + ((equal key "FILETAGS") + (when (org-string-nw-p value) + (let ((old (assq 'filetags alist)) + (new (apply #'nconc + (mapcar (lambda (x) (org-split-string x ":")) + (org-split-string value))))) + (if old (setcdr old (append new (cdr old))) + (push (cons 'filetags new) alist))))) + ((equal key "LINK") + (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) + (let ((links (assq 'link alist)) + (pair (cons (match-string-no-properties 1 value) + (match-string-no-properties 2 value)))) + (if links (push pair (cdr links)) + (push (list 'link pair) alist))))) + ((equal key "OPTIONS") + (when (and (org-string-nw-p value) + (string-match "\\^:\\(t\\|nil\\|{}\\)" value)) + (push (cons 'scripts (read (match-string 1 value))) alist))) + ((equal key "PRIORITIES") + (push (cons 'priorities + (let ((prio (org-split-string value))) + (if (< (length prio) 3) '(?A ?C ?B) + (mapcar #'string-to-char prio)))) + alist)) + ((equal key "PROPERTY") + (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) + (let* ((property (assq 'property alist)) + (value (org--update-property-plist + (match-string-no-properties 1 value) + (match-string-no-properties 2 value) + (cdr property)))) + (if property (setcdr property value) + (push (cons 'property value) alist))))) + ((equal key "STARTUP") + (let ((startup (assq 'startup alist))) + (if startup + (setcdr startup + (append (cdr startup) (org-split-string value))) + (push (cons 'startup (org-split-string value)) alist)))) + ((equal key "TAGS") + (let ((tag-cell (assq 'tags alist))) + (if tag-cell + (setcdr tag-cell (concat (cdr tag-cell) "\n" value)) + (push (cons 'tags value) alist)))) + ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) + (let ((todo (assq 'todo alist)) + (value (cons (if (equal key "TYP_TODO") 'type 'sequence) + (org-split-string value)))) + (if todo (push value (cdr todo)) + (push (list 'todo value) alist)))) + ((equal key "SETUPFILE") + (unless buffer-read-only ; Do not check in Gnus messages. + (let ((f (and (org-string-nw-p value) + (expand-file-name + (org-unbracket-string "\"" "\"" value))))) + (when (and f (file-readable-p f) (not (member f files))) + (with-temp-buffer + (setq default-directory (file-name-directory f)) + (insert-file-contents f) + (setq alist + ;; Fake Org mode to benefit from cache + ;; without recurring needlessly. + (let ((major-mode 'org-mode)) + (org--setup-collect-keywords + regexp (cons f files) alist))))))))))))))) + alist) + +(defun org-tag-string-to-alist (s) + "Return tag alist associated to string S. +S is a value for TAGS keyword or produced with +`org-tag-alist-to-string'. Return value is an alist suitable for +`org-tag-alist' or `org-tag-persistent-alist'." + (let ((lines (mapcar #'split-string (split-string s "\n" t))) + (tag-re (concat "\\`\\([[:alnum:]_@#%]+" + "\\|{.+?}\\)" ; regular expression + "\\(?:(\\(.\\))\\)?\\'")) + alist group-flag) + (dolist (tokens lines (cdr (nreverse alist))) + (push '(:newline) alist) + (while tokens + (let ((token (pop tokens))) + (pcase token + ("{" + (push '(:startgroup) alist) + (when (equal (nth 1 tokens) ":") (setq group-flag t))) + ("}" + (push '(:endgroup) alist) + (setq group-flag nil)) + ("[" + (push '(:startgrouptag) alist) + (when (equal (nth 1 tokens) ":") (setq group-flag t))) + ("]" + (push '(:endgrouptag) alist) + (setq group-flag nil)) + (":" + (push '(:grouptags) alist)) + ((guard (string-match tag-re token)) + (let ((tag (match-string 1 token)) + (key (and (match-beginning 2) + (string-to-char (match-string 2 token))))) + ;; Push all tags in groups, no matter if they already + ;; appear somewhere else in the list. + (when (or group-flag (not (assoc tag alist))) + (push (cons tag key) alist)))))))))) + +(defun org-tag-alist-to-string (alist &optional skip-key) + "Return tag string associated to ALIST. + +ALIST is an alist, as defined in `org-tag-alist' or +`org-tag-persistent-alist', or produced with +`org-tag-string-to-alist'. + +Return value is a string suitable as a value for \"TAGS\" +keyword. + +When optional argument SKIP-KEY is non-nil, skip selection keys +next to tags." + (mapconcat (lambda (token) + (pcase token + (`(:startgroup) "{") + (`(:endgroup) "}") + (`(:startgrouptag) "[") + (`(:endgrouptag) "]") + (`(:grouptags) ":") + (`(:newline) "\\n") + ((and + (guard (not skip-key)) + `(,(and tag (pred stringp)) . ,(and key (pred characterp)))) + (format "%s(%c)" tag key)) + (`(,(and tag (pred stringp)) . ,_) tag) + (_ (user-error "Invalid tag token: %S" token)))) + alist + " ")) + +(defun org-tag-alist-to-groups (alist) + "Return group alist from tag ALIST. +ALIST is an alist, as defined in `org-tag-alist' or +`org-tag-persistent-alist', or produced with +`org-tag-string-to-alist'. Return value is an alist following +the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as +a string, summarizing TAGS, as a list of strings." + (let (groups group-status current-group) + (dolist (token alist (nreverse groups)) + (pcase token + (`(,(or :startgroup :startgrouptag)) (setq group-status t)) + (`(,(or :endgroup :endgrouptag)) + (when (eq group-status 'append) + (push (nreverse current-group) groups)) + (setq group-status nil)) + (`(:grouptags) (setq group-status 'append)) + ((and `(,tag . ,_) (guard group-status)) + (if (eq group-status 'append) (push tag current-group) + (setq current-group (list tag)))) + (_ nil))))) (defun org-file-contents (file &optional noerror) "Return the contents of FILE, as a string." - (if (or (not file) (not (file-readable-p file))) - (if (not noerror) - (error "Cannot read file \"%s\"" file) - (message "Cannot read file \"%s\"" file) - "") - (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) + (if (and file (file-readable-p file)) + (with-temp-buffer + (insert-file-contents file) + (buffer-string)) + (funcall (if noerror 'message 'error) + "Cannot read file \"%s\"%s" + file + (let ((from (buffer-file-name (buffer-base-buffer)))) + (if from (concat " (referenced in file \"" from "\")") ""))))) (defun org-extract-log-state-settings (x) "Extract the log state setting from a TODO keyword string. This will extract info from a string like \"WAIT(w@/!)\"." - (let (kw key log1 log2) - (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log1 (and (match-end 3) (match-string 3 x)) - log2 (and (match-end 4) (match-string 4 x))) + (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) + (let ((kw (match-string 1 x)) + (log1 (and (match-end 3) (match-string 3 x))) + (log2 (and (match-end 4) (match-string 4 x)))) (and (or log1 log2) (list kw (and log1 (if (equal log1 "!") 'time 'note)) @@ -5216,8 +5469,8 @@ This will extract info from a string like \"WAIT(w@/!)\"." (defun org-assign-fast-keys (alist) "Assign fast keys to a keyword-key alist. Respect keys that are already there." - (let (new (alt ?0)) - (dolist (e alist) + (let (new e (alt ?0)) + (while (setq e (pop alist)) (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) (cdr e)) ;; Key already assigned. (push e new) @@ -5229,7 +5482,7 @@ Respect keys that are already there." (pop clist)) (unless clist (while (rassoc alt used) - (incf alt))) + (cl-incf alt))) (push (cons (car e) (or (car clist) alt)) new)))) (nreverse new))) @@ -5242,13 +5495,7 @@ Respect keys that are already there." (defvar org-finish-function nil "Function to be called when `C-c C-c' is used. This is for getting out of special buffers like capture.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el (defvar org-last-state) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el ;; Defined somewhere in this file, but used before definition. (defvar org-entities) ;; defined in org-entities.el @@ -5256,7 +5503,7 @@ This is for getting out of special buffers like capture.") (defvar org-org-menu) (defvar org-tbl-menu) -;;;; Define the Org-mode +;;;; Define the Org mode ;; We use a before-change function to check if a table might need ;; an update. @@ -5264,7 +5511,7 @@ This is for getting out of special buffers like capture.") "Indicates that a table might need an update. This variable is set by `org-before-change-function'. `org-table-align' sets it back to nil.") -(defun org-before-change-function (beg end) +(defun org-before-change-function (_beg _end) "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) (defvar org-mode-map) @@ -5278,13 +5525,12 @@ This variable is set by `org-before-change-function'. (defvar buffer-face-mode-face) (require 'outline) -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) -(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it ;; Other stuff we need. (require 'time-date) +(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) (require 'easymenu) +(autoload 'easy-menu-add "easymenu") (require 'overlay) ;; (require 'org-macs) moved higher up in the file before it is first used @@ -5305,15 +5551,15 @@ This variable is set by `org-before-change-function'. "Outline-based notes management and organizer, alias \"Carsten's outline-mode for keeping track of everything.\" -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content +Org mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org mode is +implemented on top of Outline mode, which is ideal to keep the content of large files well structured. It supports ToDo items, deadlines and time stamps, which magically appear in the diary listing of the Emacs calendar. Tables are easily created with a built-in table editor. Plain text URL-like links connect to websites, emails (VM), Usenet messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) +For printing and sharing of notes, an Org file (or a part of it) can be exported as a structured ASCII or HTML file. The following commands are available: @@ -5323,29 +5569,18 @@ The following commands are available: ;; Get rid of Outline menus, they are not needed ;; Need to do this here because define-derived-mode sets up ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it uses easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) + ;; we switch another buffer into Org mode. + (define-key org-mode-map [menu-bar headings] 'undefined) + (define-key org-mode-map [menu-bar hide] 'undefined) + (define-key org-mode-map [menu-bar show] 'undefined) (org-load-modules-maybe) - (when (featurep 'xemacs) - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu)) (org-install-agenda-files-menu) - (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (when org-descriptive-links (add-to-invisibility-spec '(org-link))) (add-to-invisibility-spec '(org-cwidth)) (add-to-invisibility-spec '(org-hide-block . t)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) + (setq-local outline-regexp org-outline-regexp) + (setq-local outline-level 'org-outline-level) (setq bidi-paragraph-direction 'left-to-right) (when (and org-ellipsis (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) @@ -5354,55 +5589,50 @@ The following commands are available: (setq org-display-table (make-display-table))) (set-display-table-slot org-display-table 4 - (vconcat (mapcar - (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) + (vconcat (mapcar (lambda (c) (make-glyph-code c 'org-ellipsis)) + (if (stringp org-ellipsis) org-ellipsis "...")))) (setq buffer-display-table org-display-table)) - (org-set-regexps-and-options-for-tags) (org-set-regexps-and-options) (org-set-font-lock-defaults) (when (and org-tag-faces (not org-tags-special-faces-re)) ;; tag faces set outside customize.... force initialization. (org-set-tag-faces 'org-tag-faces org-tag-faces)) ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") + (setq-local calc-embedded-open-mode "# ") ;; Modify a few syntax entries (modify-syntax-entry ?@ "w") (modify-syntax-entry ?\" "\"") (modify-syntax-entry ?\\ "_") (modify-syntax-entry ?~ "_") - (if org-startup-truncated (setq truncate-lines t)) - (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) + (setq-local font-lock-unfontify-region-function 'org-unfontify-region) ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) + (setq-local org-table-may-need-update t) + (add-hook 'before-change-functions 'org-before-change-function nil 'local) ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) + (add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) ;; Initialize macros templates. (org-macro-initialize-templates) ;; Initialize radio targets. (org-update-radio-target-regexp) ;; Indentation. - (org-set-local 'indent-line-function 'org-indent-line) - (org-set-local 'indent-region-function 'org-indent-region) + (setq-local indent-line-function 'org-indent-line) + (setq-local indent-region-function 'org-indent-region) ;; Filling and auto-filling. (org-setup-filling) ;; Comments. (org-setup-comments-handling) + ;; Initialize cache. + (org-element-cache-reset) ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-backward-element) - (org-set-local 'end-of-defun-function - (lambda () - (if (not (org-at-heading-p)) - (org-forward-element) - (org-forward-element) - (forward-char -1)))) + (setq-local beginning-of-defun-function 'org-backward-element) + (setq-local end-of-defun-function + (lambda () + (if (not (org-at-heading-p)) + (org-forward-element) + (org-forward-element) + (forward-char -1)))) ;; Next error for sparse trees - (org-set-local 'next-error-function 'org-occur-next-match) + (setq-local next-error-function 'org-occur-next-match) ;; Make sure dependence stuff works reliably, even for users who set it ;; too late :-( (if org-enforce-todo-dependencies @@ -5417,78 +5647,65 @@ The following commands are available: 'org-block-todo-from-checkboxes)) ;; Align options lines - (org-set-local - 'align-mode-rules-list + (setq-local + align-mode-rules-list '((org-in-buffer-settings - (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") + (regexp . "^[ \t]*#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") (modes . '(org-mode))))) ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) + (setq-local imenu-create-index-function 'org-imenu-get-tree) ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch)))) + (setq-local outline-isearch-open-invisible-function + (lambda (&rest _) (org-show-context 'isearch))) ;; Setup the pcomplete hooks - (set (make-local-variable 'pcomplete-command-completion-function) - 'org-pcomplete-initial) - (set (make-local-variable 'pcomplete-command-name-function) - 'org-command-at-point) - (set (make-local-variable 'pcomplete-default-completion-function) - 'ignore) - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'org-parse-arguments) - (set (make-local-variable 'pcomplete-termination-string) "") - (when (>= emacs-major-version 23) - (set (make-local-variable 'buffer-face-mode-face) 'org-default)) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (org-called-interactively-p 'any) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) + (setq-local pcomplete-command-completion-function 'org-pcomplete-initial) + (setq-local pcomplete-command-name-function 'org-command-at-point) + (setq-local pcomplete-default-completion-function 'ignore) + (setq-local pcomplete-parse-arguments-function 'org-parse-arguments) + (setq-local pcomplete-termination-string "") + (setq-local buffer-face-mode-face 'org-default) + + ;; If empty file that did not turn on Org mode automatically, make + ;; it to. + (when (and org-insert-mode-line-in-empty-file + (called-interactively-p 'any) + (= (point-min) (point-max))) + (insert "# -*- mode: org -*-\n\n")) (unless org-inhibit-startup (org-unmodified - (and org-startup-with-beamer-mode (org-beamer-mode)) + (when org-startup-with-beamer-mode (org-beamer-mode)) (when org-startup-align-all-tables - (org-table-map-tables 'org-table-align 'quietly)) - (when org-startup-with-inline-images - (org-display-inline-images)) - (when org-startup-with-latex-preview - (org-preview-latex-fragment)) - (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility)))) - ;; Try to set org-hide correctly + (org-table-map-tables #'org-table-align t)) + (when org-startup-with-inline-images (org-display-inline-images)) + (when org-startup-with-latex-preview (org-toggle-latex-fragment '(16))) + (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) + (when org-startup-truncated (setq truncate-lines t)) + (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) + (org-refresh-effort-properties))) + ;; Try to set `org-hide' face correctly. (let ((foreground (org-find-invisible-foreground))) - (if foreground - (set-face-foreground 'org-hide foreground)))) + (when foreground + (set-face-foreground 'org-hide foreground)))) ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") ("7.8.11" . "24.1") ("7.9.4" . "24.3") - ("8.2.6" . "24.4"))) + ("8.2.6" . "24.4") ("8.2.10" . "24.5") + ("9.0" . "26.1"))) (defvar org-mode-transpose-word-syntax-table - (let ((st (make-syntax-table))) - (mapc (lambda(c) (modify-syntax-entry - (string-to-char (car c)) "w p" st)) - org-emphasis-alist) - st)) + (let ((st (make-syntax-table text-mode-syntax-table))) + (dolist (c org-emphasis-alist st) + (modify-syntax-entry (string-to-char (car c)) "w p" st)))) (when (fboundp 'abbrev-table-put) (abbrev-table-put org-mode-abbrev-table :parents (list text-mode-abbrev-table))) -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - (defun org-find-invisible-foreground () (let ((candidates (remove "unspecified-bg" @@ -5498,7 +5715,7 @@ The following commands are available: (mapcar (lambda (alist) (when (boundp alist) - (cdr (assoc 'background-color (symbol-value alist))))) + (cdr (assq 'background-color (symbol-value alist))))) '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) (list (face-foreground 'org-hide)))))) (car (remove nil candidates)))) @@ -5541,8 +5758,6 @@ the rounding returns a past time." (require 'font-lock) (defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi" "message")) (defvar org-link-types-re nil "Matches a link that has a url-like prefix like \"http:\"") (defvar org-link-re-with-space nil @@ -5591,27 +5806,26 @@ stacked delimiters is N. Escaping delimiters is not possible." next (concat "\\(?:" nothing left next right "\\)+" nothing))) (concat left "\\(" re "\\)" right))) -(defvar org-match-substring-regexp +(defconst org-match-substring-regexp (concat "\\(\\S-\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\(?:" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" + "\\(?:" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") + "\\(?:\\*\\|[+-]?[[:alnum:].,\\]*[[:alnum:]]\\)\\)") "The regular expression matching a sub- or superscript.") -(defvar org-match-substring-with-braces-regexp +(defconst org-match-substring-with-braces-regexp (concat - "\\(\\S-\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") + "\\(\\S-\\)\\([_^]\\)" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)") "The regular expression matching a sub- or superscript, forcing braces.") (defun org-make-link-regexps () "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (let ((types-re (regexp-opt org-link-types t))) +This should be called after the variable `org-link-parameters' has changed." + (let ((types-re (regexp-opt (org-link-types) t))) (setq org-link-types-re (concat "\\`" types-re ":") org-link-re-with-space @@ -5629,14 +5843,12 @@ This should be called after the variable `org-link-types' has changed." "\\([^" org-non-link-chars " ]" "[^\t\n\r]*\\)") org-angle-link-re - (concat "<" types-re ":" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "\\)>") + (format "<%s:\\([^>\n]*\\(?:\n[ \t]*[^> \t\n][^>\n]*\\)*\\)>" + types-re) org-plain-link-re (concat "\\<" types-re ":" - (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" @@ -5651,77 +5863,46 @@ This should be called after the variable `org-link-types' has changed." org-bracket-link-analytic-regexp++ (concat "\\[\\[" - "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?" + "\\(" (regexp-opt (cons "coderef" (org-link-types)) t) ":\\)?" "\\([^]]+\\)" "\\]" "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)")))) - -(org-make-link-regexps) - -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 - "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date, so it can be used -on a string that terminates immediately after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis.") -(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") - "Regular expression matching time stamps, with groups.") -(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") - "Regular expression matching time stamps (also [..]), with groups.") -(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) - "Regular expression matching a time stamp range.") -(defconst org-tr-regexp-both - (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) - "Regular expression matching a time stamp range.") -(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" - org-ts-regexp "\\)?") - "Regular expression matching a time stamp or time stamp range.") -(defconst org-tsr-regexp-both - (concat org-ts-regexp-both "\\(--?-?" - org-ts-regexp-both "\\)?") - "Regular expression matching a time stamp or time stamp range. -The time stamps may be either active or inactive.") + "\\]") + org-any-link-re + (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" + org-angle-link-re "\\)\\|\\(" + org-plain-link-re "\\)")))) + +(org-make-link-regexps) (defvar org-emph-face nil) (defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to emphasized strings." + "Run through the buffer and emphasize strings." (let (rtn a) (while (and (not rtn) (re-search-forward org-emph-re limit t)) (let* ((border (char-after (match-beginning 3))) (bre (regexp-quote (char-to-string border)))) - (if (and (not (= border (char-after (match-beginning 4)))) - (not (save-match-data - (string-match (concat bre ".*" bre) - (replace-regexp-in-string - "\n" " " - (substring (match-string 2) 1 -1)))))) - (progn - (setq rtn t) - (setq a (assoc (match-string 3) org-emphasis-alist)) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 a)) - (and (nth 2 a) - (org-remove-flyspell-overlays-in - (match-beginning 0) (match-end 0))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t org-emphasis t)) - (when org-hide-emphasis-markers - (add-text-properties (match-end 4) (match-beginning 5) - '(invisible org-link)) - (add-text-properties (match-beginning 3) (match-end 3) - '(invisible org-link)))))) + (when (and (not (= border (char-after (match-beginning 4)))) + (not (string-match-p (concat bre ".*" bre) + (replace-regexp-in-string + "\n" " " + (substring (match-string 2) 1 -1))))) + (setq rtn t) + (setq a (assoc (match-string 3) org-emphasis-alist)) + (font-lock-prepend-text-property (match-beginning 2) (match-end 2) + 'face + (nth 1 a)) + (and (nth 2 a) + (org-remove-flyspell-overlays-in + (match-beginning 0) (match-end 0))) + (add-text-properties (match-beginning 2) (match-end 2) + '(font-lock-multiline t org-emphasis t)) + (when org-hide-emphasis-markers + (add-text-properties (match-end 4) (match-beginning 5) + '(invisible org-link)) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible org-link))))) (goto-char (1+ (match-beginning 0)))) rtn)) @@ -5736,19 +5917,20 @@ If CHAR is not given (for example in an interactive call) it will be prompted for." (interactive) (let ((erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move c s) + (string "") beg end move s) (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) + (setq beg (region-beginning) + end (region-end) string (buffer-substring beg end)) (setq move t)) (unless char (message "Emphasis marker or tag: [%s]" - (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) + (mapconcat #'car org-emphasis-alist "")) (setq char (read-char-exclusive))) - (if (equal char ?\ ) - (setq s "" move nil) + (if (equal char ?\s) + (setq s "" + move nil) (unless (assoc (char-to-string char) org-emphasis-alist) (user-error "No such emphasis marker: \"%c\"" char)) (setq s (char-to-string char))) @@ -5757,7 +5939,7 @@ prompted for." (assoc (substring string 0 1) org-emphasis-alist)) (setq string (substring string 1 -1))) (setq string (concat s string s)) - (if beg (delete-region beg end)) + (when beg (delete-region beg end)) (unless (or (bolp) (string-match (concat "[" (nth 0 erc) "\n]") (char-to-string (char-before (point))))) @@ -5775,37 +5957,86 @@ prompted for." (defsubst org-rear-nonsticky-at (pos) (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) -(defun org-activate-plain-links (limit) - "Run through the buffer and add overlays to links." - (let (f hl) - (when (and (re-search-forward (concat org-plain-link-re) limit t) - (not (org-in-src-block-p))) - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (setq f (get-text-property (match-beginning 0) 'face)) - (setq hl (org-match-string-no-properties 0)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'face 'org-link - 'htmlize-link `(:uri ,hl) - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0))) - t))) +(defun org-activate-links (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (catch :exit + (while (re-search-forward org-any-link-re limit t) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (style (cond ((eq ?< (char-after start)) 'angle) + ((eq ?\[ (char-after (1+ start))) 'bracket) + (t 'plain)))) + (when (and (memq style org-highlight-links) + ;; Do not confuse plain links with tags. + (not (and (eq style 'plain) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) + (let* ((link-object (save-excursion + (goto-char start) + (save-match-data (org-element-link-parser)))) + (link (org-element-property :raw-link link-object)) + (type (org-element-property :type link-object)) + (path (org-element-property :path link-object)) + (properties ;for link's visible part + (list + 'face (pcase (org-link-get-parameter type :face) + ((and (pred functionp) face) (funcall face path)) + ((and (pred facep) face) face) + ((and (pred consp) face) face) ;anonymous + (_ 'org-link)) + 'mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight) + 'keymap (or (org-link-get-parameter type :keymap) + org-mouse-map) + 'help-echo (pcase (org-link-get-parameter type :help-echo) + ((and (pred stringp) echo) echo) + ((and (pred functionp) echo) echo) + (_ (concat "LINK: " link))) + 'htmlize-link (pcase (org-link-get-parameter type + :htmlize-link) + ((and (pred functionp) f) (funcall f)) + (_ `(:uri ,link))) + 'font-lock-multiline t))) + (org-remove-flyspell-overlays-in start end) + (org-rear-nonsticky-at end) + (if (not (eq 'bracket style)) + (add-text-properties start end properties) + ;; Handle invisible parts in bracket links. + (remove-text-properties start end '(invisible nil)) + (let ((hidden + (append `(invisible + ,(or (org-link-get-parameter type :display) + 'org-link)) + properties)) + (visible-start (or (match-beginning 4) (match-beginning 2))) + (visible-end (or (match-end 4) (match-end 2)))) + (add-text-properties start visible-start hidden) + (add-text-properties visible-start visible-end properties) + (add-text-properties visible-end end hidden) + (org-rear-nonsticky-at visible-start) + (org-rear-nonsticky-at visible-end))) + (let ((f (org-link-get-parameter type :activate-func))) + (when (functionp f) + (funcall f start end path (eq style 'bracket)))) + (throw :exit t))))) ;signal success + nil)) (defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) + (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + t)) -(defcustom org-src-fontify-natively nil - "When non-nil, fontify code in code blocks." +(defcustom org-src-fontify-natively t + "When non-nil, fontify code in code blocks. +See also the `org-block' face." :type 'boolean - :version "24.1" + :version "24.4" + :package-version '(Org . "8.3") :group 'org-appearance :group 'org-babel) @@ -5820,221 +6051,248 @@ by a #." (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) - (error (message "org-mode fontification error")))) + (error (message "org-mode fontification error in %S at %d" + (current-buffer) + (line-number-at-pos))))) (defun org-fontify-meta-lines-and-blocks-1 (limit) "Fontify #+ lines and blocks." (let ((case-fold-search t)) - (if (re-search-forward - "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" - limit t) - (let ((beg (match-beginning 0)) - (block-start (match-end 0)) - (block-end nil) - (lang (match-string 7)) - (beg1 (line-beginning-position 2)) - (dc1 (downcase (match-string 2))) - (dc3 (downcase (match-string 3))) - end end1 quoting block-type ovl) - (cond - ((member dc1 '("+html:" "+ascii:" "+latex:")) - ;; a single line of backend-specific content - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - (add-text-properties (match-beginning 1) (match-end 3) - '(font-lock-fontified t face org-meta-line)) - (add-text-properties (match-beginning 6) (+ (match-end 6) 1) - '(font-lock-fontified t face org-block)) - ; for backend-specific code - t) - ((and (match-end 4) (equal dc3 "+begin")) - ;; Truly a block - (setq block-type (downcase (match-string 5)) - quoting (member block-type org-protecting-blocks)) - (when (re-search-forward - (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") - nil t) ;; on purpose, we look further than LIMIT - (setq end (min (point-max) (match-end 0)) - end1 (min (point-max) (1- (match-beginning 0)))) - (setq block-end (match-beginning 0)) - (when quoting - (remove-text-properties beg end - '(display t invisible t intangible t))) - (add-text-properties - beg end - '(font-lock-fontified t font-lock-multiline t)) - (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 (min (point-max) (1+ end)) - '(face org-meta-line)) ; for end_src - (cond - ((and lang (not (string= lang "")) org-src-fontify-natively) - (org-src-font-lock-fontify-block lang block-start block-end) - ;; remove old background overlays - (mapc (lambda (ov) - (if (eq (overlay-get ov 'face) 'org-block-background) - (delete-overlay ov))) - (overlays-at (/ (+ beg1 block-end) 2))) - ;; add a background overlay - (setq ovl (make-overlay beg1 block-end)) - (overlay-put ovl 'face 'org-block-background) - (overlay-put ovl 'evaporate t)) ;; make it go away when empty - (quoting - (add-text-properties beg1 (min (point-max) (1+ end1)) - '(face org-block))) ; end of source block - ((not org-fontify-quote-and-verse-blocks)) - ((string= block-type "quote") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) - ((string= block-type "verse") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) - (add-text-properties beg beg1 '(face org-block-begin-line)) - (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) - '(face org-block-end-line)) - t)) - ((member dc1 '("+title:" "+author:" "+email:" "+date:")) - (add-text-properties - beg (match-end 3) - (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) - '(font-lock-fontified t invisible t) - '(font-lock-fontified t face org-document-info-keyword))) - (add-text-properties - (match-beginning 6) (min (point-max) (1+ (match-end 6))) - (if (string-equal dc1 "+title:") - '(font-lock-fontified t face org-document-title) - '(font-lock-fontified t face org-document-info)))) - ((or (equal dc1 "+results") - (member dc1 '("+begin:" "+end:" "+caption:" "+label:" - "+orgtbl:" "+tblfm:" "+tblname:" "+results:" - "+call:" "+header:" "+headers:" "+name:")) - (and (match-end 4) (equal dc3 "+attr"))) - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - ((member dc3 '(" " "")) - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face font-lock-comment-face))) - ((not (member (char-after beg) '(?\ ?\t))) - ;; just any other in-buffer setting, but not indented + (when (re-search-forward + "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + limit t) + (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) + (beg1 (line-beginning-position 2)) + (dc1 (downcase (match-string 2))) + (dc3 (downcase (match-string 3))) + end end1 quoting block-type) + (cond + ((and (match-end 4) (equal dc3 "+begin")) + ;; Truly a block + (setq block-type (downcase (match-string 5)) + quoting (member block-type org-protecting-blocks)) + (when (re-search-forward + (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") + nil t) ;; on purpose, we look further than LIMIT + (setq end (min (point-max) (match-end 0)) + end1 (min (point-max) (1- (match-beginning 0)))) + (setq block-end (match-beginning 0)) + (when quoting + (org-remove-flyspell-overlays-in beg1 end1) + (remove-text-properties beg end + '(display t invisible t intangible t))) (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - (t nil)))))) - -(defun org-activate-angle-links (limit) - "Run through the buffer and add overlays to links." - (if (and (re-search-forward org-angle-link-re limit t) - (not (org-in-src-block-p))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0)) - t))) + beg end '(font-lock-fontified t font-lock-multiline t)) + (add-text-properties beg beg1 '(face org-meta-line)) + (org-remove-flyspell-overlays-in beg beg1) + (add-text-properties ; For end_src + end1 (min (point-max) (1+ end)) '(face org-meta-line)) + (org-remove-flyspell-overlays-in end1 end) + (cond + ((and lang (not (string= lang "")) org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end) + (add-text-properties beg1 block-end '(src-block t))) + (quoting + (add-text-properties beg1 (min (point-max) (1+ end1)) + (list 'face + (list :inherit + (let ((face-name + (intern (format "org-block-%s" lang)))) + (append (and (facep face-name) (list face-name)) + '(org-block))))))) ; end of source block + ((not org-fontify-quote-and-verse-blocks)) + ((string= block-type "quote") + (add-face-text-property + beg1 (min (point-max) (1+ end1)) 'org-quote t)) + ((string= block-type "verse") + (add-face-text-property + beg1 (min (point-max) (1+ end1)) 'org-verse t))) + (add-text-properties beg beg1 '(face org-block-begin-line)) + (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) + '(face org-block-end-line)) + t)) + ((member dc1 '("+title:" "+author:" "+email:" "+date:")) + (org-remove-flyspell-overlays-in + (match-beginning 0) + (if (equal "+title:" dc1) (match-end 2) (match-end 0))) + (add-text-properties + beg (match-end 3) + (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) + '(font-lock-fontified t invisible t) + '(font-lock-fontified t face org-document-info-keyword))) + (add-text-properties + (match-beginning 6) (min (point-max) (1+ (match-end 6))) + (if (string-equal dc1 "+title:") + '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-info)))) + ((string-prefix-p "+caption" dc1) + (org-remove-flyspell-overlays-in (match-end 2) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + ;; Handle short captions. + (save-excursion + (beginning-of-line) + (looking-at "\\([ \t]*#\\+caption\\(?:\\[.*\\]\\)?:\\)[ \t]*")) + (add-text-properties (line-beginning-position) (match-end 1) + '(font-lock-fontified t face org-meta-line)) + (add-text-properties (match-end 0) (line-end-position) + '(font-lock-fontified t face org-block)) + t) + ((member dc3 '(" " "")) + (org-remove-flyspell-overlays-in beg (match-end 0)) + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face font-lock-comment-face))) + (t ;; just any other in-buffer setting, but not indented + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + (add-text-properties beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t)))))) + +(defun org-fontify-drawers (limit) + "Fontify drawers." + (when (re-search-forward org-drawer-regexp limit t) + (add-text-properties + (match-beginning 0) (match-end 0) + '(font-lock-fontified t face org-special-keyword)) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + t)) + +(defun org-fontify-macros (limit) + "Fontify macros." + (when (re-search-forward "\\({{{\\).+?\\(}}}\\)" limit t) + (add-text-properties + (match-beginning 0) (match-end 0) + '(font-lock-fontified t face org-macro)) + (when org-hide-macro-markers + (add-text-properties (match-end 2) (match-beginning 2) + '(invisible t)) + (add-text-properties (match-beginning 1) (match-end 1) + '(invisible t))) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + t)) (defun org-activate-footnote-links (limit) - "Run through the buffer and add overlays to footnotes." + "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) (when fn - (let ((beg (nth 1 fn)) (end (nth 2 fn))) - (org-remove-flyspell-overlays-in beg end) + (let* ((beg (nth 1 fn)) + (end (nth 2 fn)) + (label (car fn)) + (referencep (/= (line-beginning-position) beg))) + (when (and referencep (nth 3 fn)) + (save-excursion + (goto-char beg) + (search-forward (or label "fn:")) + (org-remove-flyspell-overlays-in beg (match-end 0)))) (add-text-properties beg end (list 'mouse-face 'highlight 'keymap org-mouse-map 'help-echo - (if (= (point-at-bol) beg) - "Footnote definition" - "Footnote reference") + (if referencep "Footnote reference" + "Footnote definition") 'font-lock-fontified t 'font-lock-multiline t 'face 'org-footnote)))))) -(defun org-activate-bracket-links (limit) - "Run through the buffer and add overlays to bracketed links." - (if (and (re-search-forward org-bracket-link-regexp limit t) - (not (org-in-src-block-p))) - (let* ((hl (org-match-string-no-properties 1)) - (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) - (ip (org-maybe-intangible - (list 'invisible 'org-link - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - (vp (list 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (org-rear-nonsticky-at (match-beginning 3)) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (org-rear-nonsticky-at (match-end 3)) - (add-text-properties (match-end 3) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (org-rear-nonsticky-at (match-beginning 1)) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (org-rear-nonsticky-at (match-end 1)) - (add-text-properties (match-end 1) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - t))) - (defun org-activate-dates (limit) - "Run through the buffer and add overlays to dates." - (if (and (re-search-forward org-tsr-regexp-both limit t) - (not (equal (char-before (match-beginning 0)) 91))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0)) - (when org-display-custom-times - (if (match-end 3) - (org-display-custom-time (match-beginning 3) (match-end 3))) - (org-display-custom-time (match-beginning 1) (match-end 1))) - t))) - -(defvar org-target-link-regexp nil + "Add text properties for dates." + (when (and (re-search-forward org-tsr-regexp-both limit t) + (not (equal (char-before (match-beginning 0)) 91))) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) + (when org-display-custom-times + (if (match-end 3) + (org-display-custom-time (match-beginning 3) (match-end 3)) + (org-display-custom-time (match-beginning 1) (match-end 1)))) + t)) + +(defvar-local org-target-link-regexp nil "Regular expression matching radio targets in plain text.") -(make-variable-buffer-local 'org-target-link-regexp) -(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" + +(defconst org-target-regexp (let ((border "[^<>\n\r \t]")) + (format "<<\\(%s\\|%s[^<>\n\r]*%s\\)>>" + border border border)) "Regular expression matching a link target.") -(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" + +(defconst org-radio-target-regexp (format "<%s>" org-target-regexp) "Regular expression matching a radio target.") -(defvar org-any-target-regexp "<<\n\r]+\\)>>>?" ; FIXME, not exact, would match <<> as a radio target. + +(defconst org-any-target-regexp + (format "%s\\|%s" org-radio-target-regexp org-target-regexp) "Regular expression matching any target.") (defun org-activate-target-links (limit) - "Run through the buffer and add overlays to target matches." + "Add text properties for target matches." (when org-target-link-regexp (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - (org-rear-nonsticky-at (match-end 0)) - t))))) + (when (re-search-forward org-target-link-regexp limit t) + (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'mouse-face 'highlight + 'keymap org-mouse-map + 'help-echo "Radio target link" + 'org-linked-text t)) + (org-rear-nonsticky-at (match-end 1)) + t)))) (defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression." + "Find all radio targets in this file and update the regular expression. +Also refresh fontification if needed." (interactive) - (when (memq 'radio org-activate-links) + (let ((old-regexp org-target-link-regexp) + (before-re "\\(?:^\\|[^[:alnum:]]\\)\\(") + (after-re "\\)\\(?:$\\|[^[:alnum:]]\\)") + (targets + (org-with-wide-buffer + (goto-char (point-min)) + (let (rtn) + (while (re-search-forward org-radio-target-regexp nil t) + ;; Make sure point is really within the object. + (backward-char) + (let ((obj (org-element-context))) + (when (eq (org-element-type obj) 'radio-target) + (cl-pushnew (org-element-property :value obj) rtn + :test #'equal)))) + rtn)))) (setq org-target-link-regexp - (org-make-target-link-regexp (org-all-targets 'radio))) - (org-restart-font-lock))) + (and targets + (concat before-re + (mapconcat + (lambda (x) + (replace-regexp-in-string + " +" "\\s-+" (regexp-quote x) t t)) + targets + "\\|") + after-re))) + (unless (equal old-regexp org-target-link-regexp) + ;; Clean-up cache. + (let ((regexp (cond ((not old-regexp) org-target-link-regexp) + ((not org-target-link-regexp) old-regexp) + (t + (concat before-re + (mapconcat + (lambda (re) + (substring re (length before-re) + (- (length after-re)))) + (list old-regexp org-target-link-regexp) + "\\|") + after-re))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (org-element-cache-refresh (match-beginning 1))))) + ;; Re fontify buffer. + (when (memq 'radio org-highlight-links) + (org-restart-font-lock))))) (defun org-hide-wide-columns (limit) (let (s e) @@ -6042,20 +6300,18 @@ by a #." 'org-cwidth t)) (when s (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) + (add-text-properties s e '(invisible org-cwidth)) (goto-char e) t))) (defvar org-latex-and-related-regexp nil "Regular expression for highlighting LaTeX, entities and sub/superscript.") -(defvar org-match-substring-regexp) -(defvar org-match-substring-with-braces-regexp) (defun org-compute-latex-and-related-regexp () "Compute regular expression for LaTeX, entities and sub/superscript. Result depends on variable `org-highlight-latex-and-related'." - (org-set-local - 'org-latex-and-related-regexp + (setq-local + org-latex-and-related-regexp (let* ((re-sub (cond ((not (memq 'script org-highlight-latex-and-related)) nil) ((eq org-use-sub-superscripts '{}) @@ -6081,9 +6337,13 @@ done, nil otherwise." (when (org-string-nw-p org-latex-and-related-regexp) (catch 'found (while (re-search-forward org-latex-and-related-regexp limit t) - (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline)) + (unless + (cl-some + (lambda (f) + (memq f '(org-code org-verbatim underline org-special-keyword))) + (save-excursion + (goto-char (1+ (match-beginning 0))) + (face-at-point nil t))) (let ((offset (if (memq (char-after (1+ (match-beginning 0))) '(?_ ?^)) 1 @@ -6102,63 +6362,32 @@ done, nil otherwise." (font-lock-mode -1) (font-lock-mode 1))) -(defun org-all-targets (&optional radio) - "Return a list of all targets in this file. -When optional argument RADIO is non-nil, only find radio -targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - ;; Make sure point is really within the object. - (backward-char) - (let ((obj (org-element-context))) - (when (memq (org-element-type obj) '(radio-target target)) - (add-to-list 'rtn (downcase (org-element-property :value obj)))))) - rtn))) - -(defun org-make-target-link-regexp (targets) - "Make regular expression matching all strings in TARGETS. -The regular expression finds the targets also if there is a line break -between words." - (and targets - (concat - "\\_<\\(" - (mapconcat - (lambda (x) - (setq x (regexp-quote x)) - (while (string-match " +" x) - (setq x (replace-match "\\s-+" t t x))) - x) - targets - "\\|") - "\\)\\_>"))) - (defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 1)) - t))) + (when (re-search-forward + "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" limit t) + (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 1)) + t)) (defun org-outline-level () "Compute the outline level of the heading at point. -If this is called at a normal headline, the level is the number of stars. -Use `org-reduced-level' to remove the effect of `org-odd-levels'." - (save-excursion - (if (not (condition-case nil - (org-back-to-heading t) - (error nil))) - 0 - (looking-at org-outline-regexp) - (1- (- (match-end 0) (match-beginning 0)))))) + +If this is called at a normal headline, the level is the number +of stars. Use `org-reduced-level' to remove the effect of +`org-odd-levels'. Unlike to `org-current-level', this function +takes into consideration inlinetasks." + (org-with-wide-buffer + (end-of-line) + (if (re-search-backward org-outline-regexp-bol nil t) + (1- (- (match-end 0) (match-beginning 0))) + 0))) (defvar org-font-lock-keywords nil) -(defsubst org-re-property (property &optional literal allow-null) +(defsubst org-re-property (property &optional literal allow-null value) "Return a regexp matching a PROPERTY line. When optional argument LITERAL is non-nil, do not quote PROPERTY. @@ -6166,17 +6395,25 @@ This is useful when PROPERTY is a regexp. When ALLOW-NULL is non-nil, match properties even without a value. Match group 3 is set to the value when it exists. If there is no -value and ALLOW-NULL is non-nil, it is set to the empty string." +value and ALLOW-NULL is non-nil, it is set to the empty string. + +With optional argument VALUE, match only property lines with +that value; in this case, ALLOW-NULL is ignored. VALUE is quoted +unless LITERAL is non-nil." (concat "^\\(?4:[ \t]*\\)" (format "\\(?1::\\(?2:%s\\):\\)" (if literal property (regexp-quote property))) - (if allow-null - "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$" - "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))) + (cond (value + (format "[ \t]+\\(?3:%s\\)\\(?5:[ \t]*\\)$" + (if literal value (regexp-quote value)))) + (allow-null + "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$") + (t + "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$")))) (defconst org-property-re - (org-re-property ".*?" 'literal t) + (org-re-property "\\S-+" 'literal t) "Regular expression matching a property line. There are four matching groups: 1: :PROPKEY: including the leading and trailing colon, @@ -6188,6 +6425,8 @@ There are four matching groups: (defvar org-font-lock-hook nil "Functions to be called for special font lock stuff.") +(defvar org-font-lock-extra-keywords nil) ;Dynamically scoped. + (defvar org-font-lock-set-keywords-hook nil "Functions that can manipulate `org-font-lock-extra-keywords'. This is called after `org-font-lock-extra-keywords' is defined, but before @@ -6201,7 +6440,7 @@ needs to be inserted at a specific position in the font-lock sequence.") (defun org-set-font-lock-defaults () "Set font lock defaults for the current buffer." (let* ((em org-fontify-emphasized-text) - (lk org-activate-links) + (lk org-highlight-links) (org-font-lock-extra-keywords (list ;; Call the hook @@ -6222,26 +6461,23 @@ needs to be inserted at a specific position in the font-lock sequence.") '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) + '(org-fontify-drawers) ;; Properties (list org-property-re '(1 'org-special-keyword t) '(3 'org-property-value t)) - ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - (if (memq 'footnote lk) '(org-activate-footnote-links)) + ;; Link related fontification. + '(org-activate-links) + (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) + (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) + (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) + (when (memq 'footnote lk) '(org-activate-footnote-links)) ;; Targets. (list org-any-target-regexp '(0 'org-target t)) ;; Diary sexps. '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) ;; Macro - '("{{{.+}}}" (0 'org-macro t)) + '(org-fontify-macros) '(org-hide-wide-columns (0 nil append)) ;; TODO keyword (list (format org-heading-keyword-regexp-format @@ -6261,27 +6497,24 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Tags '(org-font-lock-add-tag-faces) ;; Tags groups - (if (and org-group-tags org-tag-groups-alist) - (list (concat org-outline-regexp-bol ".+\\(:" - (regexp-opt (mapcar 'car org-tag-groups-alist)) - ":\\).*$") - '(1 'org-tag-group prepend))) + (when (and org-group-tags org-tag-groups-alist) + (list (concat org-outline-regexp-bol ".+\\(:" + (regexp-opt (mapcar 'car org-tag-groups-alist)) + ":\\).*$") + '(1 'org-tag-group prepend))) ;; Special keywords (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) + (when em '(org-do-emphasis-faces)) ;; Checkboxes '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" 1 'org-checkbox prepend) - (if (cdr (assq 'checkbox org-list-automatic-rules)) - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) + (when (cdr (assq 'checkbox org-list-automatic-rules)) + '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" + (0 (org-get-checkbox-statistics-face) t))) ;; Description list items '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" 1 'org-list-dt prepend) @@ -6297,83 +6530,92 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Code '(org-activate-code (1 'org-code t)) ;; COMMENT - (list (format org-heading-keyword-regexp-format - (concat "\\(" - org-comment-string "\\|" org-quote-string - "\\)")) - '(2 'org-special-keyword t)) + (list (format + "^\\*+\\(?: +%s\\)?\\(?: +\\[#[A-Z0-9]\\]\\)? +\\(?9:%s\\)\\(?: \\|$\\)" + org-todo-regexp + org-comment-string) + '(9 'org-special-keyword t)) ;; Blocks and meta lines '(org-fontify-meta-lines-and-blocks)))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) (run-hooks 'org-font-lock-set-keywords-hook) ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) + (setq-local org-font-lock-keywords org-font-lock-extra-keywords) + (setq-local font-lock-defaults + '(org-font-lock-keywords t nil nil backward-paragraph)) + (kill-local-variable 'font-lock-keywords) + nil)) (defun org-toggle-pretty-entities () "Toggle the composition display of entities as UTF8 characters." (interactive) - (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (setq-local org-pretty-entities (not org-pretty-entities)) (org-restart-font-lock) (if org-pretty-entities (message "Entities are now displayed as UTF8 characters") (save-restriction (widen) - (org-decompose-region (point-min) (point-max)) + (decompose-region (point-min) (point-max)) (message "Entities are now displayed as plain text")))) -(defvar org-custom-properties-overlays nil +(defvar-local org-custom-properties-overlays nil "List of overlays used for custom properties.") -(make-variable-buffer-local 'org-custom-properties-overlays) (defun org-toggle-custom-properties-visibility () "Display or hide properties in `org-custom-properties'." (interactive) (if org-custom-properties-overlays - (progn (mapc 'delete-overlay org-custom-properties-overlays) + (progn (mapc #'delete-overlay org-custom-properties-overlays) (setq org-custom-properties-overlays nil)) - (unless (not org-custom-properties) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-property-re nil t) - (mapc (lambda(p) - (when (equal p (substring (match-string 1) 1 -1)) - (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) - (overlay-put o 'invisible t) - (overlay-put o 'org-custom-property t) - (push o org-custom-properties-overlays)))) - org-custom-properties))))))) + (when org-custom-properties + (org-with-wide-buffer + (goto-char (point-min)) + (let ((regexp (org-re-property (regexp-opt org-custom-properties) t t))) + (while (re-search-forward regexp nil t) + (let ((end (cdr (save-match-data (org-get-property-block))))) + (when (and end (< (point) end)) + ;; Hide first custom property in current drawer. + (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) + (overlay-put o 'invisible t) + (overlay-put o 'org-custom-property t) + (push o org-custom-properties-overlays)) + ;; Hide additional custom properties in the same drawer. + (while (re-search-forward regexp end t) + (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) + (overlay-put o 'invisible t) + (overlay-put o 'org-custom-property t) + (push o org-custom-properties-overlays))))) + ;; Each entry is limited to a single property drawer. + (outline-next-heading))))))) (defun org-fontify-entities (limit) "Find an entity to fontify." (let (ee) (when org-pretty-entities (catch 'match + ;; "\_ "-family is left out on purpose. Only the first one, + ;; i.e., "\_ ", could be fontified anyway, and it would be + ;; confusing when adding a second white space character. (while (re-search-forward "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" limit t) - (if (and (not (org-in-indented-comment-line)) - (setq ee (org-entity-get (match-string 1))) - (= (length (nth 6 ee)) 1)) - (let* - ((end (if (equal (match-string 2) "{}") + (when (and (not (org-at-comment-p)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (let* ((end (if (equal (match-string 2) "{}") (match-end 2) (match-end 1)))) - (add-text-properties - (match-beginning 0) end - (list 'font-lock-fontified t)) - (compose-region (match-beginning 0) end - (nth 6 ee) nil) - (backward-char 1) - (throw 'match t)))) + (add-text-properties + (match-beginning 0) end + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) end + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) nil)))) (defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode." + "Fontify string S like in Org mode." (with-temp-buffer (insert s) (let ((org-odd-levels-only odd-levels)) @@ -6387,33 +6629,55 @@ needs to be inserted at a specific position in the font-lock sequence.") (defun org-get-level-face (n) "Get the right face for match N in font-lock matching of headlines." (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (when org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) (if org-cycle-level-faces (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) (cond ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) + (t (unless org-level-color-stars-only org-f)))) +(defun org-face-from-face-or-color (context inherit face-or-color) + "Create a face list that inherits INHERIT, but sets the foreground color. +When FACE-OR-COLOR is not a string, just return it." + (if (stringp face-or-color) + (list :inherit inherit + (cdr (assoc context org-faces-easy-properties)) + face-or-color) + face-or-color)) (defun org-get-todo-face (kwd) "Get the right face for a TODO keyword KWD. If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) + (when (numberp kwd) (setq kwd (match-string kwd))) (or (org-face-from-face-or-color 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) (and (member kwd org-done-keywords) 'org-done) 'org-todo)) -(defun org-face-from-face-or-color (context inherit face-or-color) - "Create a face list that inherits INHERIT, but sets the foreground color. -When FACE-OR-COLOR is not a string, just return it." - (if (stringp face-or-color) - (list :inherit inherit - (cdr (assoc context org-faces-easy-properties)) - face-or-color) - face-or-color)) +(defun org-get-priority-face (priority) + "Get the right face for PRIORITY. +PRIORITY is a character." + (or (org-face-from-face-or-color + 'priority 'org-priority (cdr (assq priority org-priority-faces))) + 'org-priority)) + +(defun org-get-tag-face (tag) + "Get the right face for TAG. +If TAG is a number, get the corresponding match group." + (let ((tag (if (wholenump tag) (match-string tag) tag))) + (or (org-face-from-face-or-color + 'tag 'org-tag (cdr (assoc tag org-tag-faces))) + 'org-tag))) + +(defun org-font-lock-add-priority-faces (limit) + "Add the special priority faces." + (while (re-search-forward "^\\*+ .*?\\(\\[#\\(.\\)\\]\\)" limit t) + (add-text-properties + (match-beginning 1) (match-end 1) + (list 'face (org-get-priority-face (string-to-char (match-string 2))) + 'font-lock-fontified t)))) (defun org-font-lock-add-tag-faces (limit) "Add the special tag faces." @@ -6424,39 +6688,18 @@ When FACE-OR-COLOR is not a string, just return it." 'font-lock-fontified t)) (backward-char 1)))) -(defun org-font-lock-add-priority-faces (limit) - "Add the special priority faces." - (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) - (when (save-match-data (org-at-heading-p)) - (add-text-properties - (match-beginning 0) (match-end 0) - (list 'face (or (org-face-from-face-or-color - 'priority 'org-priority - (cdr (assoc (char-after (match-beginning 1)) - org-priority-faces))) - 'org-priority) - 'font-lock-fontified t))))) - -(defun org-get-tag-face (kwd) - "Get the right face for a TODO keyword KWD. -If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (org-face-from-face-or-color - 'tag 'org-tag (cdr (assoc kwd org-tag-faces))) - 'org-tag)) - -(defun org-unfontify-region (beg end &optional maybe_loudly) +(defun org-unfontify-region (beg end &optional _maybe_loudly) "Remove fontification and activation overlays from links." (font-lock-default-unfontify-region beg end) (let* ((buffer-undo-list t) (inhibit-read-only t) (inhibit-point-motion-hooks t) (inhibit-modification-hooks t) deactivate-mark buffer-file-name buffer-file-truename) - (org-decompose-region beg end) + (decompose-region beg end) (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t invisible t intangible t - org-no-flyspell t org-emphasis t)) + org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -6473,59 +6716,56 @@ and subscripts." (while (< beg end) (setq next (next-single-property-change beg 'display nil end) prop (get-text-property beg 'display)) - (if (member prop org-script-display) - (put-text-property beg next 'display nil)) + (when (member prop org-script-display) + (put-text-property beg next 'display nil)) (setq beg next)))) (defun org-raise-scripts (limit) "Add raise properties to sub/superscripts." - (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) - (if (re-search-forward - (if (eq org-use-sub-superscripts t) - org-match-substring-regexp - org-match-substring-with-braces-regexp) - limit t) - (let* ((pos (point)) table-p comment-p - (mpos (match-beginning 3)) - (emph-p (get-text-property mpos 'org-emphasis)) - (link-p (get-text-property mpos 'mouse-face)) - (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) - (setq table-p (org-looking-at-p org-table-dataline-regexp) - comment-p (org-looking-at-p "^[ \t]*#[ +]")) - (goto-char pos) - ;; Handle a_b^c - (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) - (if (or comment-p emph-p link-p keyw-p) - t - (put-text-property (match-beginning 3) (match-end 0) - 'display - (if (equal (char-after (match-beginning 2)) ?^) - (nth (if table-p 3 1) org-script-display) - (nth (if table-p 2 0) org-script-display))) - (add-text-properties (match-beginning 2) (match-end 2) - (list 'invisible t - 'org-dwidth t 'org-dwidth-n 1)) - (if (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (progn - (add-text-properties - (match-beginning 3) (1+ (match-beginning 3)) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) - (add-text-properties - (1- (match-end 3)) (match-end 3) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) - t))))) + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts + (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t)) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (looking-at-p org-table-dataline-regexp) + comment-p (looking-at-p "^[ \t]*#[ +]")) + (goto-char pos) + ;; Handle a_b^c + (when (member (char-after) '(?_ ?^)) (goto-char (1- pos))) + (unless (or comment-p emph-p link-p keyw-p) + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1))))) + t))) ;;;; Visibility cycling, including org-goto and indirect buffer ;;; Cycling -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) +(defvar-local org-cycle-global-status nil) (put 'org-cycle-global-status 'org-state t) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) +(defvar-local org-cycle-subtree-status nil) (put 'org-cycle-subtree-status 'org-state t) (defvar org-inlinetask-min-level) @@ -6537,52 +6777,58 @@ and subscripts." ;;;###autoload (defun org-cycle (&optional arg) - "TAB-action and visibility cycling for Org-mode. + "TAB-action and visibility cycling for Org mode. -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions +This is the command invoked in Org mode by the `TAB' key. Its main +purpose is outline visibility cycling, but it also invokes other actions in special contexts. -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) +When this function is called with a `\\[universal-argument]' prefix, rotate \ +the entire +buffer through 3 states (global cycling) 1. OVERVIEW: Show only top-level headlines. 2. CONTENTS: Show all headlines of all levels, but no body text. 3. SHOW ALL: Show everything. - When called with two `C-u C-u' prefixes, switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - When called with three `C-u C-u C-u' prefixed, show the entire buffer, - including any drawers. -- When inside a table, re-align the table and move to the next field. +With a `\\[universal-argument] \\[universal-argument]' prefix argument, \ +switch to the startup visibility, +determined by the variable `org-startup-folded', and by any VISIBILITY +properties in the buffer. + +With a `\\[universal-argument] \\[universal-argument] \ +\\[universal-argument]' prefix argument, show the entire buffer, including +any drawers. -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) +When inside a table, re-align the table and move to the next field. + +When point is at the beginning of a headline, rotate the subtree started +by this line through 3 different states (local cycling) 1. FOLDED: Only the main headline is shown. 2. CHILDREN: The main headline and the direct children are shown. From this state, you can move to one of the children and zoom in further. 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. - -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (C-u TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." +If there is no subtree, switch directly from CHILDREN to FOLDED. + +When point is at the beginning of an empty headline and the variable +`org-cycle-level-after-item/entry-creation' is set, cycle the level +of the headline by demoting and promoting it to likely levels. This +speeds up creation document structure by pressing `TAB' once or several +times right after creating a new headline. + +When there is a numeric prefix, go up to a heading with level ARG, do +a `show-subtree' and return to the previous cursor position. If ARG +is negative, go up that many levels. + +When point is not at the beginning of a headline, execute the global +binding for `TAB', which is re-indenting the line. See the option +`org-cycle-emulate-tab' for details. + +As a special case, if point is at the beginning of the buffer and there is +no headline in line 1, this function will act as if called with prefix arg +\(`\\[universal-argument] TAB', same as `S-TAB') also when called without \ +prefix arg, but only +if the variable `org-cycle-global-at-bob' is t." (interactive "P") (org-load-modules-maybe) (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) @@ -6611,10 +6857,6 @@ in special contexts. org-cycle-hook)) (pos (point))) - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - (cond ((equal arg '(16)) @@ -6623,32 +6865,36 @@ in special contexts. (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) ((equal arg '(64)) - (show-all) + (outline-show-all) (org-unlogged-message "Entire buffer visible, including drawers")) + ((equal arg '(4)) (org-cycle-internal-global)) + + ;; Try hiding block at point. + ((org-hide-block-toggle-maybe)) + ;; Try cdlatex TAB completion ((org-try-cdlatex-tab)) ;; Table: enter it or move to the next field. ((org-at-table-p 'any) (if (org-at-table.el-p) - (message "%s" "Use C-c ' to edit table.el tables") + (message "%s" (substitute-command-keys "\\\ +Use `\\[org-edit-special]' to edit table.el tables")) (if arg (org-table-edit-field t) (org-table-justify-field-maybe) (call-interactively 'org-table-next-field)))) - ((run-hook-with-args-until-success - 'org-tab-after-check-for-table-hook)) + ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) ;; Global cycling: delegate to `org-cycle-internal-global'. - ((eq arg t) (org-cycle-internal-global)) + (bob-special (org-cycle-internal-global)) ;; Drawers: delegate to `org-flag-drawer'. - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - (org-flag-drawer ; toggle block visibility + ((save-excursion + (beginning-of-line 1) + (looking-at org-drawer-regexp)) + (org-flag-drawer ; toggle block visibility (not (get-char-property (match-end 0) 'invisible)))) ;; Show-subtree, ARG levels up from here. @@ -6667,7 +6913,7 @@ in special contexts. ;; At an item/headline: delegate to `org-cycle-internal-local'. ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) - (save-excursion (beginning-of-line 1) + (save-excursion (move-beginning-of-line 1) (looking-at org-outline-regexp))) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (org-cycle-internal-local)) @@ -6722,7 +6968,7 @@ in special contexts. (eq org-cycle-global-status 'contents)) ;; We just showed the table of contents - now show everything (run-hook-with-args 'org-pre-cycle-hook 'all) - (show-all) + (outline-show-all) (unless ga (org-unlogged-message "SHOW ALL")) (setq org-cycle-global-status 'all) (run-hook-with-args 'org-cycle-hook 'all)) @@ -6738,6 +6984,11 @@ in special contexts. (defvar org-called-with-limited-levels nil "Non-nil when `org-with-limited-levels' is currently active.") +(defun org-invisible-p (&optional pos) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead." + (get-char-property (or pos (point)) 'invisible)) + (defun org-cycle-internal-local () "Do the local cycling action." (let ((goal-column 0) eoh eol eos has-children children-skipped struct) @@ -6765,15 +7016,10 @@ in special contexts. (org-list-search-forward (org-item-beginning-re) eos t))))) ;; Determine end invisible part of buffer (EOL) (beginning-of-line 2) - ;; XEmacs doesn't have `next-single-char-property-change' - (if (featurep 'xemacs) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) + (while (and (not (eobp)) ;This is like `next-line'. + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2))) (setq eol (point))) ;; Find out what to do next and set `this-command' (cond @@ -6786,7 +7032,7 @@ in special contexts. (save-excursion (goto-char eos) (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil)))) + (when (org-invisible-p) (org-flag-heading nil)))) ((and (or (>= eol eos) (not (string-match "\\S-" (buffer-substring eol eos)))) (or has-children @@ -6798,7 +7044,7 @@ in special contexts. (if (org-at-item-p) (org-list-set-item-visibility (point-at-bol) struct 'children) (org-show-entry) - (org-with-limited-levels (show-children)) + (org-with-limited-levels (org-show-children)) ;; FIXME: This slows down the func way too much. ;; How keep drawers hidden in subtree anyway? ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) @@ -6813,14 +7059,14 @@ in special contexts. (let* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) (end (org-list-get-bottom-point struct))) - (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) - (org-list-get-all-items (point) struct prevs)) + (dolist (e (org-list-get-all-items (point) struct prevs)) + (org-list-set-item-visibility e struct 'folded)) (goto-char (if (< end eos) end eos))))))) (org-unlogged-message "CHILDREN") (save-excursion (goto-char eos) (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil))) + (when (org-invisible-p) (org-flag-heading nil))) (setq org-cycle-subtree-status 'children) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'children))) @@ -6849,15 +7095,15 @@ in special contexts. ;;;###autoload (defun org-global-cycle (&optional arg) "Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. +With `\\[universal-argument]' prefix ARG, switch to startup visibility. With a numeric prefix, show all headlines up to that level." (interactive "P") (let ((org-cycle-include-plain-lists (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) (cond ((integerp arg) - (show-all) - (hide-sublevels arg) + (outline-show-all) + (outline-hide-sublevels arg) (setq org-cycle-global-status 'contents)) ((equal arg '(4)) (org-set-startup-visibility) @@ -6874,9 +7120,9 @@ With a numeric prefix, show all headlines up to that level." (org-content)) ((or (eq org-startup-folded 'showeverything) (eq org-startup-folded nil)) - (show-all))) + (outline-show-all))) (unless (eq org-startup-folded 'showeverything) - (if org-hide-block-startup (org-hide-block-all)) + (when org-hide-block-startup (org-hide-block-all)) (org-set-visibility-according-to-property 'no-cleanup) (org-cycle-hide-archived-subtrees 'all) (org-cycle-hide-drawers 'all) @@ -6885,34 +7131,32 @@ With a numeric prefix, show all headlines up to that level." (defun org-set-visibility-according-to-property (&optional no-cleanup) "Switch subtree visibilities according to :VISIBILITY: property." (interactive) - (let (org-show-entry-below state) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" - nil t) - (setq state (match-string 1)) - (save-excursion - (org-back-to-heading t) - (hide-subtree) - (org-reveal) - (cond - ((equal state '("fold" "folded")) - (hide-subtree)) - ((equal state "children") - (org-show-hidden-entry) - (show-children)) - ((equal state "content") - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((member state '("all" "showall")) - (show-subtree))))) - (unless no-cleanup - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:VISIBILITY:" nil t) + (if (not (org-at-property-p)) (outline-next-heading) + (let ((state (match-string 3))) + (save-excursion + (org-back-to-heading t) + (outline-hide-subtree) + (org-reveal) + (cond + ((equal state "folded") + (outline-hide-subtree)) + ((equal state "children") + (org-show-hidden-entry) + (org-show-children)) + ((equal state "content") + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-content)))) + ((member state '("all" "showall")) + (outline-show-subtree))))))) + (unless no-cleanup + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'all)))) ;; This function uses outline-regexp instead of the more fundamental ;; org-outline-regexp so that org-cycle-global works outside of Org @@ -6928,11 +7172,10 @@ results." (let ((level (save-excursion (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) - (and level (hide-sublevels level))))) + (when (re-search-forward (concat "^" outline-regexp) nil t) + (goto-char (match-beginning 0)) + (funcall outline-level))))) + (and level (outline-hide-sublevels level))))) (defun org-content (&optional arg) "Show all headlines in the buffer, like a table of contents. @@ -6950,9 +7193,9 @@ With numerical argument N, show content up to level N." t) (looking-at org-outline-regexp)) (if (integerp arg) - (show-children (1- arg)) - (show-branches)) - (if (bobp) (throw 'exit nil)))))) + (org-show-children (1- arg)) + (outline-show-branches)) + (when (bobp) (throw 'exit nil)))))) (defun org-optimize-window-after-visibility-change (state) "Adjust the window after a change in outline visibility. @@ -6967,13 +7210,11 @@ This function is the default value of the hook `org-cycle-hook'." (defun org-remove-empty-overlays-at (pos) "Remove outline overlays that do not contain non-white stuff." - (mapc - (lambda (o) - (and (eq 'outline (overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (overlay-start o) - (overlay-end o)))) - (delete-overlay o))) - (overlays-at pos))) + (dolist (o (overlays-at pos)) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o)))) (defun org-clean-visibility-after-subtree-move () "Fix visibility issues after moving a subtree." @@ -6991,7 +7232,7 @@ This function is the default value of the hook `org-cycle-hook'." (point-at-eol) (point)))) (level (looking-at "\\*+")) - (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) + (re (when level (concat "^" (regexp-quote (match-string 0)) " ")))) (save-excursion (save-restriction (narrow-to-region beg end) @@ -6999,10 +7240,10 @@ This function is the default value of the hook `org-cycle-hook'." ;; Properly fold already folded siblings (goto-char (point-min)) (while (re-search-forward re nil t) - (if (and (not (outline-invisible-p)) - (save-excursion - (goto-char (point-at-eol)) (outline-invisible-p))) - (hide-entry)))) + (when (and (not (org-invisible-p)) + (save-excursion + (goto-char (point-at-eol)) (org-invisible-p))) + (outline-hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -7012,7 +7253,7 @@ The region to be covered depends on STATE when called through `org-cycle-hook'. Lisp program can use t for STATE to get the entire buffer covered. Note that an empty line is only shown if there are at least `org-cycle-separator-lines' empty lines before the headline." - (when (not (= org-cycle-separator-lines 0)) + (when (/= org-cycle-separator-lines 0) (save-excursion (let* ((n (abs org-cycle-separator-lines)) (re (cond @@ -7021,38 +7262,34 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (t (let ((ns (number-to-string (- n 2)))) (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end b e) + beg end) (cond ((memq state '(overview contents t)) (setq beg (point-min) end (point-max))) ((memq state '(children folded)) - (setq beg (point) end (progn (org-end-of-subtree t t) - (beginning-of-line 2) - (point))))) + (setq beg (point) + end (progn (org-end-of-subtree t t) + (line-beginning-position 2))))) (when beg (goto-char beg) (while (re-search-forward re end t) (unless (get-char-property (match-end 1) 'invisible) - (setq e (match-end 1)) - (if (< org-cycle-separator-lines 0) - (setq b (save-excursion - (goto-char (match-beginning 0)) - (org-back-over-empty-lines) - (if (save-excursion - (goto-char (max (point-min) (1- (point)))) - (org-at-heading-p)) - (1- (point)) - (point)))) - (setq b (match-beginning 1))) - (outline-flag-region b e nil))))))) + (let ((e (match-end 1)) + (b (if (>= org-cycle-separator-lines 0) + (match-beginning 1) + (save-excursion + (goto-char (match-beginning 0)) + (skip-chars-backward " \t\n") + (line-end-position))))) + (outline-flag-region b e nil)))))))) ;; Never hide empty lines at the end of the file. (save-excursion (goto-char (point-max)) (outline-previous-heading) (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) + (when (and (looking-at "[ \t\n]+") + (= (match-end 0) (point-max))) + (outline-flag-region (point) (match-end 0) nil)))) (defun org-show-empty-lines-in-parent () "Move to the parent and re-show empty lines before visible headlines." @@ -7061,28 +7298,28 @@ are at least `org-cycle-separator-lines' empty lines before the headline." (org-cycle-show-empty-lines context)))) (defun org-files-list () - "Return `org-agenda-files' list, plus all open org-mode files. + "Return `org-agenda-files' list, plus all open Org files. This is useful for operations that need to scan all of a user's open and agenda-wise Org files." (let ((files (mapcar 'expand-file-name (org-agenda-files)))) (dolist (buf (buffer-list)) (with-current-buffer buf - (if (and (derived-mode-p 'org-mode) (buffer-file-name)) - (let ((file (expand-file-name (buffer-file-name)))) - (unless (member file files) - (push file files)))))) + (when (and (derived-mode-p 'org-mode) (buffer-file-name)) + (cl-pushnew (expand-file-name (buffer-file-name)) files)))) files)) (defsubst org-entry-beginning-position () "Return the beginning position of the current entry." - (save-excursion (outline-back-to-heading t) (point))) + (save-excursion (org-back-to-heading t) (point))) (defsubst org-entry-end-position () "Return the end position of the current entry." (save-excursion (outline-next-heading) (point))) -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." +(defun org-cycle-hide-drawers (state &optional exceptions) + "Re-hide all drawers after a visibility state change. +When non-nil, optional argument EXCEPTIONS is a list of strings +specifying which drawers should not be hidden." (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) (save-excursion @@ -7093,36 +7330,39 @@ open and agenda-wise Org files." (save-excursion (outline-next-heading) (point)) (org-end-of-subtree t))))) (goto-char beg) - (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) - -(defun org-cycle-hide-inline-tasks (state) - "Re-hide inline tasks when switching to `contents' or `children' -visibility state." - (case state - (contents - (when (org-bound-and-true-p org-inlinetask-min-level) - (hide-sublevels (1- org-inlinetask-min-level)))) - (children - (when (featurep 'org-inlinetask) - (save-excursion - (while (and (outline-next-heading) - (org-inlinetask-at-task-p)) - (org-inlinetask-toggle-visibility) - (org-inlinetask-goto-end))))))) - -(defun org-flag-drawer (flag) - "When FLAG is non-nil, hide the drawer we are within. -Otherwise make it visible." - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (user-error ":END: line missing at position %s" b)))))) + (while (re-search-forward org-drawer-regexp (max end (point)) t) + (unless (member-ignore-case (match-string 1) exceptions) + (let ((drawer (org-element-at-point))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (org-flag-drawer t drawer) + ;; Make sure to skip drawer entirely or we might flag + ;; it another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer)))))))))) + +(defun org-flag-drawer (flag &optional element) + "When FLAG is non-nil, hide the drawer we are at. +Otherwise make it visible. When optional argument ELEMENT is +a parsed drawer, as returned by `org-element-at-point', hide or +show that drawer instead." + (let ((drawer (or element + (and (save-excursion + (beginning-of-line) + (looking-at-p org-drawer-regexp)) + (org-element-at-point))))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (let ((post (org-element-property :post-affiliated drawer))) + (save-excursion + (outline-flag-region + (progn (goto-char post) (line-end-position)) + (progn (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \r\t\n") + (line-end-position)) + flag)) + ;; When the drawer is hidden away, make sure point lies in + ;; a visible part of the buffer. + (when (and flag (> (line-beginning-position) post)) + (goto-char post)))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" @@ -7131,9 +7371,11 @@ Otherwise make it visible." (defun org-first-headline-recenter () "Move cursor to the first headline and recenter the headline." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) - (set-window-start (selected-window) (point-at-bol)))) + (let ((window (get-buffer-window))) + (when window + (goto-char (point-min)) + (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) + (set-window-start window (line-beginning-position)))))) ;;; Saving and restoring visibility @@ -7144,38 +7386,30 @@ The return value is a list of cons cells, with start and stop positions for each overlay. If USE-MARKERS is set, return the positions as markers." (let (beg end) - (save-excursion - (save-restriction - (widen) - (delq nil - (mapcar (lambda (o) - (when (eq (overlay-get o 'invisible) 'outline) - (setq beg (overlay-start o) - end (overlay-end o)) - (and beg end (> end beg) - (if use-markers - (cons (move-marker (make-marker) beg) - (move-marker (make-marker) end)) - (cons beg end))))) - (overlays-in (point-min) (point-max)))))))) + (org-with-wide-buffer + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (copy-marker beg) + (copy-marker end t)) + (cons beg end))))) + (overlays-in (point-min) (point-max))))))) (defun org-set-outline-overlay-data (data) "Create visibility overlays for all positions in DATA. DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (show-all) - (mapc (lambda (c) - (outline-flag-region (car c) (cdr c) t)) - data))))) + (org-with-wide-buffer + (outline-show-all) + (dolist (c data) (outline-flag-region (car c) (cdr c) t)))) ;;; Folding of blocks -(defvar org-hide-block-overlays nil +(defvar-local org-hide-block-overlays nil "Overlays hiding blocks.") -(make-variable-buffer-local 'org-hide-block-overlays) (defun org-block-map (function &optional start end) "Call FUNCTION at the head of all source blocks in the current buffer. @@ -7192,74 +7426,85 @@ Optional arguments START and END can be used to limit the range." (defun org-hide-block-toggle-all () "Toggle the visibility of all blocks in the current buffer." - (org-block-map #'org-hide-block-toggle)) + (org-block-map 'org-hide-block-toggle)) (defun org-hide-block-all () "Fold all blocks in the current buffer." (interactive) (org-show-block-all) - (org-block-map #'org-hide-block-toggle-maybe)) + (org-block-map 'org-hide-block-toggle-maybe)) (defun org-show-block-all () "Unfold all blocks in the current buffer." (interactive) - (mapc 'delete-overlay org-hide-block-overlays) + (mapc #'delete-overlay org-hide-block-overlays) (setq org-hide-block-overlays nil)) (defun org-hide-block-toggle-maybe () - "Toggle visibility of block at point." + "Toggle visibility of block at point. +Unlike to `org-hide-block-toggle', this function does not throw +an error. Return a non-nil value when toggling is successful." (interactive) - (let ((case-fold-search t)) - (if (save-excursion - (beginning-of-line 1) - (looking-at org-block-regexp)) - (progn (org-hide-block-toggle) - t) ;; to signal that we took action - nil))) ;; to signal that we did not + (ignore-errors (org-hide-block-toggle))) (defun org-hide-block-toggle (&optional force) - "Toggle the visibility of the current block." + "Toggle the visibility of the current block. +When optional argument FORCE is `off', make block visible. If it +is non-nil, hide it unconditionally. Throw an error when not at +a block. Return a non-nil value when toggling is successful." (interactive) - (save-excursion - (beginning-of-line) - (if (re-search-forward org-block-regexp nil t) - (let ((start (- (match-beginning 4) 1)) ;; beginning of body - (end (match-end 0)) ;; end of entire body - ov) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-hide-block)) - (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-hide-block-overlays) - (setq org-hide-block-overlays - (delq ov org-hide-block-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-hide-block) - (delete-overlay ov))) - (overlays-at start))) - (setq ov (make-overlay start end)) - (overlay-put ov 'invisible 'org-hide-block) - ;; make the block accessible to isearch - (overlay-put - ov 'isearch-open-invisible - (lambda (ov) - (when (member ov org-hide-block-overlays) - (setq org-hide-block-overlays - (delq ov org-hide-block-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-hide-block) - (delete-overlay ov)))) - (push ov org-hide-block-overlays))) - (user-error "Not looking at a source block")))) - -;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) + (let ((element (org-element-at-point))) + (unless (memq (org-element-type element) + '(center-block comment-block dynamic-block example-block + export-block quote-block special-block + src-block verse-block)) + (user-error "Not at a block")) + (let* ((start (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (line-end-position))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-end-position))) + (overlays (overlays-at start))) + (cond + ;; Do nothing when not before or at the block opening line or + ;; at the block closing line. + ((let ((eol (line-end-position))) (and (> eol start) (/= eol end))) nil) + ((and (not (eq force 'off)) + (not (memq t (mapcar + (lambda (o) + (eq (overlay-get o 'invisible) 'org-hide-block)) + overlays)))) + (let ((ov (make-overlay start end))) + (overlay-put ov 'invisible 'org-hide-block) + ;; Make the block accessible to `isearch'. + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (memq ov org-hide-block-overlays) + (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) + (delete-overlay ov)))) + (push ov org-hide-block-overlays) + ;; When the block is hidden away, make sure point is left in + ;; a visible part of the buffer. + (when (> (line-beginning-position) start) + (goto-char start) + (beginning-of-line)) + ;; Signal successful toggling. + t)) + ((or (not force) (eq force 'off)) + (dolist (ov overlays t) + (when (memq ov org-hide-block-overlays) + (setq org-hide-block-overlays (delq ov org-hide-block-overlays))) + (when (eq (overlay-get ov 'invisible) 'org-hide-block) + (delete-overlay ov)))))))) + ;; Remove overlays when changing major mode (add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-show-block-all 'append 'local))) + (lambda () (add-hook 'change-major-mode-hook + 'org-show-block-all 'append 'local))) ;;; Org-goto @@ -7305,7 +7550,7 @@ Optional arguments START and END can be used to limit the range." (defconst org-goto-help "Browse buffer copy, to find location or copy text.%s RET=jump to location C-g=quit and return to previous location -[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") +\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") (defvar org-goto-start-pos) ; dynamically scoped parameter @@ -7343,23 +7588,23 @@ With a prefix argument, use the alternative interface: e.g., if (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (let ((pa (org-refile-get-location "Goto" nil nil t))) + (let ((pa (org-refile-get-location "Goto"))) (org-refile-check-position pa) (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) - (if (or (outline-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) + (when (or (org-invisible-p) (org-invisible-p2)) + (org-show-context 'org-goto))) (message "Quit")))) (defvar org-goto-selected-point nil) ; dynamically scoped parameter (defvar org-goto-exit-command nil) ; dynamically scoped parameter (defvar org-goto-local-auto-isearch-map) ; defined below -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. +(defun org-get-location (_buf help) + "Let the user select a location in current buffer. This function uses a recursive edit. It returns the selected position or nil." (org-no-popups @@ -7372,7 +7617,7 @@ or nil." (save-window-excursion (delete-other-windows) (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (org-pop-to-buffer-same-window + (pop-to-buffer-same-window (condition-case nil (make-indirect-buffer (current-buffer) "*org-goto*") (error (make-indirect-buffer (current-buffer) "*org-goto*")))) @@ -7390,11 +7635,9 @@ or nil." (setq buffer-read-only t) (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) - (let ((org-show-hierarchy-above t) - (org-show-siblings t) - (org-show-following-heading t)) - (goto-char org-goto-start-pos) - (and (outline-invisible-p) (org-show-context))) + (progn (goto-char org-goto-start-pos) + (when (org-invisible-p) + (org-show-set-visibility 'lineage))) (goto-char (point-min))) (let (org-special-ctrl-a/e) (org-beginning-of-line)) (message "Select location and press RET") @@ -7405,8 +7648,14 @@ or nil." (defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) (set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) -(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) -(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char) +;; `isearch-other-control-char' was removed in Emacs 24.4. +(if (fboundp 'isearch-other-control-char) + (progn + (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) + (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) + (define-key org-goto-local-auto-isearch-map "\C-i" nil) + (define-key org-goto-local-auto-isearch-map "\C-m" nil) + (define-key org-goto-local-auto-isearch-map [return] nil)) (defun org-goto-local-search-headings (string bound noerror) "Search and make sure that any matches are in headlines." @@ -7414,9 +7663,12 @@ or nil." (while (if isearch-forward (search-forward string bound noerror) (search-backward string bound noerror)) - (when (let ((context (mapcar 'car (save-match-data (org-context))))) - (and (member :headline context) - (not (member :tags context)))) + (when (save-match-data + (and (save-excursion + (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5))))) (throw 'return (point)))))) (defun org-goto-local-auto-isearch () @@ -7428,11 +7680,11 @@ or nil." (isearch-mode t) (isearch-process-search-char (string-to-char keys))))) -(defun org-goto-ret (&optional arg) +(defun org-goto-ret (&optional _arg) "Finish `org-goto' by going to the new location." (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) + (setq org-goto-selected-point (point)) + (setq org-goto-exit-command 'return) (throw 'exit nil)) (defun org-goto-left () @@ -7471,17 +7723,18 @@ or nil." (defun org-tree-to-indirect-buffer (&optional arg) "Create indirect buffer and narrow it to current subtree. + With a numerical prefix ARG, go up to this level and then take that tree. If ARG is negative, go up that many levels. If `org-indirect-buffer-display' is not `new-frame', the command removes the indirect buffer previously made with this command, to avoid proliferation of indirect buffers. However, when you call the command with a \ -\\[universal-argument] prefix, or -when `org-indirect-buffer-display' is `new-frame', the last buffer -is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the \ -\\[universal-argument] prefix also +`\\[universal-argument]' prefix, or +when `org-indirect-buffer-display' is `new-frame', the last buffer is kept +so that you can work with several indirect buffers at the same time. If +`org-indirect-buffer-display' is `dedicated-frame', the \ +`\\[universal-argument]' prefix also requests that a new frame be made for the new buffer, so that the dedicated frame is not changed." (interactive "P") @@ -7493,26 +7746,26 @@ frame is not changed." (org-back-to-heading t) (when (numberp arg) (setq level (org-outline-level)) - (if (< arg 0) (setq arg (+ level arg))) + (when (< arg 0) (setq arg (+ level arg))) (while (> (setq level (org-outline-level)) arg) (org-up-heading-safe))) (setq beg (point) - heading (org-get-heading)) + heading (org-get-heading 'no-tags)) (org-end-of-subtree t t) - (if (org-at-heading-p) (backward-char 1)) + (when (org-at-heading-p) (backward-char 1)) (setq end (point))) - (if (and (buffer-live-p org-last-indirect-buffer) - (not (eq org-indirect-buffer-display 'new-frame)) - (not arg)) - (kill-buffer org-last-indirect-buffer)) - (setq ibuf (org-get-indirect-buffer cbuf) + (when (and (buffer-live-p org-last-indirect-buffer) + (not (eq org-indirect-buffer-display 'new-frame)) + (not arg)) + (kill-buffer org-last-indirect-buffer)) + (setq ibuf (org-get-indirect-buffer cbuf heading) org-last-indirect-buffer ibuf) (cond ((or (eq org-indirect-buffer-display 'new-frame) (and arg (eq org-indirect-buffer-display 'dedicated-frame))) (select-frame (make-frame)) (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) + (pop-to-buffer-same-window ibuf) (org-set-frame-title heading)) ((eq org-indirect-buffer-display 'dedicated-frame) (raise-frame @@ -7521,26 +7774,28 @@ frame is not changed." org-indirect-dedicated-frame) (setq org-indirect-dedicated-frame (make-frame))))) (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) + (pop-to-buffer-same-window ibuf) (org-set-frame-title (concat "Indirect: " heading))) ((eq org-indirect-buffer-display 'current-window) - (org-pop-to-buffer-same-window ibuf)) + (pop-to-buffer-same-window ibuf)) ((eq org-indirect-buffer-display 'other-window) (pop-to-buffer ibuf)) (t (error "Invalid value"))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) (narrow-to-region beg end) - (show-all) + (outline-show-all) (goto-char pos) (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) -(defun org-get-indirect-buffer (&optional buffer) +(defun org-get-indirect-buffer (&optional buffer heading) (setq buffer (or buffer (current-buffer))) (let ((n 1) (base (buffer-name buffer)) bname) (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (number-to-string n))))) + (get-buffer + (setq bname + (concat base "-" + (if heading (concat heading "-" (number-to-string n)) + (number-to-string n)))))) (setq n (1+ n))) (condition-case nil (make-indirect-buffer buffer bname 'clone) @@ -7548,57 +7803,70 @@ frame is not changed." (defun org-set-frame-title (title) "Set the title of the current frame to the string TITLE." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) + (modify-frame-parameters (selected-frame) (list (cons 'name title)))) ;;;; Structure editing ;;; Inserting headlines -(defun org-previous-line-empty-p (&optional next) - "Is the previous line a blank line? -When NEXT is non-nil, check the next line instead." +(defun org--line-empty-p (n) + "Is the Nth next line empty? + +Counts the current line as N = 1 and the previous line as N = 0; +see `beginning-of-line'." (save-excursion (and (not (bobp)) - (or (beginning-of-line (if next 2 0)) t) + (or (beginning-of-line n) t) (save-match-data (looking-at "[ \t]*$"))))) -(defun org-insert-heading (&optional arg invisible-ok) - "Insert a new heading or an item with the same depth at point. - -If point is at the beginning of a heading or a list item, insert -a new heading or a new item above the current one. If point is -at the beginning of a normal line, turn the line into a heading. +(defun org-previous-line-empty-p () + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." + (org--line-empty-p 0)) -If point is in the middle of a headline or a list item, split the -headline or the item and create a new headline/item with the text -in the current line after point \(see `org-M-RET-may-split-line' -on how to modify this behavior). +(defun org-next-line-empty-p () + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." + (org--line-empty-p 2)) -With one universal prefix argument, set the user option -`org-insert-heading-respect-content' to t for the duration of -the command. This modifies the behavior described above in this -ways: on list items and at the beginning of normal lines, force -the insertion of a heading after the current subtree. +(defun org-insert-heading (&optional arg invisible-ok top) + "Insert a new heading or an item with the same depth at point. -With two universal prefix arguments, insert the heading at the -end of the grandparent subtree. For example, if point is within -a 2nd-level heading, then it will insert a 2nd-level heading at -the end of the 1st-level parent heading. +If point is at the beginning of a heading or a list item, insert +a new heading or a new item above the current one. When at the +beginning of a regular line of text, turn it into a heading. + +If point is in the middle of a line, split it and create a new +headline/item with the text in the current line after point (see +`org-M-RET-may-split-line' on how to modify this behavior). As +a special case, on a headline, splitting can only happen on the +title itself. E.g., this excludes breaking stars or tags. + +With a `\\[universal-argument]' prefix, set \ +`org-insert-heading-respect-content' to +a non-nil value for the duration of the command. This forces the +insertion of a heading after the current subtree, independently +on the location of point. + +With a `\\[universal-argument] \\[universal-argument]' prefix, \ +insert the heading at the end of the tree +above the current heading. For example, if point is within a +2nd-level heading, then it will insert a 2nd-level heading at +the end of the 1st-level parent subtree. When INVISIBLE-OK is set, stop at invisible headlines when going back. This is important for non-interactive uses of the -command." +command. + +When optional argument TOP is non-nil, insert a level 1 heading, +unconditionally." (interactive "P") - (if (org-called-interactively-p 'any) (org-reveal)) - (let ((itemp (org-in-item-p)) + (let ((itemp (and (not top) (org-in-item-p))) (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) (respect-content (or org-insert-heading-respect-content (equal arg '(4)))) - (initial-content "") - (adjust-empty-lines t)) + (initial-content "")) (cond @@ -7621,9 +7889,7 @@ command." (insert "\n* "))) (run-hooks 'org-insert-heading-hook)) - ((and itemp (not (member arg '((4) (16))))) - ;; Insert an item - (org-insert-item)) + ((and itemp (not (member arg '((4) (16)))) (org-insert-item))) (t ;; Maybe move at the end of the subtree @@ -7639,25 +7905,26 @@ command." (org-previous-line-empty-p) ;; We will decide later nil)) - ;; Get a level string to fall back on + ;; Get a level string to fall back on. (fix-level (if (org-before-first-heading-p) "*" (save-excursion (org-back-to-heading t) - (if (org-previous-line-empty-p) (setq empty-line-p t)) + (when (org-previous-line-empty-p) (setq empty-line-p t)) (looking-at org-outline-regexp) (make-string (1- (length (match-string 0))) ?*)))) (stars (save-excursion (condition-case nil - (progn + (if top "* " (org-back-to-heading invisible-ok) (when (and (not on-heading) (featurep 'org-inlinetask) (integerp org-inlinetask-min-level) (>= (length (match-string 0)) org-inlinetask-min-level)) - ;; Find a heading level before the inline task + ;; Find a heading level before the inline + ;; task. (while (and (setq level (org-up-heading-safe)) (>= level org-inlinetask-min-level))) (if (org-at-heading-p) @@ -7668,23 +7935,22 @@ command." (org-backward-heading-same-level 1 invisible-ok)) (= (point) (match-beginning 0))) - (not (org-previous-line-empty-p t))) + (not (org-next-line-empty-p))) (setq empty-line-p (or empty-line-p (org-previous-line-empty-p)))) (match-string 0)) (error (or fix-level "* "))))) (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) + (blank (if (eq blank-a 'auto) empty-line-p blank-a))) - ;; If we insert after content, move there and clean up whitespace - (when (and respect-content - (not (org-looking-at-p org-outline-regexp-bol))) + ;; If we insert after content, move there and clean up + ;; whitespace. + (when respect-content (if (not (org-before-first-heading-p)) (org-end-of-subtree nil t) (re-search-forward org-outline-regexp-bol) (beginning-of-line 0)) - (skip-chars-backward " \r\n") + (skip-chars-backward " \r\t\n") (and (not (looking-back "^\\*+" (line-beginning-position))) (looking-at "[ \t]+") (replace-match "")) (unless (eobp) (forward-char 1)) @@ -7692,14 +7958,17 @@ command." (unless (bobp) (backward-char 1)) (insert "\n"))) - ;; If we are splitting, grab the text that should be moved to the new headline + ;; If we are splitting, grab the text that should be moved + ;; to the new headline. (when may-split - (if (org-on-heading-p) - ;; This is a heading, we split intelligently (keeping tags) + (if (org-at-heading-p) + ;; This is a heading: split intelligently (keeping + ;; tags). (let ((pos (point))) - (goto-char (point-at-bol)) - (unless (looking-at org-complex-heading-regexp) - (error "This should not happen")) + (beginning-of-line) + (let ((case-fold-search nil)) + (unless (looking-at org-complex-heading-regexp) + (error "This should not happen"))) (when (and (match-beginning 4) (> pos (match-beginning 4)) (< pos (match-end 4))) @@ -7708,31 +7977,35 @@ command." (delete-region (point) (match-end 4)) (if (looking-at "[ \t]*$") (replace-match "") - (insert (make-string (length initial-content) ?\ ))) + (insert (make-string (length initial-content) ?\s))) (setq initial-content (org-trim initial-content))) (goto-char pos)) - ;; a normal line + ;; A normal line. (setq initial-content - (org-trim (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)))) + (org-trim + (delete-and-extract-region (point) (line-end-position)))))) - ;; If we are at the beginning of the line, insert before it. Else after + ;; If we are at the beginning of the line, insert before it. + ;; Otherwise, after it. (cond ((and (bolp) (looking-at "[ \t]*$"))) - ((and (bolp) (not (looking-at "[ \t]*$"))) - (open-line 1)) - (t - (goto-char (point-at-eol)) - (insert "\n"))) + ((bolp) (save-excursion (insert "\n"))) + (t (end-of-line) + (insert "\n"))) ;; Insert the new heading (insert stars) (just-one-space) (insert initial-content) - (when adjust-empty-lines - (if (or (not blank) - (and blank (not (org-previous-line-empty-p)))) - (org-N-empty-lines-before-current (if blank 1 0)))) + (unless (and blank (org-previous-line-empty-p)) + (org-N-empty-lines-before-current (if blank 1 0))) + ;; Adjust visibility, which may be messed up if we removed + ;; blank lines while previous entry was hidden. + (let ((bol (line-beginning-position))) + (dolist (o (overlays-at (1- bol))) + (when (and (eq (overlay-get o 'invisible) 'outline) + (eq (overlay-end o) bol)) + (move-overlay o (overlay-start o) (1- bol))))) (run-hooks 'org-insert-heading-hook))))))) (defun org-N-empty-lines-before-current (N) @@ -7752,20 +8025,23 @@ When NO-TAGS is non-nil, don't include tags. When NO-TODO is non-nil, don't include TODO keywords." (save-excursion (org-back-to-heading t) - (cond - ((and no-tags no-todo) - (looking-at org-complex-heading-regexp) - (match-string 4)) - (no-tags - (looking-at (concat org-outline-regexp - "\\(.*?\\)" - "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) - (match-string 1)) - (no-todo - (looking-at org-todo-line-regexp) - (match-string 3)) - (t (looking-at org-heading-regexp) - (match-string 2))))) + (let ((case-fold-search nil)) + (cond + ((and no-tags no-todo) + (looking-at org-complex-heading-regexp) + ;; Return value has to be a string, but match group 4 is + ;; optional. + (or (match-string 4) "")) + (no-tags + (looking-at (concat org-outline-regexp + "\\(.*?\\)" + "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) + (match-string 1)) + (no-todo + (looking-at org-todo-line-regexp) + (match-string 3)) + (t (looking-at org-heading-regexp) + (match-string 2)))))) (defvar orgstruct-mode) ; defined below @@ -7780,24 +8056,24 @@ This is a list with the following elements: - the tags string, or nil." (save-excursion (org-back-to-heading t) - (if (let (case-fold-search) - (looking-at - (if orgstruct-mode - org-heading-regexp - org-complex-heading-regexp))) - (if orgstruct-mode - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - nil - nil - (match-string 2) - nil) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5)))))) + (when (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (match-string-no-properties 4) + (match-string-no-properties 5)))))) (defun org-get-entry () "Get the entry text, after heading, entire subtree." @@ -7805,6 +8081,24 @@ This is a list with the following elements: (org-back-to-heading t) (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) +(defun org-edit-headline (&optional heading) + "Edit the current headline. +Set it to HEADING when provided." + (interactive) + (org-with-wide-buffer + (org-back-to-heading t) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (let* ((old (match-string-no-properties 4)) + (new (save-match-data + (org-trim (or heading (read-string "Edit: " old)))))) + (unless (equal old new) + (if old (replace-match new t t nil 4) + (goto-char (or (match-end 3) (match-end 2) (match-end 1))) + (insert " " new)) + (org-set-tags nil t) + (when (looking-at "[ \t]*$") (replace-match "")))))))) + (defun org-insert-heading-after-current () "Insert a new heading with same level as current, after current subtree." (interactive) @@ -7825,9 +8119,14 @@ This is a list with the following elements: (defun org-insert-todo-heading (arg &optional force-heading) "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also with one prefix arg, force first state. With -two prefix args, force inserting at the end of the parent subtree." + +If the heading has no TODO state, or if the state is DONE, use +the first state (TODO by default). Also with one prefix arg, +force first state. With two prefix args, force inserting at the +end of the parent subtree. + +When called at a plain list item, insert a new item with an +unchecked check box." (interactive "P") (when (or force-heading (not (org-insert-item 'checkbox))) (org-insert-heading (or (and (equal arg '(16)) '(16)) @@ -7835,19 +8134,18 @@ two prefix args, force inserting at the end of the parent subtree." (save-excursion (org-back-to-heading) (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (let* - ((new-mark-x - (if (or (equal arg '(4)) - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (car org-todo-keywords-1) - (match-string 2))) - (new-mark - (or - (run-hook-with-args-until-success - 'org-todo-get-default-hook new-mark-x nil) - new-mark-x))) + (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))) + (let* ((new-mark-x + (if (or (equal arg '(4)) + (not (match-beginning 2)) + (member (match-string 2) org-done-keywords)) + (car org-todo-keywords-1) + (match-string 2))) + (new-mark + (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook new-mark-x nil) + new-mark-x))) (beginning-of-line 1) (and (looking-at org-outline-regexp) (goto-char (match-end 0)) (if org-treat-insert-todo-heading-as-state-change @@ -7895,18 +8193,17 @@ See also `org-promote'." (org-fix-position-after-promote)) (defun org-demote-subtree () - "Demote the entire subtree. See `org-demote'. -See also `org-promote'." + "Demote the entire subtree. +See `org-demote' and `org-promote'." (interactive) (save-excursion (org-with-limited-levels (org-map-tree 'org-demote))) (org-fix-position-after-promote)) - (defun org-do-promote () "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." +If the region is active in `transient-mark-mode', promote all +headings in the region." (interactive) (save-excursion (if (org-region-active-p) @@ -7916,8 +8213,8 @@ in the region." (defun org-do-demote () "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." +If the region is active in `transient-mark-mode', demote all +headings in the region." (interactive) (save-excursion (if (org-region-active-p) @@ -7926,23 +8223,24 @@ in the region." (org-fix-position-after-promote)) (defun org-fix-position-after-promote () - "Make sure that after pro/demotion cursor position is right." + "Fix cursor position and indentation after demoting/promoting." (let ((pos (point))) (when (save-excursion - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (or (equal pos (match-end 1)) (equal pos (match-end 2)))) + (beginning-of-line) + (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) + (or (eq pos (match-end 1)) (eq pos (match-end 2)))) (cond ((eobp) (insert " ")) ((eolp) (insert " ")) - ((equal (char-after) ?\ ) (forward-char 1)))))) + ((equal (char-after) ?\s) (forward-char 1)))))) (defun org-current-level () "Return the level of the current entry, or nil if before the first headline. -The level is the number of stars at the beginning of the headline." - (save-excursion - (org-with-limited-levels - (if (ignore-errors (org-back-to-heading t)) - (funcall outline-level))))) +The level is the number of stars at the beginning of the +headline. Use `org-reduced-level' to remove the effect of +`org-odd-levels'. Unlike to `org-outline-level', this function +ignores inlinetasks." + (let ((level (org-with-limited-levels (org-outline-level)))) + (and (> level 0) level))) (defun org-get-previous-line-level () "Return the outline depth of the last headline before the current line. @@ -7978,50 +8276,39 @@ even level numbers will become the next higher odd number." ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) (max 1 (+ level (or change 0))))) -(if (boundp 'define-obsolete-function-alias) - (if (or (featurep 'xemacs) (< emacs-major-version 23)) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level "23.1"))) - (defun org-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) - (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) - (diff (abs (- level (length up-head) -1)))) - (cond ((and (= level 1) org-called-with-limited-levels - org-allow-promoting-top-level-subtree) - (replace-match "# " nil t)) - ((= level 1) - (user-error "Cannot promote to level 0. UNDO to recover if necessary")) - (t (replace-match up-head nil t))) - ;; Fixup tag positioning - (unless (= level 1) - (and org-auto-align-tags (org-set-tags nil 'ignore-column)) - (if org-adapt-indentation (org-fixup-indentation (- diff)))) - (run-hooks 'org-after-promote-entry-hook))) + "Promote the current heading higher up the tree." + (org-with-wide-buffer + (org-back-to-heading t) + (let* ((after-change-functions (remq 'flyspell-after-change-function + after-change-functions)) + (level (save-match-data (funcall outline-level))) + (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) + (diff (abs (- level (length up-head) -1)))) + (cond + ((and (= level 1) org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (user-error "Cannot promote to level 0. UNDO to recover if necessary")) + (t (replace-match up-head nil t))) + (unless (= level 1) + (when org-auto-align-tags (org-set-tags nil 'ignore-column)) + (when org-adapt-indentation (org-fixup-indentation (- diff)))) + (run-hooks 'org-after-promote-entry-hook)))) (defun org-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) - (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) - (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil 'ignore-column)) - (if org-adapt-indentation (org-fixup-indentation diff)) - (run-hooks 'org-after-demote-entry-hook))) + "Demote the current heading lower down the tree." + (org-with-wide-buffer + (org-back-to-heading t) + (let* ((after-change-functions (remq 'flyspell-after-change-function + after-change-functions)) + (level (save-match-data (funcall outline-level))) + (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) + (diff (abs (- level (length down-head) -1)))) + (replace-match down-head nil t) + (when org-auto-align-tags (org-set-tags nil 'ignore-column)) + (when org-adapt-indentation (org-fixup-indentation diff)) + (run-hooks 'org-after-demote-entry-hook)))) (defun org-cycle-level () "Cycle the level of an empty headline through possible states. @@ -8036,32 +8323,32 @@ After top level, it switches back to sibling level." (cond ;; If first headline in file, promote to top-level. ((= prev-level 0) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) + (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) ;; If same level as prev, demote one. ((= prev-level cur-level) (org-do-demote)) ;; If parent is top-level, promote to top level if not already. ((= prev-level 1) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) + (cl-loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) ;; If top-level, return to prev-level. ((= cur-level 1) - (loop repeat (/ (- prev-level 1) (org-level-increment)) - do (org-do-demote))) + (cl-loop repeat (/ (- prev-level 1) (org-level-increment)) + do (org-do-demote))) ;; If less than prev-level, promote one. ((< cur-level prev-level) (org-do-promote)) ;; If deeper than prev-level, promote until higher than ;; prev-level. ((> cur-level prev-level) - (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) - do (org-do-promote)))) + (cl-loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) + do (org-do-promote)))) t)))) (defun org-map-tree (fun) "Call FUN for every heading underneath the current one." - (org-back-to-heading) + (org-back-to-heading t) (let ((level (funcall outline-level))) (save-excursion (funcall fun) @@ -8077,39 +8364,123 @@ After top level, it switches back to sibling level." (save-excursion (setq end (copy-marker end)) (goto-char beg) - (if (and (re-search-forward org-outline-regexp-bol nil t) - (< (point) end)) - (funcall fun)) + (when (and (re-search-forward org-outline-regexp-bol nil t) + (< (point) end)) + (funcall fun)) (while (and (progn (outline-next-heading) (< (point) end)) (not (eobp))) (funcall fun))))) -(defvar org-property-end-re) ; silence byte-compiler (defun org-fixup-indentation (diff) "Change the indentation in the current entry by DIFF. -However, if any line in the current entry has no indentation, or if it -would end up with no indentation after the change, nothing at all is done." - (save-excursion - (let ((end (save-excursion (outline-next-heading) - (point-marker))) - (prohibit (if (> diff 0) - "^\\S-" - (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) - col) - (unless (save-excursion (end-of-line 1) - (re-search-forward prohibit end t)) - (while (and (< (point) end) - (re-search-forward "^[ \t]+" end t)) - (goto-char (match-end 0)) - (setq col (current-column)) - (if (< diff 0) (replace-match "")) - (org-indent-to-column (+ diff col)))) - (move-marker end nil)))) + +DIFF is an integer. Indentation is done according to the +following rules: + + - Planning information and property drawers are always indented + according to the new level of the headline; + + - Footnote definitions and their contents are ignored; + + - Inlinetasks' boundaries are not shifted; + + - Empty lines are ignored; + + - Other lines' indentation are shifted by DIFF columns, unless + it would introduce a structural change in the document, in + which case no shifting is done at all. + +Assume point is at a heading or an inlinetask beginning." + (org-with-wide-buffer + (narrow-to-region (line-beginning-position) + (save-excursion + (if (org-with-limited-levels (org-at-heading-p)) + (org-with-limited-levels (outline-next-heading)) + (org-inlinetask-goto-end)) + (point))) + (forward-line) + ;; Indent properly planning info and property drawer. + (when (looking-at-p org-planning-line-re) + (org-indent-line) + (forward-line)) + (when (looking-at org-property-drawer-re) + (goto-char (match-end 0)) + (forward-line) + (save-excursion (org-indent-region (match-beginning 0) (match-end 0)))) + (catch 'no-shift + (when (zerop diff) (throw 'no-shift nil)) + ;; If DIFF is negative, first check if a shift is possible at all + ;; (e.g., it doesn't break structure). This can only happen if + ;; some contents are not properly indented. + (let ((case-fold-search t)) + (when (< diff 0) + (let ((diff (- diff)) + (forbidden-re (concat org-outline-regexp + "\\|" + (substring org-footnote-definition-re 1)))) + (save-excursion + (while (not (eobp)) + (cond + ((looking-at-p "[ \t]*$") (forward-line)) + ((and (looking-at-p org-footnote-definition-re) + (let ((e (org-element-at-point))) + (and (eq (org-element-type e) 'footnote-definition) + (goto-char (org-element-property :end e)))))) + ((looking-at-p org-outline-regexp) (forward-line)) + ;; Give up if shifting would move before column 0 or + ;; if it would introduce a headline or a footnote + ;; definition. + (t + (skip-chars-forward " \t") + (let ((ind (current-column))) + (when (or (< ind diff) + (and (= ind diff) (looking-at-p forbidden-re))) + (throw 'no-shift nil))) + ;; Ignore contents of example blocks and source + ;; blocks if their indentation is meant to be + ;; preserved. Jump to block's closing line. + (beginning-of-line) + (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") + (let ((e (org-element-at-point))) + (and (memq (org-element-type e) + '(example-block src-block)) + (or org-src-preserve-indentation + (org-element-property :preserve-indent e)) + (goto-char (org-element-property :end e)) + (progn (skip-chars-backward " \r\t\n") + (beginning-of-line) + t)))) + (forward-line)))))))) + ;; Shift lines but footnote definitions, inlinetasks boundaries + ;; by DIFF. Also skip contents of source or example blocks + ;; when indentation is meant to be preserved. + (while (not (eobp)) + (cond + ((and (looking-at-p org-footnote-definition-re) + (let ((e (org-element-at-point))) + (and (eq (org-element-type e) 'footnote-definition) + (goto-char (org-element-property :end e)))))) + ((looking-at-p org-outline-regexp) (forward-line)) + ((looking-at-p "[ \t]*$") (forward-line)) + (t + (indent-line-to (+ (org-get-indentation) diff)) + (beginning-of-line) + (or (and (looking-at-p "[ \t]*#\\+BEGIN_\\(EXAMPLE\\|SRC\\)") + (let ((e (org-element-at-point))) + (and (memq (org-element-type e) + '(example-block src-block)) + (or org-src-preserve-indentation + (org-element-property :preserve-indent e)) + (goto-char (org-element-property :end e)) + (progn (skip-chars-backward " \r\t\n") + (beginning-of-line) + t)))) + (forward-line))))))))) (defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. + "Convert an Org file with all levels allowed to one with odd levels. This will leave level 1 alone, convert level 2 to level 3, level 3 to level 5 etc." (interactive) @@ -8125,7 +8496,7 @@ level 5 etc." (end-of-line 1)))))) (defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd/even levels. + "Convert an Org file with only odd levels to one with odd/even levels. This promotes level 3 to level 2, level 5 to level 3 etc. If the file contains a section with an even level, conversion would destroy the structure of the file. An error is signaled in this @@ -8134,7 +8505,7 @@ case." (goto-char (point-min)) ;; First check if there are no even levels (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-context t) + (org-show-set-visibility 'canonical) (error "Not all levels are odd in this file. Conversion not possible")) (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") (let ((outline-regexp org-outline-regexp) @@ -8177,7 +8548,7 @@ case." (setq beg (point))) (save-match-data (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) + (setq folded (org-invisible-p))) (progn (org-end-of-subtree nil t) (unless (eobp) (backward-char)))) (outline-next-heading) @@ -8196,12 +8567,12 @@ case." (progn (goto-char beg0) (user-error "Cannot move past superior level or buffer limit"))) (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (org-end-of-subtree t t) - (save-excursion - (org-back-over-empty-lines) - (or (bolp) (newline))))) + (when (> arg 0) + ;; Moving forward - still need to move over subtree + (org-end-of-subtree t t) + (save-excursion + (org-back-over-empty-lines) + (or (bolp) (newline)))) (setq ne-ins (org-back-over-empty-lines)) (move-marker ins-point (point)) (setq txt (buffer-substring beg end)) @@ -8230,9 +8601,9 @@ case." (insert (make-string (- ne-ins ne-beg) ?\n))) (move-marker ins-point nil) (if folded - (hide-subtree) + (outline-hide-subtree) (org-show-entry) - (show-children) + (org-show-children) (org-cycle-hide-drawers 'children)) (org-clean-visibility-after-subtree-move) ;; move back to the initial column we were at @@ -8264,7 +8635,7 @@ of some markers in the region, even if CUT is non-nil. This is useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (interactive "p") (let (beg end folded (beg0 (point))) - (if (org-called-interactively-p 'any) + (if (called-interactively-p 'any) (org-back-to-heading nil) ; take what looks like a subtree (org-back-to-heading t)) ; take what is really there (setq beg (point)) @@ -8273,11 +8644,14 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (if nosubtrees (outline-next-heading) (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (condition-case nil - (org-forward-heading-same-level (1- n) t) - (error nil)) + (setq folded (org-invisible-p))) + (ignore-errors (org-forward-heading-same-level (1- n) t)) (org-end-of-subtree t t))) + ;; Include the end of an inlinetask + (when (and (featurep 'org-inlinetask) + (looking-at-p (concat (org-inlinetask-outline-regexp) + "END[ \t]*$"))) + (end-of-line)) (setq end (point)) (goto-char beg0) (when (> end beg) @@ -8290,7 +8664,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (if cut "Cut" "Copied") (length org-subtree-clip))))) -(defun org-paste-subtree (&optional level tree for-yank) +(defun org-paste-subtree (&optional level tree for-yank remove) "Paste the clipboard as a subtree, with modification of headline level. The entire subtree is promoted or demoted in order to match a new headline level. @@ -8313,15 +8687,17 @@ If optional TREE is given, use this text instead of the kill ring. When FOR-YANK is set, this is called by `org-yank'. In this case, do not move back over whitespace before inserting, and move point to the end of -the inserted text when done." +the inserted text when done. + +When REMOVE is non-nil, remove the subtree from the clipboard." (interactive "P") (setq tree (or tree (and kill-ring (current-kill 0)))) (unless (org-kill-is-subtree-p tree) (user-error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) + (substitute-command-keys + "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels - (let* ((visp (not (outline-invisible-p))) + (let* ((visp (not (org-invisible-p))) (txt tree) (^re_ "\\(\\*+\\)[ \t]*") (old-level (if (string-match org-outline-regexp-bol txt) @@ -8364,22 +8740,22 @@ the inserted text when done." (org-odd-levels-only nil) beg end newend) ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) + (when force-level + (delete-region (point-at-bol) (point))) ;; Paste (beginning-of-line (if (bolp) 1 2)) (setq beg (point)) (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) (insert-before-markers txt) - (unless (string-match "\n\\'" txt) (insert "\n")) + (unless (string-suffix-p "\n" txt) (insert "\n")) (setq newend (point)) (org-reinstall-markers-in-region beg) (setq end (point)) (goto-char beg) (skip-chars-forward " \t\n\r") (setq beg (point)) - (if (and (outline-invisible-p) visp) - (save-excursion (outline-show-heading))) + (when (and (org-invisible-p) visp) + (save-excursion (outline-show-heading))) ;; Shift if necessary (unless (= shift 0) (save-restriction @@ -8389,15 +8765,16 @@ the inserted text when done." (setq shift (+ delta shift))) (goto-char (point-min)) (setq newend (point-max)))) - (when (or (org-called-interactively-p 'interactive) for-yank) + (when (or (called-interactively-p 'interactive) for-yank) (message "Clipboard pasted as level %d subtree" new-level)) - (if (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)) - (and for-yank (goto-char newend))))) + (when (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (eq org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (outline-hide-subtree)) + (and for-yank (goto-char newend)) + (and remove (setq kill-ring (cdr kill-ring)))))) (defun org-kill-is-subtree-p (&optional txt) "Check if the current kill is an outline subtree, or a set of trees. @@ -8447,15 +8824,14 @@ called immediately, to move the markers with the entries." "Check if MARKER is between BEG and END. If yes, remember the marker and the distance to BEG." (when (and (marker-buffer marker) - (equal (marker-buffer marker) (current-buffer))) - (if (and (>= marker beg) (< marker end)) - (push (cons marker (- marker beg)) org-markers-to-move)))) + (equal (marker-buffer marker) (current-buffer)) + (>= marker beg) (< marker end)) + (push (cons marker (- marker beg)) org-markers-to-move))) (defun org-reinstall-markers-in-region (beg) "Move all remembered markers to their position relative to BEG." - (mapc (lambda (x) - (move-marker (car x) (+ beg (cdr x)))) - org-markers-to-move) + (dolist (x org-markers-to-move) + (move-marker (car x) (+ beg (cdr x)))) (setq org-markers-to-move nil)) (defun org-narrow-to-subtree () @@ -8467,7 +8843,7 @@ If yes, remember the marker and the distance to BEG." (narrow-to-region (progn (org-back-to-heading t) (point)) (progn (org-end-of-subtree t t) - (if (and (org-at-heading-p) (not (eobp))) (backward-char 1)) + (when (and (org-at-heading-p) (not (eobp))) (backward-char 1)) (point))))))) (defun org-narrow-to-block () @@ -8480,10 +8856,6 @@ If yes, remember the marker and the distance to BEG." (narrow-to-region (car blockp) (cdr blockp)) (user-error "Not in a block")))) -(eval-when-compile - (defvar org-property-drawer-re)) - -(defvar org-property-start-re) ;; defined below (defun org-clone-subtree-with-time-shift (n &optional shift) "Clone the task (subtree) at point N times. The clones will be inserted as siblings. @@ -8500,6 +8872,9 @@ stamps in the subtree shifted for each clone produced. If SHIFT is nil or the empty string, time stamps will be left alone. The ID property of the original subtree is removed. +In each clone, all the CLOCK entries will be removed. This +prevents Org from considering that the clocked times overlap. + If the original subtree did contain time stamps with a repeater, the following will happen: - the repeater will be removed in each clone @@ -8510,80 +8885,86 @@ the following will happen: - the start days in the repeater in the original entry will be shifted to past the last clone. In this way you can spell out a number of instances of a repeating task, -and still retain the repeater to cover future instances of the task." +and still retain the repeater to cover future instances of the task. + +As described above, N+1 clones are produced when the original +subtree has a repeater. Setting N to 0, then, can be used to +remove the repeater from a subtree and create a shifted clone +with the original repeater." (interactive "nNumber of clones to produce: ") - (let ((shift - (or shift - (if (and (not (equal current-prefix-arg '(4))) - (save-excursion - (re-search-forward org-ts-regexp-both - (save-excursion - (org-end-of-subtree t) - (point)) t))) - (read-from-minibuffer - "Date shift per clone (e.g. +1w, empty to copy unchanged): ") - ""))) ;; No time shift - (n-no-remove -1) - (drawer-re org-drawer-regexp) - beg end template task idprop - shift-n shift-what doshift nmin nmax) - (if (not (and (integerp n) (> n 0))) - (error "Invalid number of replications %s" n)) - (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" - shift))) - (error "Invalid shift specification %s" shift)) - (when doshift - (setq shift-n (string-to-number (match-string 1 shift)) - shift-what (cdr (assoc (match-string 2 shift) - '(("d" . day) ("w" . week) - ("m" . month) ("y" . year)))))) - (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) - (setq nmin 1 nmax n) - (org-back-to-heading t) - (setq beg (point)) - (setq idprop (org-entry-get nil "ID")) - (org-end-of-subtree t t) - (or (bolp) (insert "\n")) - (setq end (point)) - (setq template (buffer-substring beg end)) - (when (and doshift - (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) - (delete-region beg end) - (setq end beg) - (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) - (goto-char end) - (loop for n from nmin to nmax do - ;; prepare clone - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) - (org-show-subtree) - (and idprop (if org-clone-delete-id - (org-entry-delete nil "ID") - (org-id-get-create t))) - (unless (= n 0) - (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t) - (kill-whole-line)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (mapc (lambda (d) - (org-remove-empty-drawer-at d (point))) - org-drawers))) - (goto-char (point-min)) - (when doshift - (while (re-search-forward org-ts-regexp-both nil t) - (org-timestamp-change (* n shift-n) shift-what)) - (unless (= n n-no-remove) - (goto-char (point-min)) - (while (re-search-forward org-ts-regexp nil t) - (save-excursion - (goto-char (match-beginning 0)) - (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") - (delete-region (match-beginning 1) (match-end 1))))))) - (setq task (buffer-string))) - (insert task)) + (unless (wholenump n) (user-error "Invalid number of replications %s" n)) + (when (org-before-first-heading-p) (user-error "No subtree to clone")) + (let* ((beg (save-excursion (org-back-to-heading t) (point))) + (end-of-tree (save-excursion (org-end-of-subtree t t) (point))) + (shift + (or shift + (if (and (not (equal current-prefix-arg '(4))) + (save-excursion + (goto-char beg) + (re-search-forward org-ts-regexp-both end-of-tree t))) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ") + ""))) ;No time shift + (doshift + (and (org-string-nw-p shift) + (or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" + shift) + (user-error "Invalid shift specification %s" shift))))) + (goto-char end-of-tree) + (unless (bolp) (insert "\n")) + (let* ((end (point)) + (template (buffer-substring beg end)) + (shift-n (and doshift (string-to-number (match-string 1 shift)))) + (shift-what (pcase (and doshift (match-string 2 shift)) + (`nil nil) + ("d" 'day) + ("w" (setq shift-n (* 7 shift-n)) 'day) + ("m" 'month) + ("y" 'year) + (_ (error "Unsupported time unit")))) + (nmin 1) + (nmax n) + (n-no-remove -1) + (idprop (org-entry-get nil "ID"))) + (when (and doshift + (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" + template)) + (delete-region beg end) + (setq end beg) + (setq nmin 0) + (setq nmax (1+ nmax)) + (setq n-no-remove nmax)) + (goto-char end) + (cl-loop for n from nmin to nmax do + (insert + ;; Prepare clone. + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (org-show-subtree) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (unless (= n 0) + (while (re-search-forward org-clock-line-re nil t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (org-remove-empty-drawer-at (point)))) + (goto-char (point-min)) + (when doshift + (while (re-search-forward org-ts-regexp-both nil t) + (org-timestamp-change (* n shift-n) shift-what)) + (unless (= n n-no-remove) + (goto-char (point-min)) + (while (re-search-forward org-ts-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") + (delete-region (match-beginning 1) (match-end 1))))))) + (buffer-string))))) (goto-char beg))) ;;; Outline Sorting @@ -8621,7 +9002,8 @@ hook gets called. When a region or a plain list is sorted, the cursor will be in the first entry of the sorted region/list.") (defun org-sort-entries - (&optional with-case sorting-type getkey-func compare-func property) + (&optional with-case sorting-type getkey-func compare-func property + interactive?) "Sort entries on a certain level of an outline tree. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. @@ -8632,33 +9014,40 @@ a time stamp, by a property, by priority order, or by a custom function. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to be a character, -\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F). Here is the -precise meaning of each character: +\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F ?k ?K). Here is +the precise meaning of each character: -n Numerically, by converting the beginning of the entry/item to a number. a Alphabetically, ignoring the TODO keyword and the priority, if any. -o By order of TODO keywords. -t By date/time, either the first active time stamp in the entry, or, if - none exist, by the first inactive one. -s By the scheduled date/time. -d By deadline date/time. c By creation time, which is assumed to be the first inactive time stamp at the beginning of a line. +d By deadline date/time. +k By clocking time. +n Numerically, by converting the beginning of the entry/item to a number. +o By order of TODO keywords. p By priority according to the cookie. r By the value of a property. +s By scheduled date/time. +t By date/time, either the first active time stamp in the entry, or, if + none exist, by the first inactive one. Capital letters will reverse the sort order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. +called with point at the beginning of the record. It must return a +value that is compatible with COMPARE-FUNC, the function used to +compare entries. Comparing entries ignores case by default. However, with an optional argument WITH-CASE, the sorting considers case as well. Sorting is done against the visible part of the headlines, it ignores hidden -links." - (interactive "P") +links. + +When sorting is done, call `org-after-sorting-entries-or-items-hook'. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil nil t)) (let ((case-func (if with-case 'identity 'downcase)) (cmstr ;; The clock marker is lost when using `sort-subr', let's @@ -8677,10 +9066,10 @@ links." (setq end (region-end) what "region") (goto-char (region-beginning)) - (if (not (org-at-heading-p)) (outline-next-heading)) + (unless (org-at-heading-p) (outline-next-heading)) (setq start (point))) ((or (org-at-heading-p) - (condition-case nil (progn (org-back-to-heading) t) (error nil))) + (ignore-errors (progn (org-back-to-heading) t))) ;; we will sort the children of the current headline (org-back-to-heading) (setq start (point) @@ -8691,7 +9080,7 @@ links." (point)) what "children") (goto-char start) - (show-subtree) + (outline-show-subtree) (outline-next-heading)) (t ;; we will sort the top-level entries in this file @@ -8707,7 +9096,7 @@ links." (setq end (point-max)) (setq what "top-level") (goto-char start) - (show-all))) + (outline-show-all))) (setq beg (point)) (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) @@ -8717,32 +9106,34 @@ links." re (concat "^" (regexp-quote stars) " +") re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (user-error "Region to sort contains a level above the first entry")) + (unless (equal (substring txt -1) "\n") (setq txt (concat txt "\n"))) + (when (and (not (equal stars "*")) (string-match re2 txt)) + (user-error "Region to sort contains a level above the first entry")) (unless sorting-type (message "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc - [t]ime [s]cheduled [d]eadline [c]reated - A/N/P/R/O/F/T/S/D/C means reversed:" + [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing + A/N/P/R/O/F/T/S/D/C/K means reversed:" what) - (setq sorting-type (read-char-exclusive)) - - (unless getkey-func - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func)))) - - (and (= (downcase sorting-type) ?r) - (not property) - (setq property - (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) - + (setq sorting-type (read-char-exclusive))) + + (unless getkey-func + (and (= (downcase sorting-type) ?f) + (setq getkey-func + (or (and interactive? + (org-read-function + "Function for extracting keys: ")) + (error "Missing key extractor"))))) + + (and (= (downcase sorting-type) ?r) + (not property) + (setq property + (completing-read "Property: " + (mapcar #'list (org-buffer-property-keys t)) + nil t))) + + (when (member sorting-type '(?k ?K)) (org-clock-sum)) (message "Sorting entries...") (save-restriction @@ -8777,6 +9168,8 @@ links." (if (looking-at org-complex-heading-regexp) (funcall case-func (org-sort-remove-invisible (match-string 4))) nil)) + ((= dcst ?k) + (or (get-text-property (point) :org-clock-minutes) 0)) ((= dcst ?t) (let ((end (save-excursion (outline-next-heading) (point)))) (if (or (re-search-forward org-ts-regexp end t) @@ -8807,22 +9200,29 @@ links." ((= dcst ?r) (or (org-entry-get nil property) "")) ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (- 9999 (length (member (match-string 2) - org-todo-keywords-1))))) + (when (looking-at org-complex-heading-regexp) + (let* ((m (match-string 2)) + (s (if (member m org-done-keywords) '- '+))) + (- 99 (funcall s (length (member m org-todo-keywords-1))))))) ((= dcst ?f) (if getkey-func (progn (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) + (when (stringp tmp) (setq tmp (funcall case-func tmp))) tmp) (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type)))) nil (cond ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) - ((member dcst '(?p ?t ?s ?d ?c)) '<))))) + ((= dcst ?f) + (or compare-func + (and interactive? + (org-read-function + (concat "Function for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty)))) + ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))))) (run-hooks 'org-after-sorting-entries-or-items-hook) ;; Reset the clock marker if needed (when cmstr @@ -8832,60 +9232,18 @@ links." (move-marker org-clock-marker (point)))) (message "Sorting entries...done"))) -(defun org-do-sort (table what &optional with-case sorting-type) - "Sort TABLE of WHAT according to SORTING-TYPE. -The user will be prompted for the SORTING-TYPE if the call to this -function does not specify it. WHAT is only for the prompt, to indicate -what is being sorted. The sorting key will be extracted from -the car of the elements of the table. -If WITH-CASE is non-nil, the sorting will be case-sensitive." - (unless sorting-type - (message - "Sort %s: [a]lphabetic, [n]umeric, [t]ime. A/N/T means reversed:" - what) - (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun) - ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) - (lambda(x) (downcase (org-sort-remove-invisible x)))) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (if (or (string-match org-ts-regexp x) - (string-match org-ts-regexp-both x)) - (float-time - (org-time-string-to-time (match-string 0 x))) - 0)) - comparefun (if (= dcst sorting-type) '< '>))) - (t (error "Invalid sorting type `%c'" sorting-type))) - - (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) - table) - (lambda (a b) (funcall comparefun (car a) (car b)))))) - - ;;; The orgstruct minor mode ;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode structure editing commands. +;; integrate the Org mode structure editing commands. -;; This is really a hack, because the org-mode structure commands use +;; This is really a hack, because the Org mode structure commands use ;; keys which normally belong to the major mode. Here is how it ;; works: The minor mode defines all the keys necessary to operate the ;; structure commands, but wraps the commands into a function which ;; tests if the cursor is currently at a headline or a plain list ;; item. If that is the case, the structure command is used, -;; temporarily setting many Org-mode variables like regular +;; temporarily setting many Org mode variables like regular ;; expressions for filling etc. However, when any of those keys is ;; used at a different location, function uses `key-binding' to look ;; up if the key has an associated command in another currently active @@ -8917,10 +9275,10 @@ orgstruct(++)-mode." ;;;###autoload (define-minor-mode orgstruct-mode "Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if +This mode is for using Org mode structure commands in other +modes. The following keys behave as if Org mode were active, if the cursor is on a headline, or on a plain list item (both as -defined by Org-mode)." +defined by Org mode)." nil " OrgStruct" (make-sparse-keymap) (funcall (if orgstruct-mode 'add-to-invisibility-spec @@ -8937,40 +9295,38 @@ defined by Org-mode)." "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) -(defvar org-fb-vars nil) -(make-variable-buffer-local 'org-fb-vars) +(defvar-local orgstruct-is-++ nil + "Is `orgstruct-mode' in ++ version in the current-buffer?") +(defvar-local org-fb-vars nil) (defun orgstruct++-mode (&optional arg) "Toggle `orgstruct-mode', the enhanced version of it. In addition to setting orgstruct-mode, this also exports all -indentation and autofilling variables from org-mode into the +indentation and autofilling variables from Org mode into the buffer. It will also recognize item context in multiline items." (interactive "P") (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) (if (< arg 1) (progn (orgstruct-mode -1) - (mapc (lambda(v) - (org-set-local (car v) - (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) - org-fb-vars)) + (dolist (v org-fb-vars) + (set (make-local-variable (car v)) + (if (eq (car-safe (cadr v)) 'quote) + (cl-cadadr v) + (nth 1 v))))) (orgstruct-mode 1) (setq org-fb-vars nil) (unless org-local-vars (setq org-local-vars (org-get-local-variables))) (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (push (list var `(quote ,(eval var))) org-fb-vars) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars) - (org-set-local 'orgstruct-is-++ t)))) - -(defvar orgstruct-is-++ nil - "Is `orgstruct-mode' in ++ version in the current-buffer?") -(make-variable-buffer-local 'orgstruct-is-++) + (dolist (x org-local-vars) + (when (string-match + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\ +\\|fill-prefix\\|indent-\\)" + (symbol-name (car x))) + (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) + (set (make-local-variable var) + (if (eq (car-safe val) 'quote) (nth 1 val) val)))) + (setq-local orgstruct-is-++ t)))) ;;;###autoload (defun turn-on-orgstruct++ () @@ -8999,6 +9355,7 @@ buffer. It will also recognize item context in multiline items." org-ctrl-c-minus org-ctrl-c-star org-cycle + org-force-cycle-archived org-forward-heading-same-level org-insert-heading org-insert-heading-respect-content @@ -9018,6 +9375,7 @@ buffer. It will also recognize item context in multiline items." org-shifttab org-shifttab org-shiftup + org-show-children org-show-subtree org-sort org-up-element @@ -9025,8 +9383,7 @@ buffer. It will also recognize item context in multiline items." outline-next-visible-heading outline-previous-visible-heading outline-promote - outline-up-heading - show-children)) + outline-up-heading)) (let ((f (or (car-safe cell) cell)) (disable-when-heading-prefix (cdr-safe cell))) (when (fboundp f) @@ -9045,15 +9402,15 @@ buffer. It will also recognize item context in multiline items." (regexp-quote (cdr rep)) (car rep) (key-description binding))))) - (pushnew binding new-bindings :test 'equal))) + (cl-pushnew binding new-bindings :test 'equal))) (dolist (binding new-bindings) (let ((key (lookup-key orgstruct-mode-map binding))) (when (or (not key) (numberp key)) - (condition-case nil - (org-defkey orgstruct-mode-map - binding - (orgstruct-make-binding f binding disable-when-heading-prefix)) - (error nil))))))))) + (ignore-errors + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding + f binding disable-when-heading-prefix)))))))))) (run-hooks 'orgstruct-setup-hook)) (defun orgstruct-make-binding (fun key disable-when-heading-prefix) @@ -9152,9 +9509,9 @@ definitions." ;; normalize contexts (mapcar (lambda(c) (cond ((listp (cadr c)) - (list (car c) (car c) (cadr c))) + (list (car c) (car c) (nth 1 c))) ((string= "" (cadr c)) - (list (car c) (car c) (caddr c))) + (list (car c) (car c) (nth 2 c))) (t c))) contexts)) (a alist) r s) @@ -9168,7 +9525,7 @@ definitions." (setq vrules (org-contextualize-validate-key (car c) contexts))) (mapc (lambda (vr) - (when (not (equal (car vr) (cadr vr))) + (unless (equal (car vr) (cadr vr)) (setq repl vr))) vrules) (if (not repl) (push c r) @@ -9185,39 +9542,37 @@ definitions." (delete-dups (mapcar (lambda (x) (let ((tpl (car x))) - (when (not (delq - nil - (mapcar (lambda (y) - (equal y tpl)) - s))) + (unless (delq + nil + (mapcar (lambda (y) + (equal y tpl)) + s)) x))) (reverse r)))))) (defun org-contextualize-validate-key (key contexts) "Check CONTEXTS for agenda or capture KEY." - (let (rr res) + (let (res) (dolist (r contexts) - (mapc - (lambda (rr) - (when - (and (equal key (car r)) - (if (functionp rr) (funcall rr) - (or (and (eq (car rr) 'in-file) - (buffer-file-name) - (string-match (cdr rr) (buffer-file-name))) - (and (eq (car rr) 'in-mode) - (string-match (cdr rr) (symbol-name major-mode))) - (and (eq (car rr) 'in-buffer) - (string-match (cdr rr) (buffer-name))) - (when (and (eq (car rr) 'not-in-file) - (buffer-file-name)) - (not (string-match (cdr rr) (buffer-file-name)))) - (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode)))) - (when (eq (car rr) 'not-in-buffer) - (not (string-match (cdr rr) (buffer-name))))))) - (push r res))) - (car (last r)))) + (dolist (rr (car (last r))) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) + (push r res)))) (delete-dups (delq nil res)))) (defun org-context-p (&rest contexts) @@ -9235,45 +9590,47 @@ Possible values in the list of contexts are `table', `headline', and `item'." (org-in-item-p))) (goto-char pos)))) +(defconst org-unique-local-variables + '(org-element--cache + org-element--cache-objects + org-element--cache-sync-keys + org-element--cache-sync-requests + org-element--cache-sync-timer) + "List of local variables that cannot be transferred to another buffer.") + (defun org-get-local-variables () "Return a list of all local variables in an Org mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (cdr x)))) - (if (and (not (get (car x) 'org-state)) - (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x)))) - x nil)) - varlist)))) + (delq nil + (mapcar + (lambda (x) + (let* ((binding (if (symbolp x) (list x) (list (car x) (cdr x)))) + (name (car binding))) + (and (not (get name 'org-state)) + (not (memq name org-unique-local-variables)) + (string-match-p + "\\`\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|\ +auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name name)) + binding))) + (with-temp-buffer + (org-mode) + (buffer-local-variables))))) (defun org-clone-local-variables (from-buffer &optional regexp) "Clone local variables from FROM-BUFFER. Optional argument REGEXP selects variables to clone." - (mapc - (lambda (pair) - (and (symbolp (car pair)) - (or (null regexp) - (string-match regexp (symbol-name (car pair)))) - (set (make-local-variable (car pair)) - (cdr pair)))) - (buffer-local-variables from-buffer))) + (dolist (pair (buffer-local-variables from-buffer)) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (when (and (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match-p regexp (symbol-name name)))) + (set (make-local-variable name) value)))))) ;;;###autoload (defun org-run-like-in-org-mode (cmd) - "Run a command, pretending that the current buffer is in Org-mode. + "Run a command, pretending that the current buffer is in Org mode. This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively +Org mode to the values they have in Org mode, and then interactively call CMD." (org-load-modules-maybe) (unless org-local-vars @@ -9287,67 +9644,119 @@ call CMD." (eval `(let ,binds (call-interactively (quote ,cmd)))))) -;;;; Archiving - (defun org-get-category (&optional pos force-refresh) "Get the category applying to position POS." (save-match-data - (if force-refresh (org-refresh-category-properties)) + (when force-refresh (org-refresh-category-properties)) (let ((pos (or pos (point)))) (or (get-text-property pos 'org-category) (progn (org-refresh-category-properties) (get-text-property pos 'org-category)))))) -(defun org-refresh-category-properties () - "Refresh category text properties in the buffer." - (let ((case-fold-search t) - (inhibit-read-only t) - (def-cat (cond - ((null org-category) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - "???")) - ((symbolp org-category) (symbol-name org-category)) - (t org-category))) - beg end cat pos optionp) - (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (put-text-property (point) (point-max) 'org-category def-cat) - (while (re-search-forward - "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) - (setq pos (match-end 0) - optionp (equal (char-after (match-beginning 0)) ?#) - cat (org-trim (match-string 2))) - (if optionp - (setq beg (point-at-bol) end (point-max)) - (org-back-to-heading t) - (setq beg (point) end (org-end-of-subtree t t))) - (put-text-property beg end 'org-category cat) - (put-text-property beg end 'org-category-position beg) - (goto-char pos))))))) +;;; Refresh properties (defun org-refresh-properties (dprop tprop) "Refresh buffer text properties. -DPROP is the drawer property and TPROP is the corresponding text -property to set." - (let ((case-fold-search t) - (inhibit-read-only t) p) +DPROP is the drawer property and TPROP is either the +corresponding text property to set, or an alist with each element +being a text property (as a symbol) and a function to apply to +the value of the drawer property." + (let* ((case-fold-search t) + (inhibit-read-only t) + (inherit? (org-property-inherit-p dprop)) + (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) + (global (and inherit? (org--property-global-value dprop nil)))) (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) - (setq p (org-match-string-no-properties 1)) - (save-excursion - (org-back-to-heading t) - (put-text-property - (point-at-bol) (or (outline-next-heading) (point-max)) tprop p)))))))) + (org-with-point-at 1 + ;; Set global values (e.g., values defined through + ;; "#+PROPERTY:" keywords) to the whole buffer. + (when global (put-text-property (point-min) (point-max) tprop global)) + ;; Set local values. + (while (re-search-forward property-re nil t) + (when (org-at-property-p) + (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) + (outline-next-heading)))))) + +(defun org-refresh-property (tprop p &optional inherit) + "Refresh the buffer text property TPROP from the drawer property P. +The refresh happens only for the current headline, or the whole +sub-tree if optional argument INHERIT is non-nil." + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (let ((start (point)) + (end (save-excursion + (if inherit (org-end-of-subtree t t) + (or (outline-next-heading) (point-max)))))) + (if (symbolp tprop) + ;; TPROP is a text property symbol. + (put-text-property start end tprop p) + ;; TPROP is an alist with (property . function) elements. + (pcase-dolist (`(,prop . ,f) tprop) + (put-text-property start end prop (funcall f p)))))))) +(defun org-refresh-category-properties () + "Refresh category text properties in the buffer." + (let ((case-fold-search t) + (inhibit-read-only t) + (default-category + (cond ((null org-category) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + "???")) + ((symbolp org-category) (symbol-name org-category)) + (t org-category)))) + (org-with-silent-modifications + (org-with-wide-buffer + ;; Set buffer-wide category. Search last #+CATEGORY keyword. + ;; This is the default category for the buffer. If none is + ;; found, fall-back to `org-category' or buffer file name. + (put-text-property + (point-min) (point-max) + 'org-category + (catch 'buffer-category + (goto-char (point-max)) + (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (throw 'buffer-category + (org-element-property :value element))))) + default-category)) + ;; Set sub-tree specific categories. + (goto-char (point-min)) + (let ((regexp (org-re-property "CATEGORY"))) + (while (re-search-forward regexp nil t) + (let ((value (match-string-no-properties 3))) + (when (org-at-property-p) + (put-text-property + (save-excursion (org-back-to-heading t) (point)) + (save-excursion (org-end-of-subtree t t) (point)) + 'org-category + value))))))))) + +(defun org-refresh-stats-properties () + "Refresh stats text properties in the buffer." + (org-with-silent-modifications + (org-with-point-at 1 + (let ((regexp (concat org-outline-regexp-bol + ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) + (while (re-search-forward regexp nil t) + (let* ((numerator (string-to-number (match-string 1))) + (denominator (and (match-end 2) + (string-to-number (match-string 2)))) + (stats (cond ((not denominator) numerator) ;percent + ((= denominator 0) 0) + (t (/ (* numerator 100) denominator))))) + (put-text-property (point) (progn (org-end-of-subtree t t) (point)) + 'org-stats stats))))))) + +(defun org-refresh-effort-properties () + "Refresh effort properties" + (org-refresh-properties + org-effort-property + '((effort . identity) + (effort-minutes . org-duration-string-to-minutes)))) ;;;; Link Stuff @@ -9387,78 +9796,54 @@ property to set." (defvar org-store-link-plist nil "Plist with info about the most recently link created with `org-store-link'.") -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") +(defun org-store-link-functions () + "Return a list of functions that are called to create and store a link. +The functions defined in the :store property of +`org-link-parameters'. -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for creating -this link (for example by looking at the major mode). -If not, it must exit and return nil. -If yes, it should return a non-nil value after a calling -`org-store-link-props' with a list of properties and values. -Special properties are: +value. Each function should check if it is responsible for +creating this link (for example by looking at the major mode). +If not, it must exit and return nil. If yes, it should return +a non-nil value after calling `org-store-link-props' with a list +of properties and values. Special properties are: :type The link prefix, like \"http\". This must be given. :link The link, like \"http://www.astro.uva.nl/~dominik\". This is obligatory as well. :description Optional default description for the second pair - of brackets in an Org-mode link. The user can still change - this when inserting this link into an Org-mode buffer. + of brackets in an Org mode link. The user can still change + this when inserting this link into an Org mode buffer. In addition to these, any additional properties can be specified -and then used in capture templates.") - -(defun org-add-link-type (type &optional follow export) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' - -FOLLOW and EXPORT are two functions. - -FOLLOW should take the link path as the single argument and do whatever -is necessary to follow the link, for example find a file or display -a mail message. - -EXPORT should format the link path for export to one of the export formats. -It should be a function accepting three arguments: - - path the path of the link, the text after the prefix (like \"http:\") - desc the description of the link, if any, or a description added by - org-export-normalize-links if there is none - format the export format, a symbol like `html' or `latex' or `ascii'.. - -The function may use the FORMAT information to return different values -depending on the format. The return value will be put literally into -the exported file. If the return value is nil, this means Org should -do what it normally does with links which do not have EXPORT defined. - -Org-mode has a built-in default for exporting links. If you are happy with -this default, there is no need to define an export function for the link -type. For a simple example of an export function, see `org-bbdb.el'." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (if (assoc type org-link-protocols) - (setcdr (assoc type org-link-protocols) (list follow export)) - (push (list type follow export) org-link-protocols))) +and then used in capture templates." + (cl-loop for link in org-link-parameters + with store-func + do (setq store-func (org-link-get-parameter (car link) :store)) + if store-func + collect store-func)) (defvar org-agenda-buffer-name) ; Defined in org-agenda.el (defvar org-id-link-to-org-use-id) ; Defined in org-id.el ;;;###autoload (defun org-store-link (arg) - "\\Store an org-link to the current location. + "Store an org-link to the current location. +\\ This link is added to `org-stored-links' and can later be inserted -into an org-buffer with \\[org-insert-link]. +into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a prefix arg is interpreted. -For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \ +A single +`\\[universal-argument]' negates `org-context-in-file-links' for file links or +`org-gnus-prefer-web-links' for links to Usenet articles. -A double prefix arg force skipping storing functions that are not -part of Org's core. +A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \ +skipping storing functions that are not +part of Org core. -A triple prefix arg force storing a link for each line in the +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix ARG forces storing a link for each line in the active region." (interactive "P") (org-load-modules-maybe) @@ -9473,111 +9858,111 @@ active region." (call-interactively 'org-store-link)) (move-beginning-of-line 2) (set-mark (point))))) - (org-with-limited-levels - (setq org-store-link-plist nil) - (let (link cpltxt desc description search - txt custom-id agenda-link sfuns sfunsn) - (cond + (setq org-store-link-plist nil) + (let (link cpltxt desc description search + txt custom-id agenda-link sfuns sfunsn) + (cond - ;; Store a link using an external link type - ((and (not (equal arg '(16))) - (setq sfuns - (delq - nil (mapcar (lambda (f) - (let (fs) (if (funcall f) (push f fs)))) - org-store-link-functions)) - sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) - (or (and (cdr sfuns) - (funcall (intern - (completing-read - "Which function for creating the link? " - sfunsn nil t (car sfunsn))))) - (funcall (caar sfuns))) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist - :description) - link)))) - - ;; Store a link from a source code buffer - ((org-src-edit-buffer-p) - (let (label gc) - (while (or (not label) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t)))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line 1) - (setq link (format org-coderef-label-format label)) - (setq gc (- 79 (length link))) - (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) - (insert link) - (setq link (concat "(" label ")") desc nil))) - - ;; We are in the agenda, link to referenced location - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (org-called-interactively-p 'any) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (url-view-url t)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) - (org-store-link-props :type "image" :file buffer-file-name)) - - ;; In dired, store a link to the file of the current line - ((eq major-mode 'dired-mode) - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + ;; Store a link using an external link type + ((and (not (equal arg '(16))) + (setq sfuns + (delq + nil (mapcar (lambda (f) + (let (fs) (if (funcall f) (push f fs)))) + (org-store-link-functions))) + sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) + (or (and (cdr sfuns) + (funcall (intern + (completing-read + "Which function for creating the link? " + sfunsn nil t (car sfunsn))))) + (funcall (caar sfuns))) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist + :description) + link)))) + + ;; Store a link from a source code buffer. + ((org-src-edit-buffer-p) + (let ((coderef-format (org-src-coderef-format))) + (cond ((save-excursion + (beginning-of-line) + (looking-at (org-src-coderef-regexp coderef-format))) + (setq link (format "(%s)" (match-string-no-properties 3)))) + ((called-interactively-p 'any) + (let ((label (read-string "Code line label: "))) + (end-of-line) + (setq link (format coderef-format label)) + (let ((gc (- 79 (length link)))) + (if (< (current-column) gc) + (org-move-to-column gc t) + (insert " "))) + (insert link) + (setq link (concat "(" label ")")) + (setq desc nil))) + (t (setq link nil))))) + + ;; We are in the agenda, link to referenced location + ((equal (bound-and-true-p org-agenda-buffer-name) (buffer-name)) + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (url-view-url t)) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link cpltxt) + (org-store-link-props :type "image" :file buffer-file-name)) + + ;; In dired, store a link to the file of the current line + ((derived-mode-p 'dired-mode) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link cpltxt))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (org-with-limited-levels (setq custom-id (org-entry-get nil "CUSTOM_ID")) (cond ;; Store a link using the target at point @@ -9590,7 +9975,7 @@ active region." link cpltxt)) ((and (featurep 'org-id) (or (eq org-id-link-to-org-use-id t) - (and (org-called-interactively-p 'any) + (and (called-interactively-p 'any) (or (eq org-id-link-to-org-use-id 'create-if-interactive) (and (eq org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id) @@ -9613,15 +9998,13 @@ active region." (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - (let* ((ee (org-element-at-point)) - (et (org-element-type ee)) - (ev (plist-get (cadr ee) :value)) - (ek (plist-get (cadr ee) :key)) - (eok (and (stringp ek) (string-match "name" ek)))) + (when (org-xor org-context-in-file-links + (equal arg '(4))) + (let* ((element (org-element-at-point)) + (name (org-element-property :name element))) (setq txt (cond ((org-at-heading-p) nil) - ((and (eq et 'keyword) eok) ev) + (name) ((org-region-active-p) (buffer-substring (region-beginning) (region-end))))) (when (or (null txt) (string-match "\\S-" txt)) @@ -9630,74 +10013,80 @@ active region." (condition-case nil (org-make-org-heading-search-string txt) (error ""))) - desc (or (and (eq et 'keyword) eok ev) + desc (or name (nth 4 (ignore-errors (org-heading-components))) "NONE"))))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link cpltxt)))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string. - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link cpltxt)) - - ((org-called-interactively-p 'interactive) - (user-error "No method for storing a link from this buffer")) - - (t (setq link nil))) - - ;; We're done setting link and desc, clean up - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (cond ((equal desc "NONE") (setq desc nil)) - ((and desc (string-match org-bracket-link-analytic-regexp desc)) - (let ((d0 (match-string 3 desc)) - (p0 (match-string 5 desc))) - (setq desc - (replace-regexp-in-string - org-bracket-link-regexp - (concat (or p0 d0) - (if (equal (length (match-string 0 desc)) - (length desc)) "*" "")) desc))))) - - ;; Return the link - (if (not (and (or (org-called-interactively-p 'any) - executing-kbd-macro) - link)) - (or agenda-link (and link (org-make-link-string link desc))) - (push (list link desc) org-stored-links) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name - (buffer-file-name)) "::#" custom-id)) - (push (list link desc) org-stored-links)) - (car org-stored-links)))))) + (when (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link cpltxt))))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context string. + (when (org-xor org-context-in-file-links + (equal arg '(4))) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link cpltxt)) + + ((called-interactively-p 'interactive) + (user-error "No method for storing a link from this buffer")) + + (t (setq link nil))) + + ;; We're done setting link and desc, clean up + (when (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (cond ((not desc)) + ((equal desc "NONE") (setq desc nil)) + (t (setq desc + (replace-regexp-in-string + org-bracket-link-analytic-regexp + (lambda (m) (or (match-string 5 m) (match-string 3 m))) + desc)))) + ;; Return the link + (if (not (and (or (called-interactively-p 'any) + executing-kbd-macro) + link)) + (or agenda-link (and link (org-make-link-string link desc))) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name + (buffer-file-name)) "::#" custom-id)) + (push (list link desc) org-stored-links)) + (car org-stored-links))))) (defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :fromname (car adr))) - (setq plist (plist-put plist :fromaddress (nth 1 adr)))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :toname (car adr))) - (setq plist (plist-put plist :toaddress (nth 1 adr))))) + "Store link properties, extract names, addresses and dates." + (let ((x (plist-get plist :from))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :fromname (car adr))) + (setq plist (plist-put plist :fromaddress (nth 1 adr)))))) + (let ((x (plist-get plist :to))) + (when x + (let ((adr (mail-extract-address-components x))) + (setq plist (plist-put plist :toname (car adr))) + (setq plist (plist-put plist :toaddress (nth 1 adr)))))) + (let ((x (ignore-errors (date-to-time (plist-get plist :date))))) + (when x + (setq plist (plist-put plist :date-timestamp + (format-time-string + (org-time-stamp-format t) x))) + (setq plist (plist-put plist :date-timestamp-inactive + (format-time-string + (org-time-stamp-format t t) x))))) (let ((from (plist-get plist :from)) (to (plist-get plist :to))) (when (and from to org-from-is-user-regexp) @@ -9763,45 +10152,34 @@ according to FMT (default from `org-email-link-description-format')." (defun org-make-link-string (link &optional description) "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (string-match "\\S-" link) - (error "Empty link")) - (when (and description - (stringp description) - (not (string-match "\\S-" description))) - (setq description nil)) - (when (stringp description) - ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[" description) - (setq description (replace-match "{" t t description))) - (while (string-match "\\]" description) - (setq description (replace-match "}" t t description)))) - (when (equal link description) - ;; No description needed, it is identical - (setq description nil)) - (when (and (not description) - (not (string-match (org-image-file-name-regexp) link)) - (not (equal link (org-link-escape link)))) - (setq description (org-extract-attributes link))) - (setq link - (cond ((string-match (org-image-file-name-regexp) link) link) - ((string-match org-link-types-re link) - (concat (match-string 1 link) - (org-link-escape (substring link (match-end 1))))) - (t (org-link-escape link)))) - (concat "[[" link "]" - (if description (concat "[" description "]") "") - "]")) + (unless (org-string-nw-p link) (error "Empty link")) + (let ((uri (cond ((string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1))))) + ;; For readability, url-encode internal links only + ;; when absolutely needed (i.e, when they contain + ;; square brackets). File links however, are + ;; encoded since, e.g., spaces are significant. + ((or (file-name-absolute-p link) + (string-match-p "\\`\\.\\.?/\\|[][]" link)) + (org-link-escape link)) + (t link))) + (description + (and (org-string-nw-p description) + ;; Remove brackets from description, as they are fatal. + (replace-regexp-in-string + "[][]" (lambda (m) (if (equal "[" m) "{" "}")) + (org-trim description))))) + (format "[[%s]%s]" + uri + (if description (format "[%s]" description) "")))) (defconst org-link-escape-chars - '(?\ ?\[ ?\] ?\; ?\= ?\+) - "List of characters that should be escaped in link. + ;;%20 %5B %5D %25 + '(?\s ?\[ ?\] ?%) + "List of characters that should be escaped in a link when stored to Org. This is the list that is used for internal purposes.") -(defconst org-link-escape-chars-browser - '(?\ ?\") - "List of escapes for characters that are problematic in links. -This is the list that is used before handing over to the browser.") - (defun org-link-escape (text &optional table merge) "Return percent escaped representation of TEXT. TEXT is a string with the text to escape. @@ -9809,35 +10187,29 @@ Optional argument TABLE is a list with characters that should be escaped. When nil, `org-link-escape-chars' is used. If optional argument MERGE is set, merge TABLE into `org-link-escape-chars'." - (cond - ((and table merge) - (mapc (lambda (defchr) - (unless (member defchr table) - (setq table (cons defchr table)))) org-link-escape-chars)) - ((null table) - (setq table org-link-escape-chars))) - (mapconcat - (lambda (char) - (if (or (member char table) - (and (or (< char 32) (= char 37) (> char 126)) - org-url-hexify-p)) - (mapconcat (lambda (sequence-element) - (format "%%%.2X" sequence-element)) - (or (encode-coding-char char 'utf-8) - (error "Unable to percent escape character: %s" - (char-to-string char))) "") - (char-to-string char))) text "")) + (let ((characters-to-encode + (cond ((null table) org-link-escape-chars) + (merge (append org-link-escape-chars table)) + (t table)))) + (mapconcat + (lambda (c) + (if (or (memq c characters-to-encode) + (and org-url-hexify-p (or (< c 32) (> c 126)))) + (mapconcat (lambda (e) (format "%%%.2X" e)) + (or (encode-coding-char c 'utf-8) + (error "Unable to percent escape character: %c" c)) + "") + (char-to-string c))) + text ""))) (defun org-link-unescape (str) - "Unhex hexified Unicode strings as returned from the JavaScript function -encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut." - (unless (and (null str) (string= "" str)) - (let ((pos 0) (case-fold-search t) unhexed) - (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos)) - (setq unhexed (org-link-unescape-compound (match-string 0 str))) - (setq str (replace-match unhexed t t str)) - (setq pos (+ pos (length unhexed)))))) - str) + "Unhex hexified Unicode parts in string STR. +E.g. `%C3%B6' becomes the german o-Umlaut. This is the +reciprocal of `org-link-escape', which see." + (if (org-string-nw-p str) + (replace-regexp-in-string + "\\(%[0-9A-Za-z]\\{2\\}\\)+" #'org-link-unescape-compound str t t) + str)) (defun org-link-unescape-compound (hex) "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut. @@ -9860,18 +10232,17 @@ Note: this function also decodes single byte encodings like ((>= val 192) (cons 2 192)) (t (cons 0 0))) (cons 6 128)))) - (if (>= val 192) (setq eat (car shift-xor))) + (when (>= val 192) (setq eat (car shift-xor))) (setq val (logxor val (cdr shift-xor))) (setq sum (+ (lsh sum (car shift-xor)) val)) - (if (> eat 0) (setq eat (- eat 1))) + (when (> eat 0) (setq eat (- eat 1))) (cond ((= 0 eat) ;multi byte - (setq ret (concat ret (org-char-to-string sum))) + (setq ret (concat ret (char-to-string sum))) (setq sum 0)) ((not bytes) ; single byte(s) - (setq ret (org-link-unescape-single-byte-sequence hex)))) - )) ;; end (while bytes - ret ))) + (setq ret (org-link-unescape-single-byte-sequence hex)))))) + ret))) (defun org-link-unescape-single-byte-sequence (hex) "Unhexify hex-encoded single byte character sequences." @@ -9901,28 +10272,47 @@ Note: this function also decodes single byte encodings like (defun org-link-prettify (link) "Return a human-readable representation of LINK. -The car of LINK must be a raw link the cdr of LINK must be either -a link description or nil." +The car of LINK must be a raw link. +The cdr of LINK must be either a link description or nil." (let ((desc (or (cadr link) ""))) (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) "<" (car link) ">"))) ;;;###autoload (defun org-insert-link-global () - "Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax." + "Insert a link like Org mode does. +This command can be called in any mode to insert a link in Org syntax." (interactive) (org-load-modules-maybe) (org-run-like-in-org-mode 'org-insert-link)) -(defun org-insert-all-links (&optional keep) - "Insert all links in `org-stored-links'." +(defun org-insert-all-links (arg &optional pre post) + "Insert all links in `org-stored-links'. +When a universal prefix, do not delete the links from `org-stored-links'. +When `ARG' is a number, insert the last N link(s). +`PRE' and `POST' are optional arguments to define a string to +prepend or to append." (interactive "P") - (let ((links (copy-sequence org-stored-links)) l) - (while (setq l (if keep (pop links) (pop org-stored-links))) - (insert "- ") - (org-insert-link nil (car l) (or (cadr l) "")) - (insert "\n")))) + (let ((org-keep-stored-link-after-insertion (equal arg '(4))) + (links (copy-sequence org-stored-links)) + (pr (or pre "- ")) + (po (or post "\n")) + (cnt 1) l) + (if (null org-stored-links) + (message "No link to insert") + (while (and (or (listp arg) (>= arg cnt)) + (setq l (if (listp arg) + (pop links) + (pop org-stored-links)))) + (setq cnt (1+ cnt)) + (insert pr) + (org-insert-link nil (car l) (or (cadr l) "")) + (insert po))))) + +(defun org-insert-last-stored-link (arg) + "Insert the last link stored in `org-stored-links'." + (interactive "p") + (org-insert-all-links arg "" "\n")) (defun org-link-fontify-links-to-this-file () "Fontify links to the current file in `org-stored-links'." @@ -9946,73 +10336,73 @@ This command can be called in any mode to insert a link in Org-mode syntax." (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) (delq nil (append a b))))) -(defvar org-link-links-in-this-file nil) +(defvar org--links-history nil) (defun org-insert-link (&optional complete-file link-location default-description) "Insert a link. At the prompt, enter the link. -Completion can be used to insert any of the link protocol prefixes like -http or ftp in use. +Completion can be used to insert any of the link protocol prefixes in use. The history can be used to select a link previously stored with `org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. +press `RET' at the prompt), the link defaults to the most recently +stored link. As `SPC' triggers completion in the minibuffer, you need to +use `M-SPC' or `C-q SPC' to force the insertion of a space character. You will also be prompted for a description, and if one is given, it will be displayed in the buffer instead of the link. -If there is already a link at point, this command will allow you to edit link -and description parts. +If there is already a link at point, this command will allow you to edit +link and description parts. -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can -be selected using completion. The path to the file will be relative to the +With a `\\[universal-argument]' prefix, prompts for a file to link to. The \ +file name can be +selected using completion. The path to the file will be relative to the current directory if the file is in the current directory or a subdirectory. Otherwise, the link will be the absolute path as completed in the minibuffer \(i.e. normally ~/path/to/file). You can configure this behavior using the option `org-link-file-path-type'. -With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in +With a `\\[universal-argument] \\[universal-argument]' prefix, enforce an \ +absolute path even if the file is in the current directory or below. -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'. +A `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix negates `org-keep-stored-link-after-insertion'. If `org-make-link-description-function' is non-nil, this function will be called with the link target, and the result will be the default link description. -If the LINK-LOCATION parameter is non-nil, this value will be -used as the link location instead of reading one interactively. +If the LINK-LOCATION parameter is non-nil, this value will be used as +the link location instead of reading one interactively. -If the DEFAULT-DESCRIPTION parameter is non-nil, this value will -be used as the default description." +If the DEFAULT-DESCRIPTION parameter is non-nil, this value will be used +as the default description." (interactive "P") (let* ((wcf (current-window-configuration)) (origbuf (current-buffer)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) + (region (when (org-region-active-p) + (buffer-substring (region-beginning) (region-end)))) (remove (and region (list (region-beginning) (region-end)))) (desc region) - tmphist ; byte-compile incorrectly complains about this (link link-location) (abbrevs org-link-abbrev-alist-local) - entry file all-prefixes auto-desc) + entry all-prefixes auto-desc) (cond - (link-location) ; specified by arg, just use it. + (link-location) ; specified by arg, just use it. ((org-in-regexp org-bracket-link-regexp 1) ;; We do have a link at point, and we are going to edit it. (setq remove (list (match-beginning 0) (match-end 0))) - (setq desc (if (match-end 3) (org-match-string-no-properties 3))) + (setq desc (when (match-end 3) (match-string-no-properties 3))) (setq link (read-string "Link: " (org-link-unescape - (org-match-string-no-properties 1))))) + (match-string-no-properties 1))))) ((or (org-in-regexp org-angle-link-re) (org-in-regexp org-plain-link-re)) ;; Convert to bracket link (setq remove (list (match-beginning 0) (match-end 0)) link (read-string "Link: " - (org-remove-angle-brackets (match-string 0))))) + (org-unbracket-string "<" ">" (match-string 0))))) ((member complete-file '((4) (16))) ;; Completing read for file names. (setq link (org-file-complete-link complete-file))) @@ -10035,92 +10425,91 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (unless (pos-visible-in-window-p (point-max)) (org-fit-window-to-buffer)) (and (window-live-p cw) (select-window cw))) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) (setq all-prefixes (append (mapcar 'car abbrevs) (mapcar 'car org-link-abbrev-alist) - org-link-types)) + (org-link-types))) (unwind-protect - (progn + ;; Fake a link history, containing the stored links. + (let ((org--links-history + (append (mapcar #'car org-stored-links) + org-insert-link-history))) (setq link (org-completing-read "Link: " (append - (mapcar (lambda (x) (concat x ":")) - all-prefixes) - (mapcar 'car org-stored-links)) + (mapcar (lambda (x) (concat x ":")) all-prefixes) + (mapcar #'car org-stored-links)) nil nil nil - 'tmphist + 'org--links-history (caar org-stored-links))) - (if (not (string-match "\\S-" link)) - (user-error "No link selected")) - (mapc (lambda(l) - (when (equal link (cadr l)) (setq link (car l) auto-desc t))) - org-stored-links) - (if (or (member link all-prefixes) - (and (equal ":" (substring link -1)) - (member (substring link 0 -1) all-prefixes) - (setq link (substring link 0 -1)))) - (setq link (with-current-buffer origbuf - (org-link-try-special-completion link))))) + (unless (org-string-nw-p link) (user-error "No link selected")) + (dolist (l org-stored-links) + (when (equal link (cadr l)) + (setq link (car l)) + (setq auto-desc t))) + (when (or (member link all-prefixes) + (and (equal ":" (substring link -1)) + (member (substring link 0 -1) all-prefixes) + (setq link (substring link 0 -1)))) + (setq link (with-current-buffer origbuf + (org-link-try-special-completion link))))) (set-window-configuration wcf) (kill-buffer "*Org Links*")) (setq entry (assoc link org-stored-links)) (or entry (push link org-insert-link-history)) (setq desc (or desc (nth 1 entry))))) - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) + (when (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) - (if (and (string-match org-plain-link-re link) - (not (string-match org-ts-regexp link))) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-remove-angle-brackets link))) + (when (and (string-match org-plain-link-re link) + (not (string-match org-ts-regexp link))) + ;; URL-like link, normalize the use of angular brackets. + (setq link (org-unbracket-string "<" ">" link))) ;; Check if we are linking to the current file with a search ;; option If yes, simplify the link by using only the search ;; option. (when (and buffer-file-name - (string-match "^file:\\(.+?\\)::\\(.+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) + (let ((case-fold-search nil)) + (string-match "\\`file:\\(.+?\\)::" link))) + (let ((path (match-string-no-properties 1 link)) + (search (substring-no-properties link (match-end 0)))) (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) + (when (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) - (let* ((type (match-string 1 link)) - (path (match-string 2 link)) - (origpath path) - (case-fold-search nil)) - (cond - ((or (eq org-link-file-path-type 'absolute) - (equal complete-file '(16))) - (setq path (abbreviate-file-name (expand-file-name path)))) - ((eq org-link-file-path-type 'noabbrev) - (setq path (expand-file-name path))) - ((eq org-link-file-path-type 'relative) - (setq path (file-relative-name path))) - (t - (save-match-data - (if (string-match (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory - default-directory)))) - (expand-file-name path)) - ;; We are linking a file with relative path name. - (setq path (substring (expand-file-name path) - (match-end 0))) - (setq path (abbreviate-file-name (expand-file-name path))))))) - (setq link (concat type path)) - (if (equal desc origpath) - (setq desc path)))) + (let ((case-fold-search nil)) + (when (string-match "\\`\\(file\\|docview\\):" link) + (let* ((type (match-string-no-properties 0 link)) + (path (substring-no-properties link (match-end 0))) + (origpath path)) + (cond + ((or (eq org-link-file-path-type 'absolute) + (equal complete-file '(16))) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory + default-directory)))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))) + (setq path (abbreviate-file-name (expand-file-name path))))))) + (setq link (concat type path)) + (when (equal desc origpath) + (setq desc path))))) (if org-make-link-description-function (setq desc @@ -10135,49 +10524,36 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (read-string "Description: " desc))))) (unless (string-match "\\S-" desc) (setq desc nil)) - (if remove (apply 'delete-region remove)) - (insert (org-make-link-string link desc)))) + (when remove (apply 'delete-region remove)) + (insert (org-make-link-string link desc)) + ;; Redisplay so as the new link has proper invisible characters. + (sit-for 0))) (defun org-link-try-special-completion (type) "If there is completion support for link type TYPE, offer it." - (let ((fun (intern (concat "org-" type "-complete-link")))) + (let ((fun (org-link-get-parameter type :complete))) (if (functionp fun) (funcall fun) (read-string "Link (no completion support): " (concat type ":"))))) (defun org-file-complete-link (&optional arg) "Create a file link using completion." - (let (file link) - (setq file (org-iread-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal arg '(16)) - (setq link (concat - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (concat "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (concat - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (concat "file:" file))))) - link)) - -(defun org-iread-file-name (&rest args) - "Read-file-name using `ido-mode' speedup if available. -ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. -See `read-file-name' for a description of parameters." - (org-without-partial-completion - (if (and org-completion-use-ido - (fboundp 'ido-read-file-name) - (boundp 'ido-mode) ido-mode - (listp (second args))) - (let ((ido-enter-matching-directory nil)) - (apply 'ido-read-file-name args)) - (apply 'read-file-name args)))) + (let ((file (read-file-name "File: ")) + (pwd (file-name-as-directory (expand-file-name "."))) + (pwd1 (file-name-as-directory (abbreviate-file-name + (expand-file-name "."))))) + (cond ((equal arg '(16)) + (concat "file:" + (abbreviate-file-name (expand-file-name file)))) + ((string-match + (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) + (concat "file:" (match-string 1 file))) + ((string-match + (concat "^" (regexp-quote pwd) "\\(.+\\)") + (expand-file-name file)) + (concat "file:" + (match-string 1 (expand-file-name file)))) + (t (concat "file:" file))))) (defun org-completing-read (&rest args) "Completing-read with SPACE being a normal character." @@ -10186,58 +10562,9 @@ See `read-file-name' for a description of parameters." (copy-keymap minibuffer-local-completion-map))) (org-defkey minibuffer-local-completion-map " " 'self-insert-command) (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) - (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive) - (apply 'org-icompleting-read args))) - -(defun org-completing-read-no-i (&rest args) - (let (org-completion-use-ido org-completion-use-iswitchb) - (apply 'org-completing-read args))) - -(defun org-iswitchb-completing-read (prompt choices &rest args) - "Use iswitch as a completing-read replacement to choose from choices. -PROMPT is a string to prompt with. CHOICES is a list of strings to choose -from." - (let* ((iswitchb-use-virtual-buffers nil) - (iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist choices)))) - (iswitchb-read-buffer prompt))) - -(defun org-icompleting-read (&rest args) - "Completing-read using `ido-mode' or `iswitchb' speedups if available." - (org-without-partial-completion - (if (and org-completion-use-ido - (fboundp 'ido-completing-read) - (boundp 'ido-mode) ido-mode - (listp (second args))) - (let ((ido-enter-matching-directory nil)) - (apply 'ido-completing-read (concat (car args)) - (if (consp (car (nth 1 args))) - (mapcar 'car (nth 1 args)) - (nth 1 args)) - (cddr args))) - (if (and org-completion-use-iswitchb - (boundp 'iswitchb-mode) iswitchb-mode - (listp (second args))) - (apply 'org-iswitchb-completing-read (concat (car args)) - (if (consp (car (nth 1 args))) - (mapcar 'car (nth 1 args)) - (nth 1 args)) - (cddr args)) - (apply 'completing-read args))))) - -(defun org-extract-attributes (s) - "Extract the attributes cookie from a string and set as text property." - (let (a attr (start 0) key value) - (save-match-data - (when (string-match "{{\\([^}]+\\)}}$" s) - (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) - (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) - (setq key (match-string 1 a) value (match-string 2 a) - start (match-end 0) - attr (plist-put attr (intern key) value)))) - (org-add-props s nil 'org-attr attr)) - s)) + (org-defkey minibuffer-local-completion-map (kbd "C-c !") + 'org-time-stamp-inactive) + (apply #'completing-read args))) ;;; Opening/following a link @@ -10257,8 +10584,8 @@ handle this as a special case. When the function does handle the link, it must return a non-nil value. If it decides that it is not responsible for this link, it must return -nil to indicate that that Org-mode can continue with other options -like exact and fuzzy text search.") +nil to indicate that that Org can continue with other options like +exact and fuzzy text search.") (defun org-next-link (&optional search-backward) "Move forward to the next link. @@ -10270,7 +10597,7 @@ If the link is in hidden text, expose it." (setq org-link-search-failed nil) (let* ((pos (point)) (ct (org-context)) - (a (assoc :link ct)) + (a (assq :link ct)) (srch-fun (if search-backward 're-search-backward 're-search-forward))) (cond (a (goto-char (nth (if search-backward 1 2) a))) ((looking-at org-any-link-re) @@ -10279,7 +10606,7 @@ If the link is in hidden text, expose it." (if (funcall srch-fun org-any-link-re nil t) (progn (goto-char (match-beginning 0)) - (if (outline-invisible-p) (org-show-context))) + (when (org-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) (message "No further link found")))) @@ -10292,14 +10619,9 @@ If the link is in hidden text, expose it." (defun org-translate-link (s) "Translate a link string if a translation function has been defined." - (if (and org-link-translation-function - (fboundp org-link-translation-function) - (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) - (progn - (setq s (funcall org-link-translation-function - (match-string 1 s) (match-string 2 s))) - (concat (car s) ":" (cdr s))) - s)) + (with-temp-buffer + (insert (org-trim s)) + (org-trim (org-element-interpret-data (org-element-context))))) (defun org-translate-link-from-planner (type path) "Translate a link from Emacs Planner syntax so that Org can follow it. @@ -10319,7 +10641,7 @@ This is still an experimental function, your mileage may vary." ;; A typical message link. Planner has the id after the final slash, ;; we separate it with a hash mark (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path)))))) + (org-unbracket-string "<" ">" (match-string 2 path)))))) (cons type path)) (defun org-find-file-at-mouse (ev) @@ -10333,28 +10655,32 @@ This is still an experimental function, your mileage may vary." See the docstring of `org-open-file' for details." (interactive "e") (mouse-set-point ev) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) + (when (eq major-mode 'org-agenda-mode) + (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) (org-open-at-point)) (defvar org-window-config-before-follow-link nil "The window configuration before following a link. This is saved in case the need arises to restore it.") -(defvar org-open-link-marker (make-marker) - "Marker pointing to the location where `org-open-at-point' was called.") - ;;;###autoload (defun org-open-at-point-global () - "Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax." + "Follow a link or time-stamp like Org mode does. +This command can be called in any mode to follow an external link +or a time-stamp that has Org mode syntax. Its behavior is +undefined when called on internal links (e.g., fuzzy links). +Raise an error when there is nothing to follow. " (interactive) - (org-run-like-in-org-mode 'org-open-at-point)) + (cond ((org-in-regexp org-any-link-re) + (org-open-link-from-string (match-string-no-properties 0))) + ((or (org-in-regexp org-ts-regexp-both nil t) + (org-in-regexp org-tsr-regexp-both nil t)) + (org-follow-timestamp-link)) + (t (user-error "No link found")))) ;;;###autoload (defun org-open-link-from-string (s &optional arg reference-buffer) - "Open a link in the string S, as if it was in Org-mode." + "Open a link in the string S, as if it was in Org mode." (interactive "sLink: \nP") (let ((reference-buffer (or reference-buffer (current-buffer)))) (with-temp-buffer @@ -10375,267 +10701,240 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") -(defvar org-link-search-inhibit-query nil) ;; dynamically scoped -(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el +(defvar org-link-search-inhibit-query nil) +(defvar clean-buffer-list-kill-buffer-names) ;Defined in midnight.el +(defun org--open-doi-link (path) + "Open a \"doi\" type link. +PATH is a the path to search for, as a string." + (browse-url (url-encode-url (concat org-doi-server-url path)))) + +(defun org--open-elisp-link (path) + "Open a \"elisp\" type link. +PATH is the sexp to evaluate, as a string." + (let ((cmd path)) + (if (or (and (org-string-nw-p + org-confirm-elisp-link-not-regexp) + (string-match-p org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil 'face 'org-warning)))) + (message "%s => %s" cmd + (if (eq (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (user-error "Abort")))) + +(defun org--open-help-link (path) + "Open a \"help\" type link. +PATH is a symbol name, as a string." + (pcase (intern path) + ((and (pred fboundp) variable) (describe-function variable)) + ((and (pred boundp) function) (describe-variable function)) + (name (user-error "Unknown function or variable: %s" name)))) + +(defun org--open-shell-link (path) + "Open a \"shell\" type link. +PATH is the command to execute, as a string." + (let ((buf (generate-new-buffer "*Org Shell Output*")) + (cmd path)) + (if (or (and (org-string-nw-p + org-confirm-shell-link-not-regexp) + (string-match + org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd buf) + (when (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons (buffer-name buf) + clean-buffer-list-kill-buffer-names)))) + (user-error "Abort")))) + (defun org-open-at-point (&optional arg reference-buffer) - "Open link at or after point. -If there is no link at point, this function will search forward up to -the end of the current line. -Normally, files will be opened by an appropriate application. If the -optional prefix argument ARG is non-nil, Emacs will visit the file. -With a double prefix argument, try to open outside of Emacs, in the -application the system uses for this file type." - (interactive "P") - ;; if in a code block, then open the block's results - (unless (call-interactively #'org-babel-open-src-block-result) - (org-load-modules-maybe) - (move-marker org-open-link-marker (point)) - (setq org-window-config-before-follow-link (current-window-configuration)) - (org-remove-occur-highlights nil nil t) - (cond - ((and (org-at-heading-p) - (not (org-at-timestamp-p t)) - (not (org-in-regexp - (concat org-plain-link-re "\\|" - org-bracket-link-regexp "\\|" - org-angle-link-re "\\|" - "[ \t]:[^ \t\n]+:[ \t]*$"))) - (not (get-text-property (point) 'org-linked-text))) - (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg)) - (lk0 (car lkall)) - (lk (if (stringp lk0) (list lk0) lk0)) - (lkend (cdr lkall))) - (mapcar (lambda(l) - (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point)) - lk)) - (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) - ((run-hook-with-args-until-success 'org-open-at-point-functions)) - ((and (org-at-timestamp-p t) - (not (org-in-regexp org-bracket-link-regexp))) - (org-follow-timestamp-link)) - ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) - (not (org-in-regexp org-any-link-re))) - (org-footnote-action)) - (t - (let (type path link line search (pos (point))) - (catch 'match - (save-excursion - (or (org-in-regexp org-plain-link-re) - (skip-chars-forward "^]\n\r")) - (when (org-in-regexp org-bracket-link-regexp 1) - (setq link (org-extract-attributes - (org-link-unescape (org-match-string-no-properties 1)))) - (while (string-match " *\n *" link) - (setq link (replace-match " " t t link))) - (setq link (org-link-expand-abbrev link)) - (cond - ((or (file-name-absolute-p link) - (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) - ((string-match "^help:+\\(.+\\)" link) - (setq type "help" path (match-string 1 link))) - (t (setq type "thisfile" path link))) - (throw 'match t))) - - (when (get-text-property (point) 'org-linked-text) - (setq type "thisfile" - pos (if (get-text-property (1+ (point)) 'org-linked-text) - (1+ (point)) (point)) - path (buffer-substring - (or (previous-single-property-change pos 'org-linked-text) - (point-min)) - (or (next-single-property-change pos 'org-linked-text) - (point-max))) - ;; Ensure we will search for a <<>> link, not - ;; a simple reference like <> - path (concat "<" path)) - (throw 'match t)) + "Open link, timestamp, footnote or tags at point. - (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (let ((match (org-in-regexp org-plain-link-re))) - ;; Check a plain link is not within a bracket link - (and match - (save-excursion - (save-match-data - (progn - (goto-char (car match)) - (not (org-in-regexp org-bracket-link-regexp))))))) - (let ((line_ending (save-excursion (end-of-line) (point)))) - ;; We are in a line before a plain or bracket link - (or (re-search-forward org-plain-link-re line_ending t) - (re-search-forward org-bracket-link-regexp line_ending t)))) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t))) - (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) - (setq type "tags" - path (match-string 1)) - (while (string-match ":" path) - (setq path (replace-match "+" t t path))) - (throw 'match t))) - (when (org-in-regexp "<\\([^><\n]+\\)>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t))) - (unless path - (user-error "No link found")) +When point is on a link, follow it. Normally, files will be +opened by an appropriate application. If the optional prefix +argument ARG is non-nil, Emacs will visit the file. With +a double prefix argument, try to open outside of Emacs, in the +application the system uses for this file type. - ;; switch back to reference buffer - ;; needed when if called in a temporary buffer through - ;; org-open-link-from-string - (with-current-buffer (or reference-buffer (current-buffer)) +When point is on a timestamp, open the agenda at the day +specified. - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) - (if (and org-link-translation-function - (fboundp org-link-translation-function)) - ;; Check if we need to translate the link - (let ((tmp (funcall org-link-translation-function type path))) - (setq type (car tmp) path (cdr tmp)))) +When point is a footnote definition, move to the first reference +found. If it is on a reference, move to the associated +definition. - (cond +When point is on a headline, display a list of every link in the +entry, so it is possible to pick one, or all, of them. If point +is on a tag, call `org-tags-view' instead. - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - - ((equal type "help") - (let ((f-or-v (intern path))) - (cond ((fboundp f-or-v) - (describe-function f-or-v)) - ((boundp f-or-v) - (describe-variable f-or-v)) - (t (error "Not a known function or variable"))))) - - ((equal type "mailto") - (let ((cmd (car org-link-mailto-program)) - (args (cdr org-link-mailto-program)) args1 - (address path) (subject "") a) - (if (string-match "\\(.*\\)::\\(.*\\)" path) - (setq address (match-string 1 path) - subject (org-link-escape (match-string 2 path)))) - (while args - (cond - ((not (stringp (car args))) (push (pop args) args1)) - (t (setq a (pop args)) - (if (string-match "%a" a) - (setq a (replace-match address t t a))) - (if (string-match "%s" a) - (setq a (replace-match subject t t a))) - (push a args1)))) - (apply cmd (nreverse args1)))) - - ((member type '("http" "https" "ftp" "news")) - (browse-url - (concat type ":" - (if (org-string-match-p - (concat "[[:nonascii:]" - org-link-escape-chars-browser "]") - path) - (org-link-escape path org-link-escape-chars-browser) - path)))) - - ((string= type "doi") - (browse-url - (concat org-doi-server-url - (if (org-string-match-p - (concat "[[:nonascii:]" - org-link-escape-chars-browser "]") - path) - (org-link-escape path org-link-escape-chars-browser) - path)))) - - ((member type '("message")) - (browse-url (concat type ":" path))) - - ((string= type "tags") - (org-tags-view arg path)) - - ((string= type "tree-match") - (org-occur (concat "\\[" (regexp-quote path) "\\]"))) - - ((string= type "file") - (if (string-match "::\\([0-9]+\\)\\'" path) - (setq line (string-to-number (match-string 1 path)) - path (substring path 0 (match-beginning 0))) - (if (string-match "::\\(.+\\)\\'" path) - (setq search (match-string 1 path) - path (substring path 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - (org-open-file path arg line search))) - - ((string= type "shell") - (let ((buf (generate-new-buffer "*Org Shell Output")) - (cmd path)) - (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) - (string-match org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd buf) - (if (featurep 'midnight) - (setq clean-buffer-list-kill-buffer-names - (cons buf clean-buffer-list-kill-buffer-names)))) - (error "Abort")))) - - ((string= type "elisp") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) - (string-match org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd - (if (equal (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (error "Abort")))) - - ((and (string= type "thisfile") - (or (run-hook-with-args-until-success - 'org-open-link-functions path) - (and link - (string-match "^id:" link) - (or (featurep 'org-id) (require 'org-id)) - (progn - (funcall (nth 1 (assoc "id" org-link-protocols)) - (substring path 3)) - t))))) - - ((string= type "thisfile") - (if arg - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal arg '(4)) ''occur) - ((equal arg '(16)) ''org-occur)) - ,pos))) - (condition-case nil (let ((org-link-search-inhibit-query t)) - (eval cmd)) - (error (progn (widen) (eval cmd)))))) - - (t (browse-url-at-point))))))) - (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook))) +When optional argument REFERENCE-BUFFER is non-nil, it should +specify a buffer from where the link search should happen. This +is used internally by `org-open-link-from-string'. -(defsubst org-uniquify (list) - "Non-destructively remove duplicate elements from LIST." - (let ((res (copy-sequence list))) (delete-dups res))) +On top of syntactically correct links, this function will open +the link at point in comments or comment blocks and the first +link in a property drawer line." + (interactive "P") + ;; On a code block, open block's results. + (unless (call-interactively 'org-babel-open-src-block-result) + (org-load-modules-maybe) + (setq org-window-config-before-follow-link (current-window-configuration)) + (org-remove-occur-highlights nil nil t) + (unless (run-hook-with-args-until-success 'org-open-at-point-functions) + (let* ((context + ;; Only consider supported types, even if they are not + ;; the closest one. + (org-element-lineage + (org-element-context) + '(clock comment comment-block footnote-definition + footnote-reference headline inlinetask keyword link + node-property timestamp) + t)) + (type (org-element-type context)) + (value (org-element-property :value context))) + (cond + ((not context) (user-error "No link found")) + ;; Exception: open timestamps and links in properties + ;; drawers, keywords and comments. + ((memq type '(comment comment-block keyword node-property)) + (call-interactively #'org-open-at-point-global)) + ;; On a headline or an inlinetask, but not on a timestamp, + ;; a link, a footnote reference or on tags. + ((and (memq type '(headline inlinetask)) + ;; Not on tags. + (let ((case-fold-search nil)) + (save-excursion + (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5))))) + (let* ((data (org-offer-links-in-entry (current-buffer) (point) arg)) + (links (car data)) + (links-end (cdr data))) + (if links + (dolist (link (if (stringp links) (list links) links)) + (search-forward link nil links-end) + (goto-char (match-beginning 0)) + (org-open-at-point)) + (require 'org-attach) + (org-attach-reveal 'if-exists)))) + ;; On a clock line, make sure point is on the timestamp + ;; before opening it. + ((and (eq type 'clock) + value + (>= (point) (org-element-property :begin value)) + (<= (point) (org-element-property :end value))) + (org-follow-timestamp-link)) + ;; Do nothing on white spaces after an object. + ((>= (point) + (save-excursion + (goto-char (org-element-property :end context)) + (skip-chars-backward " \t") + (point))) + (user-error "No link found")) + ((eq type 'timestamp) (org-follow-timestamp-link)) + ;; On tags within a headline or an inlinetask. + ((and (memq type '(headline inlinetask)) + (let ((case-fold-search nil)) + (save-excursion (beginning-of-line) + (looking-at org-complex-heading-regexp)) + (and (match-beginning 5) + (>= (point) (match-beginning 5))))) + (org-tags-view arg (substring (match-string 5) 0 -1))) + ((eq type 'link) + ;; When link is located within the description of another + ;; link (e.g., an inline image), always open the parent + ;; link. + (let* ((link (let ((up (org-element-property :parent context))) + (if (eq (org-element-type up) 'link) up context))) + (type (org-element-property :type link)) + (path (org-link-unescape (org-element-property :path link)))) + ;; Switch back to REFERENCE-BUFFER needed when called in + ;; a temporary buffer through `org-open-link-from-string'. + (with-current-buffer (or reference-buffer (current-buffer)) + (cond + ((equal type "file") + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + ;; Look into `org-link-parameters' in order to find + ;; a DEDICATED-FUNCTION to open file. The function + ;; will be applied on raw link instead of parsed + ;; link due to the limitation in `org-add-link-type' + ;; ("open" function called with a single argument). + ;; If no such function is found, fallback to + ;; `org-open-file'. + (let* ((option (org-element-property :search-option link)) + (app (org-element-property :application link)) + (dedicated-function + (org-link-get-parameter + (if app (concat type "+" app) type) + :follow))) + (if dedicated-function + (funcall dedicated-function + (concat path + (and option (concat "::" option)))) + (apply #'org-open-file + path + (cond (arg) + ((equal app "emacs") 'emacs) + ((equal app "sys") 'system)) + (cond ((not option) nil) + ((string-match-p "\\`[0-9]+\\'" option) + (list (string-to-number option))) + (t (list nil + (org-link-unescape option))))))))) + ((functionp (org-link-get-parameter type :follow)) + (funcall (org-link-get-parameter type :follow) path)) + ((member type '("coderef" "custom-id" "fuzzy" "radio")) + (unless (run-hook-with-args-until-success + 'org-open-link-functions path) + (if (not arg) (org-mark-ring-push) + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer)))) + (let ((destination + (org-with-wide-buffer + (if (equal type "radio") + (org-search-radio-target + (org-element-property :path link)) + (org-link-search + (if (member type '("custom-id" "coderef")) + (org-element-property :raw-link link) + path) + ;; Prevent fuzzy links from matching + ;; themselves. + (and (equal type "fuzzy") + (+ 2 (org-element-property :begin link))))) + (point)))) + (unless (and (<= (point-min) destination) + (>= (point-max) destination)) + (widen)) + (goto-char destination)))) + (t (browse-url-at-point)))))) + ;; On a footnote reference or at a footnote definition's label. + ((or (eq type 'footnote-reference) + (and (eq type 'footnote-definition) + (save-excursion + ;; Do not validate action when point is on the + ;; spaces right after the footnote label, in + ;; order to be on par with behaviour on links. + (skip-chars-forward " \t") + (let ((begin + (org-element-property :contents-begin context))) + (if begin (< (point) begin) + (= (org-element-property :post-affiliated context) + (line-beginning-position))))))) + (org-footnote-action)) + (t (user-error "No link found"))))) + (run-hook-with-args 'org-follow-link-hook))) (defun org-offer-links-in-entry (buffer marker &optional nth zero) "Offer links in the current entry and return the selected link. @@ -10644,65 +10943,57 @@ If NTH is an integer, return the NTH link found. If ZERO is a string, check also this string for a link, and if there is one, return it." (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" - "\\(" org-angle-link-re "\\)\\|" - "\\(" org-plain-link-re "\\)")) - (cnt ?0) - (in-emacs (if (integerp nth) nil nth)) - have-zero end links link c) - (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) - (push (match-string 0 zero) links) - (setq cnt (1- cnt) have-zero t)) - (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (while (re-search-forward re end t) - (push (match-string 0) links)) - (setq links (org-uniquify (reverse links)))) - (cond - ((null links) - (message "No links")) - ((equal (length links) 1) - (setq link (car links))) - ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) - (setq link (nth (if have-zero nth (1- nth)) links))) - (t ; we have to select a link - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Select Link*" - (mapc (lambda (l) - (if (not (string-match org-bracket-link-regexp l)) - (princ (format "[%c] %s\n" (incf cnt) - (org-remove-angle-brackets l))) - (if (match-end 3) - (princ (format "[%c] %s (%s)\n" (incf cnt) - (match-string 3 l) (match-string 1 l))) - (princ (format "[%c] %s\n" (incf cnt) - (match-string 1 l)))))) - links)) - (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) - (message "Select link to open, RET to open all:") - (setq c (read-char-exclusive)) - (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) - (when (equal c ?q) (error "Abort")) - (if (equal c ?\C-m) - (setq link links) - (setq nth (- c ?0)) - (if have-zero (setq nth (1+ nth))) - (unless (and (integerp nth) (>= (length links) nth)) - (user-error "Invalid link selection")) - (setq link (nth (1- nth) links))))) - (cons link end)))))) - -;; Add special file links that specify the way of opening - -(org-add-link-type "file+sys" 'org-open-file-with-system) -(org-add-link-type "file+emacs" 'org-open-file-with-emacs) + (org-with-wide-buffer + (goto-char marker) + (let ((cnt ?0) + have-zero end links link c) + (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) + (push (match-string 0 zero) links) + (setq cnt (1- cnt) have-zero t)) + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (while (re-search-forward org-any-link-re end t) + (push (match-string 0) links)) + (setq links (org-uniquify (reverse links)))) + (cond + ((null links) + (message "No links")) + ((equal (length links) 1) + (setq link (car links))) + ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) + (setq link (nth (if have-zero nth (1- nth)) links))) + (t ; we have to select a link + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Select Link*" + (dolist (l links) + (cond + ((not (string-match org-bracket-link-regexp l)) + (princ (format "[%c] %s\n" (cl-incf cnt) + (org-unbracket-string "<" ">" l)))) + ((match-end 3) + (princ (format "[%c] %s (%s)\n" (cl-incf cnt) + (match-string 3 l) (match-string 1 l)))) + (t (princ (format "[%c] %s\n" (cl-incf cnt) + (match-string 1 l))))))) + (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) + (message "Select link to open, RET to open all:") + (setq c (read-char-exclusive)) + (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) + (when (equal c ?q) (user-error "Abort")) + (if (equal c ?\C-m) + (setq link links) + (setq nth (- c ?0)) + (when have-zero (setq nth (1+ nth))) + (unless (and (integerp nth) (>= (length links) nth)) + (user-error "Invalid link selection")) + (setq link (nth (1- nth) links))))) + (cons link end))))) + +;; TODO: These functions are deprecated since `org-open-at-point' +;; hard-codes behaviour for "file+emacs" and "file+sys" types. (defun org-open-file-with-system (path) "Open file at PATH using the system way of opening it." (org-open-file path 'system)) @@ -10732,8 +11023,8 @@ which see. A function in this hook may also use `setq' to set the variable `description' to provide a suggestion for the descriptive text to -be used for this link when it gets inserted into an Org-mode -buffer with \\[org-insert-link].") +be used for this link when it gets inserted into an Org buffer +with \\[org-insert-link].") (defvar org-execute-file-search-functions nil "List of functions to execute a file search triggered by a link. @@ -10757,179 +11048,201 @@ the window configuration before `org-open-at-point' was called using: (set-window-configuration org-window-config-before-follow-link)") -(defun org-link-search (s &optional type avoid-pos stealth) - "Search for a link search option. -If S is surrounded by forward slashes, it is interpreted as a -regular expression. In org-mode files, this will create an `org-occur' -sparse tree. In ordinary files, `occur' will be used to list matches. -If the current buffer is in `dired-mode', grep will be used to search -in all files. If AVOID-POS is given, ignore matches near that position. +(defun org-search-radio-target (target) + "Search a radio target matching TARGET in current buffer. +White spaces are not significant." + (let ((re (format "<<<%s>>>" + (mapconcat #'regexp-quote + (org-split-string target "[ \t\n]+") + "[ \t]+\\(?:\n[ \t]*\\)?"))) + (origin (point))) + (goto-char (point-min)) + (catch :radio-match + (while (re-search-forward re nil t) + (backward-char) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'radio-target) + (goto-char (org-element-property :begin object)) + (org-show-context 'link-search) + (throw :radio-match nil)))) + (goto-char origin) + (user-error "No match for radio target: %s" target)))) + +(defun org-link-search (s &optional avoid-pos stealth) + "Search for a search string S. + +If S starts with \"#\", it triggers a custom ID search. + +If S is enclosed within parenthesis, it initiates a coderef +search. + +If S is surrounded by forward slashes, it is interpreted as +a regular expression. In Org mode files, this will create an +`org-occur' sparse tree. In ordinary files, `occur' will be used +to list matches. If the current buffer is in `dired-mode', grep +will be used to search in all files. + +When AVOID-POS is given, ignore matches near that position. When optional argument STEALTH is non-nil, do not modify -visibility around point, thus ignoring -`org-show-hierarchy-above', `org-show-following-heading' and -`org-show-siblings' variables." - (let ((case-fold-search t) - (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) - (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) - (append '(("") (" ") ("\t") ("\n")) - org-emphasis-alist) - "\\|") "\\)")) - (pos (point)) - (pre nil) (post nil) - words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) +visibility around point, thus ignoring `org-show-context-detail' +variable. + +Search is case-insensitive and ignores white spaces. Return type +of matched result, which is either `dedicated' or `fuzzy'." + (unless (org-string-nw-p s) (error "Invalid search string \"%s\"" s)) + (let* ((case-fold-search t) + (origin (point)) + (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) + (starred (eq (string-to-char normalized) ?*)) + (words (split-string (if starred (substring s 1) s))) + (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)")) + (s-single-re (mapconcat #'regexp-quote words "[ \t]+")) + type) (cond - ;; First check if there are any special search functions + ;; Check if there are any special search functions. ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) - ;; Now try the builtin stuff - ((and (equal (string-to-char s0) ?#) - (> (length s0) 1) - (save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "^[ \t]*:CUSTOM_ID:[ \t]+" - (regexp-quote (substring s0 1)) "[ \t]*$") nil t) - (setq type 'dedicated - pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos) - (org-back-to-heading t))) - ((save-excursion + ((eq (string-to-char s) ?#) + ;; Look for a custom ID S if S starts with "#". + (let* ((id (substring normalized 1)) + (match (org-find-property "CUSTOM_ID" id))) + (if match (progn (goto-char match) (setf type 'dedicated)) + (error "No match for custom ID: %s" id)))) + ((string-match "\\`(\\(.*\\))\\'" normalized) + ;; Look for coderef targets if S is enclosed within parenthesis. + (let ((coderef (match-string-no-properties 1 normalized)) + (re (substring s-single-re 1 -1))) (goto-char (point-min)) - (and - (re-search-forward - (concat "<<" (regexp-quote s0) ">>") nil t) - (setq type 'dedicated - pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos)) - ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) - (setq type 'dedicated pos (match-beginning 0)))) - ;; Found an element with a matching #+name affiliated keyword. - (goto-char pos)) - ((and (string-match "^(\\(.*\\))$" s0) - (save-excursion + (catch :coderef-match + (while (re-search-forward re nil t) + (let ((element (org-element-at-point))) + (when (and (memq (org-element-type element) + '(example-block src-block)) + ;; Build proper regexp according to current + ;; block's label format. + (let ((label-fmt + (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format)))) + (save-excursion + (beginning-of-line) + (looking-at (format ".*?\\(%s\\)[ \t]*$" + (format label-fmt coderef)))))) + (setq type 'dedicated) + (goto-char (match-beginning 1)) + (throw :coderef-match nil)))) + (goto-char origin) + (error "No match for coderef: %s" coderef)))) + ((string-match "\\`/\\(.*\\)/\\'" normalized) + ;; Look for a regular expression. + (funcall (if (derived-mode-p 'org-mode) #'org-occur #'org-do-occur) + (match-string 1 s))) + ;; From here, we handle fuzzy links. + ;; + ;; Look for targets, only if not in a headline search. + ((and (not starred) + (let ((target (format "<<%s>>" s-multi-re))) + (catch :target-match + (goto-char (point-min)) + (while (re-search-forward target nil t) + (backward-char) + (let ((context (org-element-context))) + (when (eq (org-element-type context) 'target) + (setq type 'dedicated) + (goto-char (org-element-property :begin context)) + (throw :target-match t)))) + nil)))) + ;; Look for elements named after S, only if not in a headline + ;; search. + ((and (not starred) + (let ((name (format "^[ \t]*#\\+NAME: +%s[ \t]*$" s-single-re))) + (catch :name-match + (goto-char (point-min)) + (while (re-search-forward name nil t) + (let ((element (org-element-at-point))) + (when (equal words + (split-string + (org-element-property :name element))) + (setq type 'dedicated) + (beginning-of-line) + (throw :name-match t)))) + nil)))) + ;; Regular text search. Prefer headlines in Org mode buffers. + ;; Ignore COMMENT keyword, TODO keywords, priority cookies, + ;; statistics cookies and tags. + ((and (derived-mode-p 'org-mode) + (let ((title-re + (format "%s.*\\(?:%s[ \t]\\)?.*%s" + org-outline-regexp-bol + org-comment-string + (mapconcat #'regexp-quote words ".+"))) + (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") + (comment-re (format "\\`%s[ \t]+" org-comment-string))) (goto-char (point-min)) - (and - (re-search-forward - (concat "[^[]" (regexp-quote - (format org-coderef-label-format - (match-string 1 s0)))) - nil t) - (setq type 'dedicated - pos (1+ (match-beginning 0)))))) - ;; There is a coderef target for this - (goto-char pos)) - ((string-match "^/\\(.*\\)/$" s) - ;; A regular expression - (cond - ((derived-mode-p 'org-mode) - (org-occur (match-string 1 s))) - (t (org-do-occur (match-string 1 s))))) - ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline) - (and (equal (string-to-char s) ?*) (setq s (substring s 1))) - (goto-char (point-min)) - (cond - ((let (case-fold-search) - (re-search-forward (format org-complex-heading-regexp-format - (regexp-quote s)) - nil t)) - ;; OK, found a match - (setq type 'dedicated) - (goto-char (match-beginning 0))) - ((and (not org-link-search-inhibit-query) - (eq org-link-search-must-match-exact-headline 'query-to-create) - (y-or-n-p "No match - create this as a new heading? ")) - (goto-char (point-max)) - (or (bolp) (newline)) - (insert "* " s "\n") - (beginning-of-line 0)) - (t - (goto-char pos) - (error "No match")))) - (t - ;; A normal search string - (when (equal (string-to-char s) ?*) - ;; Anchor on headlines, post may include tags. - (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" - post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") - s (substring s 1))) - (remove-text-properties - 0 (length s) - '(face nil mouse-face nil keymap nil fontified nil) s) - ;; Make a series of regular expressions to find a match - (setq words (org-split-string s "[ \n\r\t]+") - - re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") - re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") - "\\)" markers) - re2a_ (concat "\\(" (mapconcat 'downcase words - "[ \t\r\n]+") "\\)[ \t\r\n]") - re2a (concat "[ \t\r\n]" re2a_) - re4_ (concat "\\(" (mapconcat 'downcase words - "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") - re4 (concat "[^a-zA-Z_]" re4_) - - re1 (concat pre re2 post) - re3 (concat pre (if pre re4_ re4) post) - re5 (concat pre ".*" re4) - re2 (concat pre re2) - re2a (concat pre (if pre re2a_ re2a)) - re4 (concat pre (if pre re4_ re4)) - reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 - "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)")) - (cond - ((eq type 'org-occur) (org-occur reall)) - ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) - (t (goto-char (point-min)) - (setq type 'fuzzy) - (if (or (and (org-search-not-self 1 re0 nil t) - (setq type 'dedicated)) - (org-search-not-self 1 re1 nil t) - (org-search-not-self 1 re2 nil t) - (org-search-not-self 1 re2a nil t) - (org-search-not-self 1 re3 nil t) - (org-search-not-self 1 re4 nil t) - (org-search-not-self 1 re5 nil t)) - (goto-char (match-beginning 1)) - (goto-char pos) - (error "No match")))))) - (and (derived-mode-p 'org-mode) - (not stealth) - (org-show-context 'link-search)) + (catch :found + (while (re-search-forward title-re nil t) + (when (equal words + (split-string + (replace-regexp-in-string + cookie-re "" + (replace-regexp-in-string + comment-re "" (org-get-heading t t))))) + (throw :found t))) + nil))) + (beginning-of-line) + (setq type 'dedicated)) + ;; Offer to create non-existent headline depending on + ;; `org-link-search-must-match-exact-headline'. + ((and (derived-mode-p 'org-mode) + (not org-link-search-inhibit-query) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (yes-or-no-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (unless (bolp) (newline)) + (org-insert-heading nil t t) + (insert s "\n") + (beginning-of-line 0)) + ;; Only headlines are looked after. No need to process + ;; further: throw an error. + ((and (derived-mode-p 'org-mode) + (or starred org-link-search-must-match-exact-headline)) + (goto-char origin) + (error "No match for fuzzy expression: %s" normalized)) + ;; Regular text search. + ((catch :fuzzy-match + (goto-char (point-min)) + (while (re-search-forward s-multi-re nil t) + ;; Skip match if it contains AVOID-POS or it is included in + ;; a link with a description but outside the description. + (unless (or (and avoid-pos + (<= (match-beginning 0) avoid-pos) + (> (match-end 0) avoid-pos)) + (and (save-match-data + (org-in-regexp org-bracket-link-regexp)) + (match-beginning 3) + (or (> (match-beginning 3) (point)) + (<= (match-end 3) (point))) + (org-element-lineage + (save-match-data (org-element-context)) + '(link) t))) + (goto-char (match-beginning 0)) + (setq type 'fuzzy) + (throw :fuzzy-match t))) + nil)) + ;; All failed. Throw an error. + (t (goto-char origin) + (error "No match for fuzzy expression: %s" normalized))) + ;; Disclose surroundings of match, if appropriate. + (when (and (derived-mode-p 'org-mode) (not stealth)) + (org-show-context 'link-search)) type)) -(defun org-search-not-self (group &rest args) - "Execute `re-search-forward', but only accept matches that do not -enclose the position of `org-open-link-marker'." - (let ((m org-open-link-marker)) - (catch 'exit - (while (apply #'re-search-forward args) - (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 - (goto-char (match-end group)) - (if (and (or (not (eq (marker-buffer m) (current-buffer))) - (> (match-beginning 0) (marker-position m)) - (< (match-end 0) (marker-position m))) - (save-match-data - (or (not (org-in-regexp - org-bracket-link-analytic-regexp 1)) - (not (match-end 4)) ; no description - (and (<= (match-beginning 4) (point)) - (>= (match-end 4) (point)))))) - (throw 'exit (point)))))))) - (defun org-get-buffer-for-internal-link (buffer) "Return a buffer to be used for displaying the link target of internal links." (cond ((not org-display-internal-link-with-indirect-buffer) buffer) - ((string-match "(Clone)$" (buffer-name buffer)) + ((string-suffix-p "(Clone)" (buffer-name buffer)) (message "Buffer is already a clone, not making another one") ;; we also do not modify visibility in this case buffer) @@ -10953,8 +11266,8 @@ to read." (goto-char (point-min)) (when (re-search-forward "match[a-z]+" nil t) (setq beg (match-end 0)) - (if (re-search-forward "^[ \t]*[0-9]+" nil t) - (setq end (1- (match-beginning 0))))) + (when (re-search-forward "^[ \t]*[0-9]+" nil t) + (setq end (1- (match-beginning 0))))) (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) (goto-char (point-min)) (select-window cwin)))) @@ -10962,13 +11275,13 @@ to read." ;;; The mark ring for links jumps (defvar org-mark-ring nil - "Mark ring for positions before jumps in Org-mode.") + "Mark ring for positions before jumps in Org mode.") (defvar org-mark-ring-last-goto nil "Last position in the mark ring used to go back.") ;; Fill and close the ring (setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded -(loop for i from 1 to org-mark-ring-length do - (push (make-marker) org-mark-ring)) +(dotimes (_ org-mark-ring-length) + (push (make-marker) org-mark-ring)) (setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) org-mark-ring) @@ -10982,15 +11295,15 @@ to read." (or buffer (current-buffer))) (message "%s" (substitute-command-keys - "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) + "Position saved to mark ring, go back with \ +`\\[org-mark-ring-goto]'."))) (defun org-mark-ring-goto (&optional n) "Jump to the previous position in the mark ring. With prefix arg N, jump back that many stored positions. When called several times in succession, walk through the entire ring. -Org-mode commands jumping to a different position in the current file, -or to another Org-mode file, automatically push the old position -onto the ring." +Org mode commands jumping to a different position in the current file, +or to another Org file, automatically push the old position onto the ring." (interactive "p") (let (p m) (if (eq last-command this-command) @@ -10998,25 +11311,19 @@ onto the ring." (setq p org-mark-ring)) (setq org-mark-ring-last-goto p) (setq m (car p)) - (org-pop-to-buffer-same-window (marker-buffer m)) + (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) -(defun org-remove-angle-brackets (s) - (if (equal (substring s 0 1) "<") (setq s (substring s 1))) - (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) - s) (defun org-add-angle-brackets (s) - (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) - (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) - s) -(defun org-remove-double-quotes (s) - (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) - (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) + (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) + (unless (equal (substring s -1) ">") (setq s (concat s ">"))) s) ;;; Following specific links +(defvar org-agenda-buffer-tmp-name) +(defvar org-agenda-start-on-weekday) (defun org-follow-timestamp-link () "Open an agenda view for the time-stamp date/range at point." (cond @@ -11071,43 +11378,40 @@ If the file does not exist, an error is thrown." buffer-file-name (substitute-in-file-name (expand-file-name path)))) (file-apps (append org-file-apps (org-default-apps))) - (apps (org-remove-if + (apps (cl-remove-if 'org-file-apps-entry-match-against-dlink-p file-apps)) - (apps-dlink (org-remove-if-not + (apps-dlink (cl-remove-if-not 'org-file-apps-entry-match-against-dlink-p file-apps)) (remp (and (assq 'remote apps) (org-file-remote-p file))) - (dirp (if remp nil (file-directory-p file))) + (dirp (unless remp (file-directory-p file))) (file (if (and dirp org-open-directory-means-index-dot-org) (concat (file-name-as-directory file) "index.org") file)) (a-m-a-p (assq 'auto-mode apps)) (dfile (downcase file)) - ;; reconstruct the original file: link from the PATH, LINE and SEARCH args - (link (cond ((and (eq line nil) - (eq search nil)) - file) - (line - (concat file "::" (number-to-string line))) - (search - (concat file "::" search)))) + ;; Reconstruct the original link from the PATH, LINE and + ;; SEARCH args. + (link (cond (line (concat file "::" (number-to-string line))) + (search (concat file "::" search)) + (t file))) (dlink (downcase link)) (old-buffer (current-buffer)) (old-pos (point)) (old-mode major-mode) - ext cmd link-match-data) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) - (setq ext (match-string 1 dfile)) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) - (setq ext (match-string 1 dfile)))) + (ext + (and (string-match "\\`.*?\\.\\([a-zA-Z0-9]+\\(\\.gz\\)?\\)\\'" dfile) + (match-string 1 dfile))) + cmd link-match-data) (cond ((member in-emacs '((16) system)) - (setq cmd (cdr (assoc 'system apps)))) + (setq cmd (cdr (assq 'system apps)))) (in-emacs (setq cmd 'emacs)) (t - (setq cmd (or (and remp (cdr (assoc 'remote apps))) - (and dirp (cdr (assoc 'directory apps))) - ; first, try matching against apps-dlink - ; if we get a match here, store the match data for later + (setq cmd (or (and remp (cdr (assq 'remote apps))) + (and dirp (cdr (assq 'directory apps))) + ;; First, try matching against apps-dlink if we + ;; get a match here, store the match data for + ;; later. (let ((match (assoc-default dlink apps-dlink 'string-match))) (if match @@ -11120,9 +11424,9 @@ If the file does not exist, an error is thrown." (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) 'string-match) (cdr (assoc ext apps)) - (cdr (assoc t apps)))))) + (cdr (assq t apps)))))) (when (eq cmd 'system) - (setq cmd (cdr (assoc 'system apps)))) + (setq cmd (cdr (assq 'system apps)))) (when (eq cmd 'default) (setq cmd (cdr (assoc t apps)))) (when (eq cmd 'mailcap) @@ -11133,21 +11437,20 @@ If the file does not exist, an error is thrown." (if (stringp command) (setq cmd command) (setq cmd 'emacs)))) - (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files - (not (file-exists-p file)) - (not org-open-non-existing-files)) - (user-error "No such file: %s" file)) + (when (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (user-error "No such file: %s" file)) (cond ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) ;; Remove quotes around the file name - we'll use shell-quote-argument. (while (string-match "['\"]%s['\"]" cmd) (setq cmd (replace-match "%s" t t cmd))) - (while (string-match "%s" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument - (convert-standard-filename file))) - t t cmd))) + (setq cmd (replace-regexp-in-string + "%s" + (shell-quote-argument (convert-standard-filename file)) + cmd + nil t)) ;; Replace "%1", "%2" etc. in command with group matches from regex (save-match-data @@ -11169,17 +11472,33 @@ If the file does not exist, an error is thrown." (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) - (if line (org-goto-line line) - (if search (org-link-search search)))) + (cond (line (org-goto-line line) + (when (derived-mode-p 'org-mode) (org-reveal))) + (search (org-link-search search)))) + ((functionp cmd) + (save-match-data + (set-match-data link-match-data) + (condition-case nil + (funcall cmd file link) + ;; FIXME: Remove this check when most default installations + ;; of Emacs have at least Org 9.0. + ((debug wrong-number-of-arguments wrong-type-argument + invalid-function) + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Lisp error: %S" cmd))))) ((consp cmd) - (let ((file (convert-standard-filename file))) - (save-match-data - (set-match-data link-match-data) - (eval cmd)))) + ;; FIXME: Remove this check when most default installations of + ;; Emacs have at least Org 9.0. + ;; Heads-up instead of silently fall back to + ;; `org-link-frame-setup' for an old usage of `org-file-apps' + ;; with sexp instead of a function for `cmd'. + (user-error "Please see Org News for version 9.0 about \ +`org-file-apps'--Error: Deprecated usage of %S" cmd)) (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) - (or (not (equal old-buffer (current-buffer))) - (not (equal old-pos (point)))) + (and (derived-mode-p 'org-mode) + (eq old-mode 'org-mode) + (or (not (eq old-buffer (current-buffer))) + (not (eq old-pos (point)))) (org-mark-ring-push old-pos old-buffer)))) (defun org-file-apps-entry-match-against-dlink-p (entry) @@ -11220,16 +11539,15 @@ be opened in Emacs." (append (delq nil (mapcar (lambda (x) - (if (not (stringp (car x))) - nil + (unless (not (stringp (car x))) (if (string-match "\\W" (car x)) x (cons (concat "\\." (car x) "\\'") (cdr x))))) list)) - (if add-auto-mode - (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) + (when add-auto-mode + (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) -(defvar ange-ftp-name-format) ; to silence the XEmacs compiler. +(defvar ange-ftp-name-format) (defun org-file-remote-p (file) "Test whether FILE specifies a location on a remote system. Return non-nil if the location is indeed remote. @@ -11262,8 +11580,8 @@ on the system \"/user@host:\"." ((not (listp org-reverse-note-order)) nil) (t (catch 'exit (dolist (entry org-reverse-note-order) - (if (string-match (car entry) buffer-file-name) - (throw 'exit (cdr entry)))))))) + (when (string-match (car entry) buffer-file-name) + (throw 'exit (cdr entry)))))))) (defvar org-refile-target-table nil "The list of refile targets, created by `org-refile'.") @@ -11288,7 +11606,7 @@ on the system \"/user@host:\"." (defun org-refile-cache-clear () "Clear the refile cache and disable all the markers." - (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (dolist (m org-refile-markers) (move-marker m nil)) (setq org-refile-markers nil) (setq org-refile-cache nil) (message "Refile cache has been cleared")) @@ -11323,17 +11641,23 @@ on the system \"/user@host:\"." org-refile-cache)))) (and set (org-refile-cache-check-set set) set))))) -(defun org-refile-get-targets (&optional default-buffer excluded-entries) +(defvar org-outline-path-cache nil + "Alist between buffer positions and outline paths. +It value is an alist (POSITION . PATH) where POSITION is the +buffer position at the beginning of an entry and PATH is a list +of strings describing the outline path for that entry, in reverse +order.") + +(defun org-refile-get-targets (&optional default-buffer) "Produce a table with refile targets." (let ((case-fold-search nil) ;; otherwise org confuses "TODO" as a kw and "Todo" as a word (entries (or org-refile-targets '((nil . (:level . 1))))) - targets tgs txt re files desc descre fast-path-p level pos0) + targets tgs files desc descre) (message "Getting targets...") (with-current-buffer (or default-buffer (current-buffer)) (dolist (entry entries) (setq files (car entry) desc (cdr entry)) - (setq fast-path-p nil) (cond ((null files) (setq files (list (current-buffer)))) ((eq files 'org-agenda-files) @@ -11342,7 +11666,7 @@ on the system \"/user@host:\"." (setq files (funcall files))) ((and (symbolp files) (boundp files)) (setq files (symbol-value files)))) - (if (stringp files) (setq files (list files))) + (when (stringp files) (setq files (list files))) (cond ((eq (car desc) :tag) (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) @@ -11357,7 +11681,6 @@ on the system \"/user@host:\"." (cdr desc))) "\\}[ \t]"))) ((eq (car desc) :maxlevel) - (setq fast-path-p t) (setq descre (concat "^\\*\\{1," (number-to-string (if org-odd-levels-only (1- (* 2 (cdr desc))) @@ -11365,99 +11688,113 @@ on the system \"/user@host:\"." "\\}[ \t]"))) (t (error "Bad refiling target description %s" desc))) (dolist (f files) - (with-current-buffer - (if (bufferp f) f (org-get-agenda-file-buffer f)) + (with-current-buffer (if (bufferp f) f (org-get-agenda-file-buffer f)) (or (setq tgs (org-refile-cache-get (buffer-file-name) descre)) (progn - (if (bufferp f) (setq f (buffer-file-name - (buffer-base-buffer f)))) + (when (bufferp f) + (setq f (buffer-file-name (buffer-base-buffer f)))) (setq f (and f (expand-file-name f))) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) tgs)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (and (looking-at org-complex-heading-regexp) - (not (member (match-string 4) excluded-entries)) - (match-string 4)) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - txt (replace-regexp-in-string "\\( *[[0-9]+/?[0-9]*%?]\\)+$" "" txt) - re (format org-complex-heading-regexp-format - (regexp-quote (match-string 4)))) - (when org-refile-use-outline-path - (setq txt (mapconcat - 'org-protect-slash - (append - (if (eq org-refile-use-outline-path - 'file) - (list (file-name-nondirectory - (buffer-file-name - (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path - 'full-file-path) - (list (buffer-file-name - (buffer-base-buffer))))) - (org-get-outline-path fast-path-p - level txt) - (list txt)) - "/"))) - (push (list txt f re (org-refile-marker (point))) - tgs))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))) + (when (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (org-with-wide-buffer + (goto-char (point-min)) + (setq org-outline-path-cache nil) + (while (re-search-forward descre nil t) + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (let ((begin (point)) + (heading (match-string-no-properties 4))) + (unless (or (and + org-refile-target-verify-function + (not + (funcall org-refile-target-verify-function))) + (not heading)) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (target + (if (not org-refile-use-outline-path) heading + (mapconcat + #'org-protect-slash + (append + (pcase org-refile-use-outline-path + (`file (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer))))) + (`full-file-path + (list (buffer-file-name + (buffer-base-buffer)))) + (_ nil)) + (org-get-outline-path t t)) + "/")))) + (push (list target f re (org-refile-marker (point))) + tgs))) + (when (= (point) begin) + ;; Verification function has not moved point. + (end-of-line))))))) (when org-refile-use-cache (org-refile-cache-put tgs (buffer-file-name) descre)) (setq targets (append tgs targets)))))) (message "Getting targets...done") - (nreverse targets))) + (delete-dups (nreverse targets)))) (defun org-protect-slash (s) - (while (string-match "/" s) - (setq s (replace-match "\\" t t s))) - s) - -(defvar org-olpa (make-vector 20 nil)) - -(defun org-get-outline-path (&optional fastp level heading) - "Return the outline path to the current entry, as a list. - -The parameters FASTP, LEVEL, and HEADING are for use by a scanner -routine which makes outline path derivations for an entire file, -avoiding backtracing. Refile target collection makes use of that." - (if fastp - (progn - (if (> level 19) - (error "Outline path failure, more than 19 levels")) - (loop for i from level upto 19 do - (aset org-olpa i nil)) - (prog1 - (delq nil (append org-olpa nil)) - (aset org-olpa level heading))) - (let (rtn case-fold-search) - (save-excursion - (save-restriction - (widen) - (while (org-up-heading-safe) - (when (looking-at org-complex-heading-regexp) - (push (org-trim - (replace-regexp-in-string - ;; Remove statistical/checkboxes cookies - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-match-string-no-properties 4))) - rtn))) - rtn))))) + (replace-regexp-in-string "/" "\\/" s nil t)) + +(defun org--get-outline-path-1 (&optional use-cache) + "Return outline path to current headline. + +Outline path is a list of strings, in reverse order. When +optional argument USE-CACHE is non-nil, make use of a cache. See +`org-get-outline-path' for details. + +Assume buffer is widened and point is on a headline." + (or (and use-cache (cdr (assq (point) org-outline-path-cache))) + (let ((p (point)) + (heading (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp) + (if (not (match-end 4)) "" + ;; Remove statistics cookies. + (org-trim + (org-link-display-format + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (match-string-no-properties 4)))))))) + (if (org-up-heading-safe) + (let ((path (cons heading (org--get-outline-path-1 use-cache)))) + (when use-cache + (push (cons p path) org-outline-path-cache)) + path) + ;; This is a new root node. Since we assume we are moving + ;; forward, we can drop previous cache so as to limit number + ;; of associations there. + (let ((path (list heading))) + (when use-cache (setq org-outline-path-cache (list (cons p path)))) + path))))) + +(defun org-get-outline-path (&optional with-self use-cache) + "Return the outline path to the current entry. + +An outline path is a list of ancestors for current headline, as +a list of strings. Statistics cookies are removed and links are +replaced with their description, if any, or their path otherwise. + +When optional argument WITH-SELF is non-nil, the path also +includes the current headline. + +When optional argument USE-CACHE is non-nil, cache outline paths +between calls to this function so as to avoid backtracking. This +argument is useful when planning to find more than one outline +path in the same document. In that case, there are two +conditions to satisfy: + - `org-outline-path-cache' is set to nil before starting the + process; + - outline paths are computed by increasing buffer positions." + (org-with-wide-buffer + (and (or (and with-self (org-back-to-heading t)) + (org-up-heading-safe)) + (reverse (org--get-outline-path-1 use-cache))))) (defun org-format-outline-path (path &optional width prefix separator) "Format the outline path PATH for display. @@ -11467,38 +11804,28 @@ such as the file name. SEPARATOR is inserted between the different parts of the path, the default is \"/\"." (setq width (or width 79)) - (if prefix (setq width (- width (length prefix)))) - (if (not path) - (or prefix "") - (let* ((nsteps (length path)) - (total-width (+ nsteps (apply '+ (mapcar 'length path)))) - (maxwidth (if (<= total-width width) - 10000 ;; everything fits - ;; we need to shorten the level headings - (/ (- width nsteps) nsteps))) - (org-odd-levels-only nil) - (n 0) - (total (1+ (length prefix)))) - (setq maxwidth (max maxwidth 10)) - (concat prefix - (if prefix (or separator "/")) - (mapconcat - (lambda (h) - (setq n (1+ n)) - (if (and (= n nsteps) (< maxwidth 10000)) - (setq maxwidth (- total-width total))) - (if (< (length h) maxwidth) - (progn (setq total (+ total (length h) 1)) h) - (setq h (substring h 0 (- maxwidth 2)) - total (+ total maxwidth 1)) - (if (string-match "[ \t]+\\'" h) - (setq h (substring h 0 (match-beginning 0)))) - (setq h (concat h ".."))) - (org-add-props h nil 'face - (nth (% (1- n) org-n-level-faces) - org-level-faces)) - h) - path (or separator "/")))))) + (setq path (delq nil path)) + (unless (> width 0) + (user-error "Argument `width' must be positive")) + (setq separator (or separator "/")) + (let* ((org-odd-levels-only nil) + (fpath (concat + prefix (and prefix path separator) + (mapconcat + (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s)) + (cl-loop for head in path + for n from 0 + collect (org-add-props + head nil 'face + (nth (% n org-n-level-faces) org-level-faces))) + separator)))) + (when (> (length fpath) width) + (if (< width 7) + ;; It's unlikely that `width' will be this small, but don't + ;; waste characters by adding ".." if it is. + (setq fpath (substring fpath 0 width)) + (setf (substring fpath (- width 2)) ".."))) + fpath)) (defun org-display-outline-path (&optional file current separator just-return-string) "Display the current outline path in the echo area. @@ -11513,10 +11840,10 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message." (bfn (buffer-file-name (buffer-base-buffer))) (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) res) - (if current (setq path (append path - (save-excursion - (org-back-to-heading t) - (if (looking-at org-complex-heading-regexp) + (when current (setq path (append path + (save-excursion + (org-back-to-heading t) + (when (looking-at org-complex-heading-regexp) (list (match-string 4))))))) (setq res (org-format-outline-path @@ -11546,25 +11873,27 @@ the *old* location.") (let ((org-refile-keep t)) (funcall 'org-refile nil nil nil "Copy"))) -(defun org-refile (&optional goto default-buffer rfloc msg) +(defun org-refile (&optional arg default-buffer rfloc msg) "Move the entry or entries at point to another heading. + The list of target headings is compiled using the information in `org-refile-targets', which see. -At the target location, the entry is filed as a subitem of the target -heading. Depending on `org-reverse-note-order', the new subitem will -either be the first or the last subitem. +At the target location, the entry is filed as a subitem of the +target heading. Depending on `org-reverse-note-order', the new +subitem will either be the first or the last subitem. -If there is an active region, all entries in that region will be moved. -However, the region must fulfill the requirement that the first heading -is the first one sets the top-level of the moved text - at most siblings -below it are allowed. +If there is an active region, all entries in that region will be +refiled. However, the region must fulfill the requirement that +the first heading sets the top-level of the moved text. -With prefix arg GOTO, the command will only visit the target location +With a `\\[universal-argument]' ARG, the command will only visit the target \ +location and not actually move anything. -With a double prefix arg \\[universal-argument] \\[universal-argument], \ -go to the location where the last refiling operation has put the subtree. +With a prefix `\\[universal-argument] \\[universal-argument]', go to the \ +location where the last +refiling operation has put the subtree. With a numeric prefix argument of `2', refile to the running clock. @@ -11578,26 +11907,23 @@ RFLOC can be a refile location obtained in a different way. MSG is a string to replace \"Refile\" in the default prompt with another verb. E.g. `org-copy' sets this parameter to \"Copy\". -See also `org-refile-use-outline-path' and `org-completion-use-ido'. +See also `org-refile-use-outline-path'. -If you are using target caching (see `org-refile-use-cache'), -you have to clear the target cache in order to find new targets. -This can be done with a 0 prefix (`C-0 C-c C-w') or a triple +If you are using target caching (see `org-refile-use-cache'), you +have to clear the target cache in order to find new targets. +This can be done with a `0' prefix (`C-0 C-c C-w') or a triple prefix argument (`C-u C-u C-u C-c C-w')." - (interactive "P") - (if (member goto '(0 (64))) + (if (member arg '(0 (64))) (org-refile-cache-clear) (let* ((actionmsg (cond (msg msg) - ((equal goto 3) "Refile (and keep)") + ((equal arg 3) "Refile (and keep)") (t "Refile"))) - (cbuf (current-buffer)) (regionp (org-region-active-p)) (region-start (and regionp (region-beginning))) (region-end (and regionp (region-end))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) - (org-refile-keep (if (equal goto 3) t org-refile-keep)) - pos it nbuf file re level reversed) + (org-refile-keep (if (equal arg 3) t org-refile-keep)) + pos it nbuf file level reversed) (setq last-command nil) (when regionp (goto-char region-start) @@ -11610,10 +11936,10 @@ prefix argument (`C-u C-u C-u C-c C-w')." (org-toggle-heading) (setq region-end (+ (- (point-at-eol) s) region-end))))) (user-error "The region is not a (sequence of) subtree(s)"))) - (if (equal goto '(16)) + (if (equal arg '(16)) (org-refile-goto-last-stored) (when (or - (and (equal goto 2) + (and (equal arg 2) org-clock-hd-marker (marker-buffer org-clock-hd-marker) (prog1 (setq it (list (or org-clock-heading "running clock") @@ -11621,43 +11947,44 @@ prefix argument (`C-u C-u C-u C-c C-w')." (marker-buffer org-clock-hd-marker)) "" (marker-position org-clock-hd-marker))) - (setq goto nil))) - (setq it (or rfloc - (let (heading-text) - (save-excursion - (unless (and goto (listp goto)) - (org-back-to-heading t) - (setq heading-text - (nth 4 (org-heading-components)))) - - (org-refile-get-location - (cond ((and goto (listp goto)) "Goto") - (regionp (concat actionmsg " region to")) - (t (concat actionmsg " subtree \"" - heading-text "\" to"))) - default-buffer - (and (not (equal '(4) goto)) - org-refile-allow-creating-parent-nodes) - goto)))))) + (setq arg nil))) + (setq it + (or rfloc + (let (heading-text) + (save-excursion + (unless (and arg (listp arg)) + (org-back-to-heading t) + (setq heading-text + (replace-regexp-in-string + org-bracket-link-regexp + "\\3" + (or (nth 4 (org-heading-components)) + "")))) + (org-refile-get-location + (cond ((and arg (listp arg)) "Goto") + (regionp (concat actionmsg " region to")) + (t (concat actionmsg " subtree \"" + heading-text "\" to"))) + default-buffer + (and (not (equal '(4) arg)) + org-refile-allow-creating-parent-nodes))))))) (setq file (nth 1 it) - re (nth 2 it) pos (nth 3 it)) - (if (and (not goto) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) - + (when (and (not arg) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) - (if (and goto (not (equal goto 3))) + (if (and arg (not (equal arg 3))) (progn - (org-pop-to-buffer-same-window nbuf) + (pop-to-buffer-same-window nbuf) (goto-char pos) (org-show-context 'org-goto)) (if regionp @@ -11668,50 +11995,48 @@ prefix argument (`C-u C-u C-u C-c C-w')." (with-current-buffer (setq nbuf (or (find-buffer-visiting file) (find-file-noselect file))) (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at org-outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (org-paste-subtree level) - (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos org-log-refile) - (unless (eq org-log-refile 'note) - (save-excursion (org-add-log-note)))) - (and org-auto-align-tags - (let ((org-loop-over-headlines-in-active-region nil)) - (org-set-tags nil t))) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-refile))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - ;; If we are refiling for capture, make sure that the - ;; last-capture pointers point here - (when (org-bound-and-true-p org-refile-for-capture) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture-marker))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) + (org-with-wide-buffer + (if pos + (progn + (goto-char pos) + (looking-at org-outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (unless (bolp) (newline)) + (org-paste-subtree level nil nil t) + (when org-log-refile + (org-add-log-setup 'refile nil nil org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-set-tags nil t))) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (bound-and-true-p org-capture-is-refiling) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + (move-marker org-capture-last-stored-marker (point))) + (when (fboundp 'deactivate-mark) (deactivate-mark)) + (run-hooks 'org-after-refile-insert-hook))) (unless org-refile-keep (if regionp (delete-region (point) (+ (point) (- region-end region-start))) @@ -11726,7 +12051,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (defun org-refile-goto-last-stored () "Go to the location where the last refile was stored." (interactive) - (bookmark-jump "org-refile-last-stored") + (bookmark-jump (plist-get org-bookmark-names-plist :last-refile)) (message "This is the location of the last refile")) (defun org-refile--get-location (refloc tbl) @@ -11740,35 +12065,22 @@ Also check `org-refile-target-table'." (list (replace-regexp-in-string "/$" "" refloc) (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc)))))) -(defun org-refile-get-location (&optional prompt default-buffer new-nodes - no-exclude) +(defun org-refile-get-location (&optional prompt default-buffer new-nodes) "Prompt the user for a refile location, using PROMPT. PROMPT should not be suffixed with a colon and a space, because this function appends the default value from -`org-refile-history' automatically, if that is not empty. -When NO-EXCLUDE is set, do not exclude headlines in the current subtree, -this is used for the GOTO interface." +`org-refile-history' automatically, if that is not empty." (let ((org-refile-targets org-refile-targets) - (org-refile-use-outline-path org-refile-use-outline-path) - excluded-entries) - (when (and (derived-mode-p 'org-mode) - (not org-refile-use-cache) - (not no-exclude)) - (org-map-tree - (lambda() - (setq excluded-entries - (append excluded-entries (list (org-get-heading t t))))))) - (setq org-refile-target-table - (org-refile-get-targets default-buffer excluded-entries))) + (org-refile-use-outline-path org-refile-use-outline-path)) + (setq org-refile-target-table (org-refile-get-targets default-buffer))) (unless org-refile-target-table (user-error "No refile targets")) (let* ((cbuf (current-buffer)) - (partial-completion-mode nil) (cfn (buffer-file-name (buffer-base-buffer cbuf))) (cfunc (if (and org-refile-use-outline-path org-outline-path-complete-in-steps) - 'org-olpath-completing-read - 'org-icompleting-read)) + #'org-olpath-completing-read + #'completing-read)) (extra (if org-refile-use-outline-path "/" "")) (cbnex (concat (buffer-name) extra)) (filename (and cfn (expand-file-name cfn))) @@ -11803,8 +12115,8 @@ this is used for the GOTO interface." (cons (car pa) (if (assoc (car org-refile-history) tbl) org-refile-history (cdr org-refile-history)))) - (if (equal (car org-refile-history) (nth 1 org-refile-history)) - (pop org-refile-history))) + (when (equal (car org-refile-history) (nth 1 org-refile-history)) + (pop org-refile-history))) pa) (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) (progn @@ -11827,20 +12139,18 @@ this is used for the GOTO interface." (pos (nth 3 refile-pointer)) buffer) (if (and (not (markerp pos)) (not file)) - (user-error "Please save the buffer to a file before refiling") + (user-error "Please indicate a target file in the refile path") (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) (or (find-buffer-visiting file) (find-file-noselect file)))) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (beginning-of-line 1) - (unless (org-looking-at-p re) - (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) + (org-with-wide-buffer + (goto-char pos) + (beginning-of-line 1) + (unless (looking-at-p re) + (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling")))))))) (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." @@ -11851,53 +12161,43 @@ this is used for the GOTO interface." level) (with-current-buffer (or (find-buffer-visiting file) (find-file-noselect file)) - (save-excursion - (save-restriction - (widen) - (if pos - (goto-char pos) - (goto-char (point-max)) - (if (not (bolp)) (newline))) - (when (looking-at org-outline-regexp) - (setq level (funcall outline-level)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (insert "\n" (make-string - (if pos (org-get-valid-level level 1) 1) ?*) - " " child "\n") - (beginning-of-line 0) - (list (concat (car parent-target) "/" child) file "" (point))))))) + (org-with-wide-buffer + (if pos + (goto-char pos) + (goto-char (point-max)) + (unless (bolp) (newline))) + (when (looking-at org-outline-regexp) + (setq level (funcall outline-level)) + (org-end-of-subtree t t)) + (org-back-over-empty-lines) + (insert "\n" (make-string + (if pos (org-get-valid-level level 1) 1) ?*) + " " child "\n") + (beginning-of-line 0) + (list (concat (car parent-target) "/" child) file "" (point)))))) (defun org-olpath-completing-read (prompt collection &rest args) "Read an outline path like a file name." - (let ((thetable collection) - (org-completion-use-ido nil) ; does not work with ido. - (org-completion-use-iswitchb nil)) ; or iswitchb - (apply - 'org-icompleting-read prompt - (lambda (string predicate &optional flag) - (let (rtn r f (l (length string))) - (cond - ((eq flag nil) - ;; try completion - (try-completion string thetable)) - ((eq flag t) - ;; all-completions - (setq rtn (all-completions string thetable predicate)) - (mapcar - (lambda (x) - (setq r (substring x l)) - (if (string-match " ([^)]*)$" x) - (setq f (match-string 0 x)) - (setq f "")) - (if (string-match "/" r) - (concat string (substring r 0 (match-end 0)) f) - x)) - rtn)) - ((eq flag 'lambda) - ;; exact match? - (assoc string thetable))))) - args))) + (let ((thetable collection)) + (apply #'completing-read + prompt + (lambda (string predicate &optional flag) + (cond + ((eq flag nil) (try-completion string thetable)) + ((eq flag t) + (let ((l (length string))) + (mapcar (lambda (x) + (let ((r (substring x l)) + (f (if (string-match " ([^)]*)$" x) + (match-string 0 x) + ""))) + (if (string-match "/" r) + (concat string (substring r 0 (match-end 0)) f) + x))) + (all-completions string thetable predicate)))) + ;; Exact match? + ((eq flag 'lambda) (assoc string thetable)))) + args))) ;;;; Dynamic blocks @@ -11910,19 +12210,12 @@ If not found, stay at current position and return nil." (setq pos (and (re-search-forward (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) (match-beginning 0)))) - (if pos (goto-char pos)) + (when pos (goto-char pos)) pos)) -(defconst org-dblock-start-re - "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" - "Matches the start line of a dynamic block, with parameters.") - -(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" - "Matches the end of a dynamic block.") - (defun org-create-dblock (plist) "Create a dynamic block section, with parameters taken from PLIST. -PLIST must contain a :name entry which is used as name of the block." +PLIST must contain a :name entry which is used as the name of the block." (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) (end-of-line 1) (newline)) @@ -12042,13 +12335,14 @@ This function can be used in a hook." ;;;; Completion +(declare-function org-export-backend-options "ox" (cl-x) t) (defun org-get-export-keywords () "Return a list of all currently understood export keywords. Export keywords include options, block names, attributes and keywords relative to each registered export back-end." (let (keywords) (dolist (backend - (org-bound-and-true-p org-export--registered-backends) + (bound-and-true-p org-export-registered-backends) (delq nil keywords)) ;; Back-end name (for keywords, like #+LATEX:) (push (upcase (symbol-name (org-export-backend-name backend))) keywords) @@ -12064,27 +12358,24 @@ keywords relative to each registered export back-end." "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) (defcustom org-structure-template-alist - '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "\n\n") - ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "\n?\n") - ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "\n?\n") - ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "\n?\n") - ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "\n?\n") - ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "
    \n?\n
    ") - ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" - "\n?\n") - ("L" "#+LaTeX: " "?") - ("h" "#+BEGIN_HTML\n?\n#+END_HTML" - "\n?\n") - ("H" "#+HTML: " "?") - ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "") - ("A" "#+ASCII: " "") - ("i" "#+INDEX: ?" "#+INDEX: ?") - ("I" "#+INCLUDE: %file ?" - "")) + '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE") + ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE") + ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM") + ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER") + ("l" "#+BEGIN_EXPORT latex\n?\n#+END_EXPORT") + ("L" "#+LaTeX: ") + ("h" "#+BEGIN_EXPORT html\n?\n#+END_EXPORT") + ("H" "#+HTML: ") + ("a" "#+BEGIN_EXPORT ascii\n?\n#+END_EXPORT") + ("A" "#+ASCII: ") + ("i" "#+INDEX: ?") + ("I" "#+INCLUDE: %file ?")) "Structure completion elements. This is a list of abbreviation keys and values. The value gets inserted if you type `<' followed by the key and then press the completion key, -usually `M-TAB'. %file will be replaced by a file name after prompting +usually `TAB'. %file will be replaced by a file name after prompting for the file using completion. The cursor will be placed at the position of the `?' in the template. There are two templates for each key, the first uses the original Org syntax, @@ -12095,8 +12386,9 @@ variable `org-mtags-prefer-muse-templates'." :type '(repeat (list (string :tag "Key") - (string :tag "Template") - (string :tag "Muse Template")))) + (string :tag "Template"))) + :version "26.1" + :package-version '(Org . "8.3")) (defun org-try-structure-completion () "Try to complete a structure template before point. @@ -12113,29 +12405,28 @@ expands them." (defun org-complete-expand-structure-template (start cell) "Expand a structure template." - (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) - (rpl (nth (if musep 2 1) cell)) - (ind "")) + (let ((rpl (nth 1 cell)) + (ind "")) (delete-region start (point)) - (when (string-match "\\`#\\+" rpl) + (when (string-match "\\`[ \t]*#\\+" rpl) (cond ((bolp)) ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) (setq ind (buffer-substring (point-at-bol) (point)))) (t (newline)))) (setq start (point)) - (if (string-match "%file" rpl) - (setq rpl (replace-match - (concat - "\"" - (save-match-data - (abbreviate-file-name (read-file-name "Include file: "))) - "\"") - t t rpl))) + (when (string-match "%file" rpl) + (setq rpl (replace-match + (concat + "\"" + (save-match-data + (abbreviate-file-name (read-file-name "Include file: "))) + "\"") + t t rpl))) (setq rpl (mapconcat 'identity (split-string rpl "\n") (concat "\n" ind))) (insert rpl) - (if (re-search-backward "\\?" start t) (delete-char 1)))) + (when (re-search-backward "\\?" start t) (delete-char 1)))) ;;;; TODO, DEADLINE, Comments @@ -12144,17 +12435,18 @@ expands them." (interactive) (save-excursion (org-back-to-heading) - (let (case-fold-search) - (cond - ((looking-at (format org-heading-keyword-regexp-format - org-comment-string)) - (goto-char (match-end 1)) - (looking-at (concat " +" org-comment-string)) - (replace-match "" t t) - (when (eolp) (insert " "))) - ((looking-at org-outline-regexp) - (goto-char (match-end 0)) - (insert org-comment-string " ")))))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + (goto-char (or (match-end 3) (match-end 2) (match-end 1))) + (skip-chars-forward " \t") + (unless (memq (char-before) '(?\s ?\t)) (insert " ")) + (if (org-in-commented-heading-p t) + (delete-region (point) + (progn (search-forward " " (line-end-position) 'move) + (skip-chars-forward " \t") + (point))) + (insert org-comment-string) + (unless (eolp) (insert " "))))) (defvar org-last-todo-state-is-todo nil "This is non-nil when the last TODO state change led to a TODO state. @@ -12193,43 +12485,65 @@ nil or a string to be used for the todo mark." ) (interactive "P") (if (eq major-mode 'org-agenda-mode) (apply 'org-agenda-todo-yesterday arg) - (let* ((hour (third (decode-time - (org-current-time)))) + (let* ((org-use-effective-time t) + (hour (nth 2 (decode-time (org-current-time)))) (org-extend-today-until (1+ hour))) (org-todo arg)))) (defvar org-block-entry-blocking "" "First entry preventing the TODO state change.") +(defun org-cancel-repeater () + "Cancel a repeater by setting its numeric value to zero." + (interactive) + (save-excursion + (org-back-to-heading t) + (let ((bound1 (point)) + (bound0 (save-excursion (outline-next-heading) (point)))) + (when (and (re-search-forward + (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" + org-deadline-time-regexp "\\)\\|\\(" + org-ts-regexp "\\)") + bound0 t) + (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" + bound1 t)) + (replace-match "0" t nil nil 1))))) + +(defvar org-state) +(defvar org-blocked-by-checkboxes) (defun org-todo (&optional arg) "Change the TODO state of an item. + The state of an item is given by a keyword at the start of the heading, like *** TODO Write paper *** DONE Call mom The different keywords are specified in the variable `org-todo-keywords'. -By default the available states are \"TODO\" and \"DONE\". -So for this example: when the item starts with TODO, it is changed to DONE. +By default the available states are \"TODO\" and \"DONE\". So, for this +example: when the item starts with TODO, it is changed to DONE. When it starts with DONE, the DONE is removed. And when neither TODO nor DONE are present, add TODO at the beginning of the heading. -With \\[universal-argument] prefix arg, use completion to determine the new \ +With `\\[universal-argument]' prefix ARG, use completion to determine the new \ state. -With numeric prefix arg, switch to that state. -With a double \\[universal-argument] prefix, switch to the next set of TODO \ +With numeric prefix ARG, switch to that state. +With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \ +next set of TODO \ keywords (nextset). -With a triple \\[universal-argument] prefix, circumvent any state blocking. +With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \ +prefix, circumvent any state blocking. With a numeric prefix arg of 0, inhibit note taking for the change. - -For calling through lisp, arg is also interpreted in the following way: -`none' -> empty state -\"\" (empty string) -> switch to empty state -`done' -> switch to DONE -`nextset' -> switch to the next set of keywords -`previousset' -> switch to the previous set of keywords -\"WAITING\" -> switch to the specified keyword, but only if it - really is a member of `org-todo-keywords'." +With a numeric prefix arg of -1, cancel repeater to allow marking as DONE. + +When called through ELisp, arg is also interpreted in the following way: +`none' -> empty state +\"\" -> switch to empty state +`done' -> switch to DONE +`nextset' -> switch to the next set of keywords +`previousset' -> switch to the previous set of keywords +\"WAITING\" -> switch to the specified keyword, but only if it + really is a member of `org-todo-keywords'." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) @@ -12238,8 +12552,9 @@ For calling through lisp, arg is also interpreted in the following way: (org-map-entries `(org-todo ,arg) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if (equal arg '(16)) (setq arg 'nextset)) + cl (when (org-invisible-p) (org-end-of-subtree nil t)))) + (when (equal arg '(16)) (setq arg 'nextset)) + (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) (let ((org-blocker-hook org-blocker-hook) commentp case-fold-search) @@ -12252,10 +12567,10 @@ For calling through lisp, arg is also interpreted in the following way: (save-excursion (catch 'exit (org-back-to-heading t) - (when (looking-at (concat "^\\*+ " org-comment-string)) + (when (org-in-commented-heading-p t) (org-toggle-comment) (setq commentp t)) - (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) + (when (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) (looking-at "\\(?: *\\|[ \t]*$\\)")) (let* ((match-data (match-data)) @@ -12285,31 +12600,30 @@ For calling through lisp, arg is also interpreted in the following way: (and (not arg) org-use-fast-todo-selection (not (eq org-use-fast-todo-selection 'prefix))))) - ;; Use fast selection + ;; Use fast selection. (org-fast-todo-selection)) ((and (equal arg '(4)) (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) - ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar 'list org-todo-keywords-1) + ;; Read a state with completion. + (completing-read + "State: " (mapcar #'list org-todo-keywords-1) nil t)) ((eq arg 'right) (if this (if tail (car tail) nil) (car org-todo-keywords-1))) ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil + (unless (equal member org-todo-keywords-1) (if this (nth (- (length org-todo-keywords-1) (length tail) 2) org-todo-keywords-1) (org-last org-todo-keywords-1)))) ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling + (setq arg nil))) ;hack to fall back to cycling (arg - ;; user or caller requests a specific state + ;; User or caller requests a specific state. (cond ((equal arg "") nil) ((eq arg 'none) nil) @@ -12327,8 +12641,8 @@ For calling through lisp, arg is also interpreted in the following way: ((nth (1- (prefix-numeric-value arg)) org-todo-keywords-1)))) ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry + ((equal this final-done-word) nil) ;-> make empty + ((null tail) nil) ;-> first entry ((memq interpret '(type priority)) (if (eq this-command last-command) (car tail) @@ -12346,24 +12660,30 @@ For calling through lisp, arg is also interpreted in the following way: :position startpos)) dolog now-done-p) (when org-blocker-hook - (setq org-last-todo-state-is-todo - (not (member this org-done-keywords))) - (unless (save-excursion - (save-match-data - (org-with-wide-buffer - (run-hook-with-args-until-failure - 'org-blocker-hook change-plist)))) - (if (org-called-interactively-p 'interactive) - (user-error "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - ;; fail silently - (message "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - (throw 'exit nil)))) + (let (org-blocked-by-checkboxes block-reason) + (setq org-last-todo-state-is-todo + (not (member this org-done-keywords))) + (unless (save-excursion + (save-match-data + (org-with-wide-buffer + (run-hook-with-args-until-failure + 'org-blocker-hook change-plist)))) + (setq block-reason (if org-blocked-by-checkboxes + "contained checkboxes" + (format "\"%s\"" org-block-entry-blocking))) + (if (called-interactively-p 'interactive) + (user-error "TODO state change from %s to %s blocked (by %s)" + this org-state block-reason) + ;; Fail silently. + (message "TODO state change from %s to %s blocked (by %s)" + this org-state block-reason) + (throw 'exit nil))))) (store-match-data match-data) (replace-match next t t) - (unless (pos-visible-in-window-p hl-pos) - (message "TODO state changed to %s" (org-trim next))) + (cond ((equal this org-state) + (message "TODO state was already %s" (org-trim next))) + ((pos-visible-in-window-p hl-pos) + (message "TODO state changed to %s" (org-trim next)))) (unless head (setq head (org-get-todo-sequence-head org-state) ass (assoc head org-todo-kwd-alist) @@ -12384,11 +12704,11 @@ For calling through lisp, arg is also interpreted in the following way: (when (and (or org-todo-log-states org-log-done) (not (eq org-inhibit-logging t)) (not (memq arg '(nextset previousset)))) - ;; we need to look at recording a time and note + ;; We need to look at recording a time and note. (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) (nth 2 (assoc this org-todo-log-states)))) - (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) - (setq dolog 'time)) + (when (and (eq dolog 'note) (eq org-inhibit-logging 'note)) + (setq dolog 'time)) (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) (and org-state (member org-state org-not-done-keywords) @@ -12397,21 +12717,21 @@ For calling through lisp, arg is also interpreted in the following way: ;; If there was a CLOSED time stamp, get rid of it. (org-add-planning-info nil nil 'closed)) (when (and now-done-p org-log-done) - ;; It is now done, and it was not done before + ;; It is now done, and it was not done before. (org-add-planning-info 'closed (org-current-effective-time)) - (if (and (not dolog) (eq 'note org-log-done)) - (org-add-log-setup 'done org-state this 'findpos 'note))) + (when (and (not dolog) (eq 'note org-log-done)) + (org-add-log-setup 'done org-state this 'note))) (when (and org-state dolog) - ;; This is a non-nil state, and we need to log it - (org-add-log-setup 'state org-state this 'findpos dolog))) - ;; Fixup tag positioning + ;; This is a non-nil state, and we need to log it. + (org-add-log-setup 'state org-state this dolog))) + ;; Fixup tag positioning. (org-todo-trigger-tag-changes org-state) (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) (when org-provide-todo-statistics (org-update-parent-todo-statistics)) (run-hooks 'org-after-todo-state-change-hook) - (if (and arg (not (member org-state org-done-keywords))) - (setq head (org-get-todo-sequence-head org-state))) + (when (and arg (not (member org-state org-done-keywords))) + (setq head (org-get-todo-sequence-head org-state))) (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) ;; Do we need to trigger a repeat? (when now-done-p @@ -12421,15 +12741,14 @@ For calling through lisp, arg is also interpreted in the following way: (setq org-agenda-headline-snapshot-before-repeat (org-get-heading)))) (org-auto-repeat-maybe org-state)) - ;; Fixup cursor location if close to the keyword - (if (and (outline-on-heading-p) - (not (bolp)) - (save-excursion (beginning-of-line 1) - (looking-at org-todo-line-regexp)) - (< (point) (+ 2 (or (match-end 2) (match-end 1))))) - (progn - (goto-char (or (match-end 2) (match-end 1))) - (and (looking-at " ") (just-one-space)))) + ;; Fixup cursor location if close to the keyword. + (when (and (outline-on-heading-p) + (not (bolp)) + (save-excursion (beginning-of-line 1) + (looking-at org-todo-line-regexp)) + (< (point) (+ 2 (or (match-end 2) (match-end 1))))) + (goto-char (or (match-end 2) (match-end 1))) + (and (looking-at " ") (just-one-space))) (when org-trigger-hook (save-excursion (run-hook-with-args 'org-trigger-hook change-plist))) @@ -12471,10 +12790,10 @@ changes. Such blocking occurs when: (> child-level this-level)) ;; this todo has children, check whether they are all ;; completed - (if (and (not (org-entry-is-done-p)) - (org-entry-is-todo-p)) - (progn (setq org-block-entry-blocking (org-get-heading)) - (throw 'dont-block nil))) + (when (and (not (org-entry-is-done-p)) + (org-entry-is-todo-p)) + (setq org-block-entry-blocking (org-get-heading)) + (throw 'dont-block nil)) (outline-next-heading) (setq child-level (funcall outline-level)))))) ;; Otherwise, if the task's parent has the :ORDERED: property, and @@ -12482,8 +12801,9 @@ changes. Such blocking occurs when: (save-excursion (org-back-to-heading t) (let* ((pos (point)) - (parent-pos (and (org-up-heading-safe) (point)))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent + (parent-pos (and (org-up-heading-safe) (point))) + (case-fold-search nil)) + (unless parent-pos (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t)) @@ -12492,11 +12812,11 @@ changes. Such blocking occurs when: ;; Search further up the hierarchy, to see if an ancestor is blocked (while t (goto-char parent-pos) - (if (not (looking-at org-not-done-heading-regexp)) - (throw 'dont-block t)) ; do not block, parent is not a TODO + (unless (looking-at org-not-done-heading-regexp) + (throw 'dont-block t)) ; do not block, parent is not a TODO (setq pos (point)) (setq parent-pos (and (org-up-heading-safe) (point))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent + (unless parent-pos (throw 'dont-block t)) ; no parent (when (and (org-not-nil (org-entry-get (point) "ORDERED")) (forward-line 1) (re-search-forward org-not-done-heading-regexp pos t) @@ -12533,14 +12853,13 @@ See variable `org-track-ordered-property-with-tag'." (org-back-to-heading) (if (org-entry-get nil "ORDERED") (progn - (org-delete-property "ORDERED" "PROPERTIES") + (org-delete-property "ORDERED") (and tag (org-toggle-tag tag 'off)) (message "Subtasks can be completed in arbitrary order")) (org-entry-put nil "ORDERED" "t") (and tag (org-toggle-tag tag 'on)) (message "Subtasks must be completed in sequence"))))) -(defvar org-blocked-by-checkboxes) ; dynamically scoped (defun org-block-todo-from-checkboxes (change-plist) "Block turning an entry into a TODO, using checkboxes. This checks whether the current task should be blocked from state @@ -12564,32 +12883,32 @@ changes because there are unchecked boxes in this entry." (outline-next-heading) (setq end (point)) (goto-char beg) - (if (org-list-search-forward - (concat (org-item-beginning-re) - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\[[- ]\\]") - end t) - (progn - (if (boundp 'org-blocked-by-checkboxes) - (setq org-blocked-by-checkboxes t)) - (throw 'dont-block nil))))) + (when (org-list-search-forward + (concat (org-item-beginning-re) + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\[[- ]\\]") + end t) + (when (boundp 'org-blocked-by-checkboxes) + (setq org-blocked-by-checkboxes t)) + (throw 'dont-block nil)))) t))) ; do not block (defun org-entry-blocked-p () - "Is the current entry blocked?" - (org-with-silent-modifications - (if (org-entry-get nil "NOBLOCKING") - nil ;; Never block this entry - (not (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point) - :from 'todo - :to 'done)))))) + "Non-nil if entry at point is blocked." + (and (not (org-entry-get nil "NOBLOCKING")) + (member (org-entry-get nil "TODO") org-not-done-keywords) + (not (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done))))) (defun org-update-statistics-cookies (all) "Update the statistics cookie, either from TODO or from checkboxes. -This should be called with the cursor in a line with a statistics cookie." +This should be called with the cursor in a line with a statistics +cookie. When called with a \\[universal-argument] prefix, update +all statistics cookies in the buffer." (interactive "P") (if all (progn @@ -12605,7 +12924,7 @@ This should be called with the cursor in a line with a statistics cookie." (setq l1 (org-outline-level)) (setq end (save-excursion (outline-next-heading) - (if (org-at-heading-p) (setq l2 (org-outline-level))) + (when (org-at-heading-p) (setq l2 (org-outline-level))) (point))) (if (and (save-excursion (re-search-forward @@ -12642,7 +12961,7 @@ statistics everywhere." (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") level ltoggle l1 new ndel (cnt-all 0) (cnt-done 0) is-percent kwd - checkbox-beg ov ovs ove cookie-present) + checkbox-beg cookie-present) (catch 'exit (save-excursion (beginning-of-line 1) @@ -12677,14 +12996,31 @@ statistics everywhere." (setq kwd (and (or recursive (= l1 ltoggle)) (match-string 2))) (if (or (eq org-provide-todo-statistics 'all-headlines) + (and (eq org-provide-todo-statistics t) + (or (member kwd org-done-keywords))) (and (listp org-provide-todo-statistics) + (stringp (car org-provide-todo-statistics)) (or (member kwd org-provide-todo-statistics) - (member kwd org-done-keywords)))) + (member kwd org-done-keywords))) + (and (listp org-provide-todo-statistics) + (listp (car org-provide-todo-statistics)) + (or (member kwd (car org-provide-todo-statistics)) + (and (member kwd org-done-keywords) + (member kwd (cadr org-provide-todo-statistics)))))) (setq cnt-all (1+ cnt-all)) - (if (eq org-provide-todo-statistics t) - (and kwd (setq cnt-all (1+ cnt-all))))) - (and (member kwd org-done-keywords) - (setq cnt-done (1+ cnt-done))) + (and (eq org-provide-todo-statistics t) + kwd + (setq cnt-all (1+ cnt-all)))) + (when (or (and (member org-provide-todo-statistics '(t all-headlines)) + (member kwd org-done-keywords)) + (and (listp org-provide-todo-statistics) + (listp (car org-provide-todo-statistics)) + (member kwd org-done-keywords) + (member kwd (cadr org-provide-todo-statistics))) + (and (listp org-provide-todo-statistics) + (stringp (car org-provide-todo-statistics)) + (member kwd org-done-keywords))) + (setq cnt-done (1+ cnt-done))) (outline-next-heading))) (setq new (if is-percent @@ -12692,15 +13028,10 @@ statistics everywhere." (max 1 cnt-all))) (format "[%d/%d]" cnt-done cnt-all)) ndel (- (match-end 0) checkbox-beg)) - ;; handle overlays when updating cookie from column view - (when (setq ov (car (overlays-at checkbox-beg))) - (setq ovs (overlay-start ov) ove (overlay-end ov)) - (delete-overlay ov)) (goto-char checkbox-beg) (insert new) (delete-region (point) (+ (point) ndel)) - (when org-auto-align-tags (org-fix-tags-on-the-fly)) - (when ov (move-overlay ov ovs ove))) + (when org-auto-align-tags (org-fix-tags-on-the-fly))) (when cookie-present (run-hook-with-args 'org-after-todo-statistics-hook cnt-done (- cnt-all cnt-done)))))) @@ -12736,9 +13067,9 @@ This hook runs even if there is no statistics cookie present, in which case (when (and (stringp state) (> (length state) 0)) (setq changes (append changes (cdr (assoc state l))))) (when (member state org-not-done-keywords) - (setq changes (append changes (cdr (assoc 'todo l))))) + (setq changes (append changes (cdr (assq 'todo l))))) (when (member state org-done-keywords) - (setq changes (append changes (cdr (assoc 'done l))))) + (setq changes (append changes (cdr (assq 'done l))))) (dolist (c changes) (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) @@ -12749,7 +13080,7 @@ This hook runs even if there is no statistics cookie present, in which case org-log-repeat nil org-todo-log-states nil) (dolist (w (org-split-string value)) - (let* (a) + (let (a) (cond ((setq a (assoc w org-startup-options)) (and (member (nth 1 a) '(org-log-done org-log-repeat)) @@ -12786,7 +13117,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (expert nil) (fwidth (+ maxlen 3 1 3)) (ncol (/ (- (window-width) 4) fwidth)) - tg cnt c tbl + tg cnt e c tbl groups ingroup) (save-excursion (save-window-excursion @@ -12794,13 +13125,13 @@ Returns the new TODO keyword, or nil if no state change should occur." (set-buffer (get-buffer-create " *Org todo*")) (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) + (setq-local org-done-keywords done-keywords) (setq tbl fulltable cnt 0) - (dolist (e tbl) + (while (setq e (pop tbl)) (cond ((equal e '(:startgroup)) (push '() groups) (setq ingroup t) - (when (not (= cnt 0)) + (unless (= cnt 0) (setq cnt 0) (insert "\n")) (insert "{ ")) @@ -12808,7 +13139,7 @@ Returns the new TODO keyword, or nil if no state change should occur." (setq ingroup nil cnt 0) (insert "}\n")) ((equal e '(:newline)) - (when (not (= cnt 0)) + (unless (= cnt 0) (setq cnt 0) (insert "\n") (setq e (car tbl)) @@ -12817,19 +13148,19 @@ Returns the new TODO keyword, or nil if no state change should occur." (setq tbl (cdr tbl))))) (t (setq tg (car e) c (cdr e)) - (if ingroup (push tg (car groups))) + (when ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face (org-get-todo-face tg))) - (if (and (= cnt 0) (not ingroup)) (insert " ")) + (when (and (= cnt 0) (not ingroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) (when (= (setq cnt (1+ cnt)) ncol) (insert "\n") - (if ingroup (insert " ")) + (when ingroup (insert " ")) (setq cnt 0))))) (insert "\n") (goto-char (point-min)) - (if (not expert) (org-fit-window-to-buffer)) + (unless expert (org-fit-window-to-buffer)) (message "[a-z..]:Set [SPC]:clear") (setq c (let ((inhibit-quit t)) (read-char-exclusive))) (cond @@ -12851,12 +13182,19 @@ Returns the new TODO keyword, or nil if no state change should occur." "Return the TODO keyword of the current subtree." (save-excursion (org-back-to-heading t) - (and (looking-at org-todo-line-regexp) + (and (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) (match-end 2) (match-string 2)))) (defun org-at-date-range-p (&optional inactive-ok) - "Is the cursor inside a date range?" + "Non-nil if point is inside a date range. + +When optional argument INACTIVE-OK is non-nil, also consider +inactive time ranges. + +When this function returns a non-nil value, match data is set +according to `org-tr-regexp-both' or `org-tr-regexp', depending +on INACTIVE-OK." (interactive) (save-excursion (catch 'exit @@ -12888,14 +13226,15 @@ Returns the new TODO keyword, or nil if no state change should occur." (defvar org-last-inserted-timestamp) (defvar org-log-post-message) (defvar org-log-note-purpose) -(defvar org-log-note-how) +(defvar org-log-note-how nil) (defvar org-log-note-extra) (defun org-auto-repeat-maybe (done-word) - "Check if the current headline contains a repeated deadline/schedule. + "Check if the current headline contains a repeated time-stamp. + If yes, set TODO state back to what it was and change the base date of repeating deadline/scheduled time stamps to new date. + This function is run automatically after each state change to a DONE state." - ;; last-state is dynamically scoped into this function (let* ((repeat (org-get-repeat)) (aa (assoc org-last-state org-todo-kwd-alist)) (interpret (nth 1 aa)) @@ -12903,73 +13242,108 @@ This function is run automatically after each state change to a DONE state." (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) (msg "Entry repeats: ") (org-log-done nil) - (org-todo-log-states nil) - re type n what ts time to-state) - (when repeat - (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") - org-todo-repeat-to-state)) - (unless (and to-state (member to-state org-todo-keywords-1)) - (setq to-state (if (eq interpret 'type) org-last-state head))) - (org-todo to-state) + (org-todo-log-states nil)) + (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) + (when (eq org-log-repeat t) (setq org-log-repeat 'state)) + (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) + org-todo-repeat-to-state))) + (org-todo (cond ((and to-state (member to-state org-todo-keywords-1)) + to-state) + ((eq interpret 'type) org-last-state) + (head) + (t 'none)))) (when (or org-log-repeat (org-entry-get nil "CLOCK")) (org-entry-put nil "LAST_REPEAT" (format-time-string (org-time-stamp-format t t)))) (when org-log-repeat (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) (memq 'org-add-log-note post-command-hook)) - ;; OK, we are already setup for some record - (if (eq org-log-repeat 'note) - ;; make sure we take a note, not only a time stamp - (setq org-log-note-how 'note)) - ;; Set up for taking a record - (org-add-log-setup 'state (or done-word (car org-done-keywords)) + ;; We are already setup for some record. + (when (eq org-log-repeat 'note) + ;; Make sure we take a note, not only a time stamp. + (setq org-log-note-how 'note)) + ;; Set up for taking a record. + (org-add-log-setup 'state + (or done-word (car org-done-keywords)) org-last-state - 'findpos org-log-repeat))) + org-log-repeat))) (org-back-to-heading t) (org-add-planning-info nil nil 'closed) - (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" - org-deadline-time-regexp "\\)\\|\\(" - org-ts-regexp "\\)")) - (while (re-search-forward - re (save-excursion (outline-next-heading) (point)) t) - (setq type (if (match-end 1) org-scheduled-string - (if (match-end 3) org-deadline-string "Plain:")) - ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) - (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) - (setq n (string-to-number (match-string 2 ts)) - what (match-string 3 ts)) - (if (equal what "w") (setq n (* n 7) what "d")) - (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) - (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) - ;; Preparation, see if we need to modify the start date for the change - (when (match-end 1) - (setq time (save-match-data (org-time-string-to-time ts))) + (let ((end (save-excursion (outline-next-heading) (point))) + (planning-re (regexp-opt + (list org-scheduled-string org-deadline-string)))) + (while (re-search-forward org-ts-regexp end t) + (let* ((ts (match-string 0)) + (planning? (org-at-planning-p)) + (type (if (not planning?) "Plain:" + (save-excursion + (re-search-backward + planning-re (line-beginning-position) t) + (match-string 0))))) (cond - ((equal (match-string 1 ts) ".") - ;; Shift starting date to today - (org-timestamp-change - (- (org-today) (time-to-days time)) - 'day)) - ((equal (match-string 1 ts) "+") - (let ((nshiftmax 10) (nshift 0)) - (while (or (= nshift 0) - (<= (time-to-days time) - (time-to-days (current-time)))) - (when (= (incf nshift) nshiftmax) - (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) - (error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (setq time (save-match-data (org-time-string-to-time ts))))) - (org-timestamp-change (- n) (cdr (assoc what whata))) - ;; rematch, so that we have everything in place for the real shift - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) - (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) - (setq msg (concat msg type " " org-last-changed-timestamp " ")))) + ;; Ignore fake time-stamps (e.g., within comments). + ((and (not planning?) + (not (org-at-property-p)) + (not (eq 'timestamp + (org-element-type (save-excursion + (backward-char) + (org-element-context))))))) + ;; Time-stamps without a repeater are usually skipped. + ;; However, a SCHEDULED time-stamp without one is + ;; removed, as it is considered as no longer relevant. + ((not (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)) + (when (equal type org-scheduled-string) + (org-remove-timestamp-with-keyword type))) + (t + (let ((n (string-to-number (match-string 2 ts))) + (what (match-string 3 ts))) + (when (equal what "w") (setq n (* n 7) what "d")) + (when (and (equal what "h") + (not (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" + ts))) + (user-error + "Cannot repeat in Repeat in %d hour(s) because no hour \ +has been set" + n)) + ;; Preparation, see if we need to modify the start + ;; date for the change. + (when (match-end 1) + (let ((time (save-match-data (org-time-string-to-time ts)))) + (cond + ((equal (match-string 1 ts) ".") + ;; Shift starting date to today + (org-timestamp-change + (- (org-today) (time-to-days time)) + 'day)) + ((equal (match-string 1 ts) "+") + (let ((nshiftmax 10) + (nshift 0)) + (while (or (= nshift 0) + (not (time-less-p (current-time) time))) + (when (= (cl-incf nshift) nshiftmax) + (or (y-or-n-p + (format "%d repeater intervals were not \ +enough to shift date past today. Continue? " + nshift)) + (user-error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (setq time + (save-match-data + (org-time-string-to-time ts))))) + (org-timestamp-change (- n) (cdr (assoc what whata))) + ;; Rematch, so that we have everything in place + ;; for the real shift. + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" + ts))))) + (save-excursion + (org-timestamp-change n (cdr (assoc what whata)) nil t)) + (setq msg + (concat + msg type " " org-last-changed-timestamp " ")))))))) (setq org-log-post-message msg) (message "%s" msg)))) @@ -12977,7 +13351,7 @@ This function is run automatically after each state change to a DONE state." "Make a compact tree which shows all headlines marked with TODO. The tree will show the lines where the regexp matches, and all higher headlines above the match. -With a \\[universal-argument] prefix, prompt for a regexp to match. +With a `\\[universal-argument]' prefix, prompt for a regexp to match. With a numeric prefix N, construct a sparse tree for the Nth element of `org-todo-keywords-1'." (interactive "P") @@ -12985,8 +13359,9 @@ of `org-todo-keywords-1'." (kwd-re (cond ((null arg) org-not-done-regexp) ((equal arg '(4)) - (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " - (mapcar 'list org-todo-keywords-1)))) + (let ((kwd + (completing-read "Keyword (or KWD1|KWD2|...): " + (mapcar #'list org-todo-keywords-1)))) (concat "\\(" (mapconcat 'identity (org-split-string kwd "|") "\\|") "\\)\\>"))) @@ -12997,75 +13372,99 @@ of `org-todo-keywords-1'." (message "%d TODO entries found" (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) +(defun org--deadline-or-schedule (arg type time) + "Insert DEADLINE or SCHEDULE information in current entry. +TYPE is either `deadline' or `scheduled'. See `org-deadline' or +`org-schedule' for information about ARG and TIME arguments." + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ +\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Item no longer has a deadline." + "Item is no longer scheduled."))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp))))) + (defun org-deadline (arg &optional time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. With one universal prefix argument, remove any deadline from the item. With two universal prefix arguments, prompt for a warning delay. With argument TIME, set the deadline at the corresponding date. TIME -can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-deadline ',arg ,time) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "DEADLINE")) - (old-date-time (if old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date 'findpos - org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-deadline-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-deadline-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Warn starting from" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No deadline information to update")))) - (t - (org-add-planning-info 'deadline time 'closed) - (when (and old-date org-log-redeadline - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'redeadline nil old-date 'findpos - org-log-redeadline)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-deadline-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp)))))) +can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'deadline time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'deadline time))) (defun org-schedule (arg &optional time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. @@ -13075,68 +13474,14 @@ With argument TIME, scheduled at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-schedule ',arg ,time) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "SCHEDULED")) - (old-date-time (if old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date 'findpos - org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled."))) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-scheduled-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-scheduled-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Delay until" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No scheduled information to update")))) - (t - (org-add-planning-info 'scheduled time 'closed) - (when (and old-date org-log-reschedule - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'reschedule nil old-date 'findpos - org-log-reschedule)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-scheduled-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp)))))) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'scheduled time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'scheduled time))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable @@ -13167,24 +13512,36 @@ nil." (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) (equal (char-before) ?\ )) (backward-delete-char 1) - (if (string-match "^[ \t]*$" (buffer-substring - (point-at-bol) (point-at-eol))) - (delete-region (point-at-bol) - (min (point-max) (1+ (point-at-eol)))))))))) + (when (string-match "^[ \t]*$" (buffer-substring + (point-at-bol) (point-at-eol))) + (delete-region (point-at-bol) + (min (point-max) (1+ (point-at-eol)))))))))) (defvar org-time-was-given) ; dynamically scoped parameter (defvar org-end-time-was-given) ; dynamically scoped parameter -(defun org-add-planning-info (what &optional time &rest remove) - "Insert new timestamp with keyword in the line directly after the headline. -WHAT indicates what kind of time stamp to add. TIME indicates the time to use. -If non is given, the user is prompted for a date. -REMOVE indicates what kind of entries to remove. An old WHAT entry will also -be removed." - (interactive) - (let (org-time-was-given org-end-time-was-given ts - end default-time default-input) +(defun org-at-planning-p () + "Non-nil when point is on a planning info line." + ;; This is as accurate and faster than `org-element-at-point' since + ;; planning info location is fixed in the section. + (org-with-wide-buffer + (beginning-of-line) + (and (looking-at-p org-planning-line-re) + (eq (point) + (ignore-errors + (if (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p)) + (org-back-to-heading t) + (org-with-limited-levels (org-back-to-heading t))) + (line-beginning-position 2)))))) +(defun org-add-planning-info (what &optional time &rest remove) + "Insert new timestamp with keyword in the planning line. +WHAT indicates what kind of time stamp to add. It is a symbol +among `closed', `deadline', `scheduled' and nil. TIME indicates +the time to use. If none is given, the user is prompted for +a date. REMOVE indicates what kind of entries to remove. An old +WHAT entry will also be removed." + (let (org-time-was-given org-end-time-was-given default-time default-input) (catch 'exit (when (and (memq what '(scheduled deadline)) (or (not time) @@ -13193,108 +13550,98 @@ be removed." ;; Try to get a default date/time from existing timestamp (save-excursion (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time - (apply 'encode-time (org-parse-time-string ts)) - default-input (and ts (org-get-compact-tod ts)))))) + (let ((end (save-excursion (outline-next-heading) (point))) ts) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time (apply 'encode-time (org-parse-time-string ts)) + default-input (and ts (org-get-compact-tod ts))))))) (when what (setq time (if (stringp time) - ;; This is a string (relative or absolute), set proper date - (apply 'encode-time + ;; This is a string (relative or absolute), set + ;; proper date. + (apply #'encode-time (org-read-date-analyze time default-time (decode-time default-time))) ;; If necessary, get the time from the user (or time (org-read-date nil 'to-time nil nil default-time default-input))))) - (when (and org-insert-labeled-timestamps-at-point - (member what '(scheduled deadline))) - (insert - (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") - (org-insert-time-stamp time org-time-was-given - nil nil nil (list org-end-time-was-given)) - (setq what nil)) - (save-excursion - (save-restriction - (let (col list elt ts buffer-invisibility-spec) - (org-back-to-heading t) - (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*")) - (goto-char (match-end 1)) - (setq col (current-column)) - (goto-char (match-end 0)) - (if (eobp) (insert "\n") (forward-char 1)) - (when (and (not what) - (not (looking-at - (concat "[ \t]*" - org-keyword-time-not-clock-regexp)))) - ;; Nothing to add, nothing to remove...... :-) - (throw 'exit nil)) - (if (and (not (looking-at org-outline-regexp)) - (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp - "[^\r\n]*")) - (not (equal (match-string 1) org-clock-string))) - (narrow-to-region (match-beginning 0) (match-end 0)) - (insert-before-markers "\n") - (backward-char 1) - (narrow-to-region (point) (point)) - (and org-adapt-indentation (org-indent-to-column col))) - ;; Check if we have to remove something. - (setq list (cons what remove)) - (while list - (setq elt (pop list)) - (when (or (and (eq elt 'scheduled) - (re-search-forward org-scheduled-time-regexp nil t)) - (and (eq elt 'deadline) - (re-search-forward org-deadline-time-regexp nil t)) - (and (eq elt 'closed) - (re-search-forward org-closed-time-regexp nil t))) - (replace-match "") - (if (looking-at "--+<[^>]+>") (replace-match "")))) - (and (looking-at "[ \t]+") (replace-match "")) - (and org-adapt-indentation (bolp) (org-indent-to-column col)) - (when what - (insert - (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") - (cond ((eq what 'scheduled) org-scheduled-string) - ((eq what 'deadline) org-deadline-string) - ((eq what 'closed) org-closed-string)) - " ") - (setq ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given))) - (insert - (if (not (or (bolp) (eq (char-before) ?\ ) - (memq (char-after) '(32 10)) - (eobp))) " " "")) - (end-of-line 1)) - (goto-char (point-min)) - (widen) - (if (and (looking-at "[ \t]*\n") - (equal (char-before) ?\n)) - (delete-region (1- (point)) (point-at-eol))) - ts)))))) - -(defvar org-log-note-marker (make-marker)) + (org-with-wide-buffer + (org-back-to-heading t) + (forward-line) + (unless (bolp) (insert "\n")) + (cond ((looking-at-p org-planning-line-re) + ;; Move to current indentation. + (skip-chars-forward " \t") + ;; Check if we have to remove something. + (dolist (type (if what (cons what remove) remove)) + (save-excursion + (when (re-search-forward + (cl-case type + (closed org-closed-time-regexp) + (deadline org-deadline-time-regexp) + (scheduled org-scheduled-time-regexp) + (otherwise + (error "Invalid planning type: %s" type))) + (line-end-position) t) + ;; Delete until next keyword or end of line. + (delete-region + (match-beginning 0) + (if (re-search-forward org-keyword-time-not-clock-regexp + (line-end-position) + t) + (match-beginning 0) + (line-end-position)))))) + ;; If there is nothing more to add and no more keyword + ;; is left, remove the line completely. + (if (and (looking-at-p "[ \t]*$") (not what)) + (delete-region (line-beginning-position) + (line-beginning-position 2)) + ;; If we removed last keyword, do not leave trailing + ;; white space at the end of line. + (let ((p (point))) + (save-excursion + (end-of-line) + (unless (= (skip-chars-backward " \t" p) 0) + (delete-region (point) (line-end-position))))))) + ((not what) (throw 'exit nil)) ; Nothing to do. + (t (insert-before-markers "\n") + (backward-char 1) + (when org-adapt-indentation + (indent-to-column (1+ (org-outline-level)))))) + (when what + ;; Insert planning keyword. + (insert (cl-case what + (closed org-closed-string) + (deadline org-deadline-string) + (scheduled org-scheduled-string) + (otherwise (error "Invalid planning type: %s" what))) + " ") + ;; Insert associated timestamp. + (let ((ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given)))) + (unless (eolp) (insert " ")) + ts)))))) + +(defvar org-log-note-marker (make-marker) + "Marker pointing at the entry where the note is to be inserted.") (defvar org-log-note-purpose nil) (defvar org-log-note-state nil) (defvar org-log-note-previous-state nil) -(defvar org-log-note-how nil) (defvar org-log-note-extra nil) (defvar org-log-note-window-configuration nil) (defvar org-log-note-return-to (make-marker)) (defvar org-log-note-effective-time nil "Remembered current time so that dynamically scoped -`org-extend-today-until' affects tha timestamps in state change -log") +`org-extend-today-until' affects timestamps in state change log") (defvar org-log-post-message nil "Message to be displayed after a log note has been stored. @@ -13304,85 +13651,92 @@ The auto-repeater uses this.") "Add a note to the current entry. This is done in the same way as adding a state change note." (interactive) - (org-add-log-setup 'note nil nil 'findpos nil)) + (org-add-log-setup 'note)) -(defvar org-property-end-re) -(defun org-add-log-setup (&optional purpose state prev-state - findpos how extra) +(defun org-log-beginning (&optional create) + "Return expected start of log notes in current entry. +When optional argument CREATE is non-nil, the function creates +a drawer to store notes, if necessary. Returned position ignores +narrowing." + (org-with-wide-buffer + (let ((drawer (org-log-into-drawer))) + (cond + (drawer + (org-end-of-meta-data) + (let ((regexp (concat "^[ \t]*:" (regexp-quote drawer) ":[ \t]*$")) + (end (if (org-at-heading-p) (point) + (save-excursion (outline-next-heading) (point)))) + (case-fold-search t)) + (catch 'exit + ;; Try to find existing drawer. + (while (re-search-forward regexp end t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'drawer) + (let ((cend (org-element-property :contents-end element))) + (when (and (not org-log-states-order-reversed) cend) + (goto-char cend))) + (throw 'exit nil)))) + ;; No drawer found. Create one, if permitted. + (when create + (unless (bolp) (insert "\n")) + (let ((beg (point))) + (insert ":" drawer ":\n:END:\n") + (org-indent-region beg (point))) + (end-of-line -1))))) + (t + (org-end-of-meta-data org-log-state-notes-insert-after-drawers) + (skip-chars-forward " \t\n") + (beginning-of-line) + (unless org-log-states-order-reversed + (org-skip-over-state-notes) + (skip-chars-backward " \t\n") + (forward-line))))) + (if (bolp) (point) (line-beginning-position 2)))) + +(defun org-add-log-setup (&optional purpose state prev-state how extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. -When FINDPOS is non-nil, find the correct position for the note in -the current entry. If not, assume that it can be inserted at point. HOW is an indicator what kind of note should be created. EXTRA is additional text that will be inserted into the notes buffer." - (let* ((org-log-into-drawer (org-log-into-drawer)) - (drawer (cond ((stringp org-log-into-drawer) - org-log-into-drawer) - (org-log-into-drawer "LOGBOOK")))) - (save-restriction - (save-excursion - (when findpos - (org-back-to-heading t) - (narrow-to-region (point) (save-excursion - (outline-next-heading) (point))) - (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*" - "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp - "[^\r\n]*\\)?")) - (goto-char (match-end 0)) - (cond - (drawer - (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$") - nil t) - (progn - (goto-char (match-end 0)) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (1- (match-beginning 0)))))) - (insert "\n:" drawer ":\n:END:") - (beginning-of-line 0) - (org-indent-line) - (beginning-of-line 2) - (org-indent-line) - (end-of-line 0))) - ((and org-log-state-notes-insert-after-drawers - (save-excursion - (forward-line) (looking-at org-drawer-regexp))) - (forward-line) - (while (looking-at org-drawer-regexp) - (goto-char (match-end 0)) - (re-search-forward org-property-end-re (point-max) t) - (forward-line)) - (forward-line -1))) - (unless org-log-states-order-reversed - (and (= (char-after) ?\n) (forward-char 1)) - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r"))) - (move-marker org-log-note-marker (point)) - (setq org-log-note-purpose purpose - org-log-note-state state - org-log-note-previous-state prev-state - org-log-note-how how - org-log-note-extra extra - org-log-note-effective-time (org-current-effective-time)) - (add-hook 'post-command-hook 'org-add-log-note 'append))))) + (move-marker org-log-note-marker (point)) + (setq org-log-note-purpose purpose + org-log-note-state state + org-log-note-previous-state prev-state + org-log-note-how how + org-log-note-extra extra + org-log-note-effective-time (org-current-effective-time)) + (add-hook 'post-command-hook 'org-add-log-note 'append)) (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." - (if (looking-at "\n[ \t]*- State") (forward-char 1)) (when (ignore-errors (goto-char (org-in-item-p))) (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct))) - (while (looking-at "[ \t]*- State") + (prevs (org-list-prevs-alist struct)) + (regexp + (concat "[ \t]*- +" + (replace-regexp-in-string + " +" " +" + (org-replace-escapes + (regexp-quote (cdr (assq 'state org-log-note-headings))) + `(("%d" . ,org-ts-regexp-inactive) + ("%D" . ,org-ts-regexp) + ("%s" . "\"\\S-+\"") + ("%S" . "\"\\S-+\"") + ("%t" . ,org-ts-regexp-inactive) + ("%T" . ,org-ts-regexp) + ("%u" . ".*?") + ("%U" . ".*?"))))))) + (while (looking-at-p regexp) (goto-char (or (org-list-get-next-item (point) struct prevs) (org-list-get-item-end (point) struct))))))) -(defun org-add-log-note (&optional purpose) - "Pop up a window for taking a note, and add this note later at point." +(defun org-add-log-note (&optional _purpose) + "Pop up a window for taking a note, and add this note later." (remove-hook 'post-command-hook 'org-add-log-note) (setq org-log-note-window-configuration (current-window-configuration)) (delete-other-windows) (move-marker org-log-note-return-to (point)) - (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker)) + (pop-to-buffer-same-window (marker-buffer org-log-note-marker)) (goto-char org-log-note-marker) (org-switch-to-buffer-other-window "*Org Note*") (erase-buffer) @@ -13411,23 +13765,23 @@ EXTRA is additional text that will be inserted into the notes buffer." ((eq org-log-note-purpose 'note) "this entry") (t (error "This should not happen"))))) - (if org-log-note-extra (insert org-log-note-extra)) - (org-set-local 'org-finish-function 'org-store-log-note) + (when org-log-note-extra (insert org-log-note-extra)) + (setq-local org-finish-function 'org-store-log-note) (run-hooks 'org-log-buffer-setup-hook))) (defvar org-note-abort nil) ; dynamically scoped (defun org-store-log-note () "Finish taking a log note, and insert it to where it belongs." - (let ((txt (buffer-string))) - (kill-buffer (current-buffer)) - (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind bul) + (let ((txt (prog1 (buffer-string) + (kill-buffer))) + (note (cdr (assq org-log-note-purpose org-log-note-headings))) + lines) (while (string-match "\\`# .*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) - (if (string-match "\\s-+\\'" txt) - (setq txt (replace-match "" t t txt))) + (when (string-match "\\s-+\\'" txt) + (setq txt (replace-match "" t t txt))) (setq lines (org-split-string txt "\n")) - (when (and note (string-match "\\S-" note)) + (when (org-string-nw-p note) (setq note (org-replace-escapes note @@ -13445,74 +13799,83 @@ EXTRA is additional text that will be inserted into the notes buffer." (cons "%D" (format-time-string (org-time-stamp-format nil nil) org-log-note-effective-time)) - (cons "%s" (if org-log-note-state - (concat "\"" org-log-note-state "\"") - "")) - (cons "%S" (if org-log-note-previous-state - (concat "\"" org-log-note-previous-state "\"") - "\"\""))))) - (if lines (setq note (concat note " \\\\"))) + (cons "%s" (cond + ((not org-log-note-state) "") + ((string-match-p org-ts-regexp + org-log-note-state) + (format "\"[%s]\"" + (substring org-log-note-state 1 -1))) + (t (format "\"%s\"" org-log-note-state)))) + (cons "%S" + (cond + ((not org-log-note-previous-state) "") + ((string-match-p org-ts-regexp + org-log-note-previous-state) + (format "\"[%s]\"" + (substring + org-log-note-previous-state 1 -1))) + (t (format "\"%s\"" + org-log-note-previous-state))))))) + (when lines (setq note (concat note " \\\\"))) (push note lines)) - (when (or current-prefix-arg org-note-abort) - (when org-log-into-drawer - (org-remove-empty-drawer-at - (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") - org-log-note-marker)) - (setq lines nil)) - (when lines + (when (and lines (not (or current-prefix-arg org-note-abort))) (with-current-buffer (marker-buffer org-log-note-marker) - (save-excursion - (goto-char org-log-note-marker) - (move-marker org-log-note-marker nil) - (end-of-line 1) - (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (setq ind (save-excursion - (if (ignore-errors (goto-char (org-in-item-p))) - (let ((struct (org-list-struct))) - (org-list-get-ind - (org-list-get-top-point struct) struct)) - (skip-chars-backward " \r\t\n") - (cond - ((and (org-at-heading-p) - org-adapt-indentation) - (1+ (org-current-level))) - ((org-at-heading-p) 0) - (t (org-get-indentation)))))) - (setq bul (org-list-bullet-string "-")) - (org-indent-line-to ind) - (insert bul (pop lines)) - (let ((ind-body (+ (length bul) ind))) - (while lines - (insert "\n") - (org-indent-line-to ind-body) - (insert (pop lines)))) - (message "Note stored") - (org-back-to-heading t) - (org-cycle-hide-drawers 'children)) + (org-with-wide-buffer + ;; Find location for the new note. + (goto-char org-log-note-marker) + (set-marker org-log-note-marker nil) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) + ;; Make sure point is at the beginning of an empty line. + (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) + ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) + ;; In an existing list, add a new item at the top level. + ;; Otherwise, indent line like a regular one. + (let ((itemp (org-in-item-p))) + (if itemp + (indent-line-to + (let ((struct (save-excursion + (goto-char itemp) (org-list-struct)))) + (org-list-get-ind (org-list-get-top-point struct) struct))) + (org-indent-line))) + (insert (org-list-bullet-string "-") (pop lines)) + (let ((ind (org-list-item-body-column (line-beginning-position)))) + (dolist (line lines) + (insert "\n") + (indent-line-to ind) + (insert line))) + (message "Note stored") + (org-back-to-heading t) + (org-cycle-hide-drawers 'children)) ;; Fix `buffer-undo-list' when `org-store-log-note' is called ;; from within `org-add-log-note' because `buffer-undo-list' ;; is then modified outside of `org-with-remote-undo'. (when (eq this-command 'org-agenda-todo) - (setcdr buffer-undo-list (cddr buffer-undo-list))))))) - ;; Don't add undo information when called from `org-agenda-todo' + (setcdr buffer-undo-list (cddr buffer-undo-list)))))) + ;; Don't add undo information when called from `org-agenda-todo'. (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) (set-window-configuration org-log-note-window-configuration) (with-current-buffer (marker-buffer org-log-note-return-to) (goto-char org-log-note-return-to)) (move-marker org-log-note-return-to nil) - (and org-log-post-message (message "%s" org-log-post-message)))) + (when org-log-post-message (message "%s" org-log-post-message)))) -(defun org-remove-empty-drawer-at (drawer pos) - "Remove an empty drawer DRAWER at position POS. +(defun org-remove-empty-drawer-at (pos) + "Remove an empty drawer at position POS. POS may also be a marker." (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (if (org-in-regexp - (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) - (replace-match "")))))) + (org-with-wide-buffer + (goto-char pos) + (let ((drawer (org-element-at-point))) + (when (and (memq (org-element-type drawer) '(drawer property-drawer)) + (not (org-element-property :contents-begin drawer))) + (delete-region (org-element-property :begin drawer) + (progn (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point)))))))) (defvar org-ts-type nil) (defun org-sparse-tree (&optional arg type) @@ -13533,47 +13896,45 @@ D Show deadlines and scheduled items between a date range." (interactive "P") (setq type (or type org-sparse-tree-default-date-type)) (setq org-ts-type type) - (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty - [d]eadlines [b]efore-date [a]fter-date [D]ates range - [c]ycle through date types: %s" - (case type + (message "Sparse tree: [r]egexp [t]odo [T]odo-kwd [m]atch [p]roperty + \[d]eadlines [b]efore-date [a]fter-date [D]ates range + \[c]ycle through date types: %s" + (cl-case type (all "all timestamps") (scheduled "only scheduled") (deadline "only deadline") (active "only active timestamps") (inactive "only inactive timestamps") - (scheduled-or-deadline "scheduled/deadline") (closed "with a closed time-stamp") (otherwise "scheduled/deadline"))) (let ((answer (read-char-exclusive))) - (case answer + (cl-case answer (?c (org-sparse-tree arg - (cadr (memq type '(scheduled-or-deadline all scheduled deadline active - inactive closed))))) - (?d (call-interactively #'org-check-deadlines)) - (?b (call-interactively #'org-check-before-date)) - (?a (call-interactively #'org-check-after-date)) - (?D (call-interactively #'org-check-dates-range)) - (?t (call-interactively #'org-show-todo-tree)) + (cadr + (memq type '(nil all scheduled deadline active inactive closed))))) + (?d (call-interactively 'org-check-deadlines)) + (?b (call-interactively 'org-check-before-date)) + (?a (call-interactively 'org-check-after-date)) + (?D (call-interactively 'org-check-dates-range)) + (?t (call-interactively 'org-show-todo-tree)) (?T (org-show-todo-tree '(4))) - (?m (call-interactively #'org-match-sparse-tree)) + (?m (call-interactively 'org-match-sparse-tree)) ((?p ?P) - (let* ((kwd (org-icompleting-read + (let* ((kwd (completing-read "Property: " (mapcar #'list (org-buffer-property-keys)))) - (value (org-icompleting-read + (value (completing-read "Value: " (mapcar #'list (org-property-values kwd))))) (unless (string-match "\\`{.*}\\'" value) (setq value (concat "\"" value "\""))) (org-match-sparse-tree arg (concat kwd "=" value)))) - ((?r ?R ?/) (call-interactively #'org-occur)) + ((?r ?R ?/) (call-interactively 'org-occur)) (otherwise (user-error "No such sparse tree command \"%c\"" answer))))) -(defvar org-occur-highlights nil +(defvar-local org-occur-highlights nil "List of overlays used for occur matches.") -(make-variable-buffer-local 'org-occur-highlights) -(defvar org-occur-parameters nil +(defvar-local org-occur-parameters nil "Parameters of the active org-occur calls. This is a list, each call to org-occur pushes as cons cell, containing the regular expression and the callback, onto the list. @@ -13583,18 +13944,21 @@ will only contain one set of parameters. When the highlights are removed (for example with `C-c C-c', or with the next edit (depending on `org-remove-highlights-with-change'), this variable is emptied as well.") -(make-variable-buffer-local 'org-occur-parameters) (defun org-occur (regexp &optional keep-previous callback) "Make a compact tree which shows all matches of REGEXP. -The tree will show the lines where the regexp matches, and all higher -headlines above the match. It will also show the heading after the match, -to make sure editing the matching entry is easy. -If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous -call to `org-occur' will be kept, to allow stacking of calls to this -command. -If CALLBACK is non-nil, it is a function which is called to confirm -that the match should indeed be shown." + +The tree will show the lines where the regexp matches, and any other context +defined in `org-show-context-detail', which see. + +When optional argument KEEP-PREVIOUS is non-nil, highlighting and exposing +done by a previous call to `org-occur' will be kept, to allow stacking of +calls to this command. + +Optional argument CALLBACK can be a function of no argument. In this case, +it is called with point at the end of the match, match data being set +accordingly. Current match is shown only if the return value is non-nil. +The function must neither move point nor alter narrowing." (interactive "sRegexp: \nP") (when (equal regexp "") (user-error "Regexp cannot be empty")) @@ -13604,32 +13968,35 @@ that the match should indeed be shown." (let ((cnt 0)) (save-excursion (goto-char (point-min)) - (if (or (not keep-previous) ; do not want to keep - (not org-occur-highlights)) ; no previous matches - ;; hide everything - (org-overview)) - (while (re-search-forward regexp nil t) - (when (or (not callback) - (save-match-data (funcall callback))) - (setq cnt (1+ cnt)) - (when org-highlight-sparse-tree-matches - (org-highlight-new-match (match-beginning 0) (match-end 0))) - (org-show-context 'occur-tree)))) + (when (or (not keep-previous) ; do not want to keep + (not org-occur-highlights)) ; no previous matches + ;; hide everything + (org-overview)) + (let ((case-fold-search (if (eq org-occur-case-fold-search 'smart) + (isearch-no-upper-case-p regexp t) + org-occur-case-fold-search))) + (while (re-search-forward regexp nil t) + (when (or (not callback) + (save-match-data (funcall callback))) + (setq cnt (1+ cnt)) + (when org-highlight-sparse-tree-matches + (org-highlight-new-match (match-beginning 0) (match-end 0))) + (org-show-context 'occur-tree))))) (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-remove-occur-highlights - nil 'local)) + (add-hook 'before-change-functions 'org-remove-occur-highlights + nil 'local)) (unless org-sparse-tree-open-archived-trees (org-hide-archived-subtrees (point-min) (point-max))) (run-hooks 'org-occur-hook) - (if (org-called-interactively-p 'interactive) - (message "%d match(es) for regexp %s" cnt regexp)) + (when (called-interactively-p 'interactive) + (message "%d match(es) for regexp %s" cnt regexp)) cnt)) -(defun org-occur-next-match (&optional n reset) +(defun org-occur-next-match (&optional n _reset) "Function for `next-error-function' to find sparse tree matches. N is the number of matches to move, when negative move backwards. -RESET is entirely ignored - this function always goes back to the -starting point when no match is found." +This function always goes back to the starting point when no +match is found." (let* ((limit (if (< n 0) (point-min) (point-max))) (search-func (if (< n 0) 'previous-single-char-property-change @@ -13641,7 +14008,7 @@ starting point when no match is found." (while (setq p1 (funcall search-func (point) 'org-type)) (when (equal p1 limit) (goto-char pos) - (error "No more matches")) + (user-error "No more matches")) (when (equal (get-char-property p1 'org-type) 'org-occur) (setq n (1- n)) (when (= n 0) @@ -13649,65 +14016,75 @@ starting point when no match is found." (throw 'exit (point)))) (goto-char p1)) (goto-char p1) - (error "No more matches")))) + (user-error "No more matches")))) (defun org-show-context (&optional key) "Make sure point and context are visible. -How much context is shown depends upon the variables -`org-show-hierarchy-above', `org-show-following-heading', -`org-show-entry-below' and `org-show-siblings'." - (let ((heading-p (org-at-heading-p t)) - (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) - (following-p (org-get-alist-option org-show-following-heading key)) - (entry-p (org-get-alist-option org-show-entry-below key)) - (siblings-p (org-get-alist-option org-show-siblings key))) - ;; Show heading or entry text - (if (and heading-p (not entry-p)) - (org-flag-heading nil) ; only show the heading - (and (or entry-p (outline-invisible-p) (org-invisible-p2)) - (org-show-hidden-entry))) ; show entire entry - (when following-p - ;; Show next sibling, or heading below text - (save-excursion - (and (if heading-p (org-goto-sibling) (outline-next-heading)) - (org-flag-heading nil)))) - (when siblings-p (org-show-siblings)) - (when hierarchy-p - ;; show all higher headings, possibly with siblings - (save-excursion - (while (and (condition-case nil - (progn (org-up-heading-all 1) t) - (error nil)) - (not (bobp))) - (org-flag-heading nil) - (when siblings-p (org-show-siblings))))))) +Optional argument KEY, when non-nil, is a symbol. See +`org-show-context-detail' for allowed values and how much is to +be shown." + (org-show-set-visibility + (cond ((symbolp org-show-context-detail) org-show-context-detail) + ((cdr (assq key org-show-context-detail))) + (t (cdr (assq 'default org-show-context-detail)))))) + +(defun org-show-set-visibility (detail) + "Set visibility around point according to DETAIL. +DETAIL is either nil, `minimal', `local', `ancestors', `lineage', +`tree', `canonical' or t. See `org-show-context-detail' for more +information." + ;; Show current heading and possibly its entry, following headline + ;; or all children. + (if (and (org-at-heading-p) (not (eq detail 'local))) + (org-flag-heading nil) + (org-show-entry) + ;; If point is hidden within a drawer or a block, make sure to + ;; expose it. + (dolist (o (overlays-at (point))) + (when (memq (overlay-get o 'invisible) '(org-hide-block outline)) + (delete-overlay o))) + (unless (org-before-first-heading-p) + (org-with-limited-levels + (cl-case detail + ((tree canonical t) (org-show-children)) + ((nil minimal ancestors)) + (t (save-excursion + (outline-next-heading) + (org-flag-heading nil))))))) + ;; Show all siblings. + (when (eq detail 'lineage) (org-show-siblings)) + ;; Show ancestors, possibly with their children. + (when (memq detail '(ancestors lineage tree canonical t)) + (save-excursion + (while (org-up-heading-safe) + (org-flag-heading nil) + (when (memq detail '(canonical t)) (org-show-entry)) + (when (memq detail '(tree canonical t)) (org-show-children)))))) (defvar org-reveal-start-hook nil "Hook run before revealing a location.") (defun org-reveal (&optional siblings) "Show current entry, hierarchy above it, and the following headline. -This can be used to show a consistent set of context around locations -exposed with `org-show-hierarchy-above' or `org-show-following-heading' -not t for the search context. + +This can be used to show a consistent set of context around +locations exposed with `org-show-context'. With optional argument SIBLINGS, on each level of the hierarchy all siblings are shown. This repairs the tree structure to what it would look like when opened with hierarchical calls to `org-cycle'. -With double optional argument \\[universal-argument] \\[universal-argument], \ -go to the parent and show the -entire tree." + +With a \\[universal-argument] \\[universal-argument] prefix, \ +go to the parent and show the entire tree." (interactive "P") (run-hooks 'org-reveal-start-hook) - (let ((org-show-hierarchy-above t) - (org-show-following-heading t) - (org-show-siblings (if siblings t org-show-siblings))) - (org-show-context nil)) - (when (equal siblings '(16)) - (save-excursion - (when (org-up-heading-safe) - (org-show-subtree) - (run-hook-with-args 'org-cycle-hook 'subtree))))) + (cond ((equal siblings '(4)) (org-show-set-visibility 'canonical)) + ((equal siblings '(16)) + (save-excursion + (when (org-up-heading-safe) + (org-show-subtree) + (run-hook-with-args 'org-cycle-hook 'subtree)))) + (t (org-show-set-visibility 'lineage)))) (defun org-highlight-new-match (beg end) "Highlight from BEG to END and mark the highlight is an occur headline." @@ -13716,13 +14093,13 @@ entire tree." (overlay-put ov 'org-type 'org-occur) (push ov org-occur-highlights))) -(defun org-remove-occur-highlights (&optional beg end noremove) +(defun org-remove-occur-highlights (&optional _beg _end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function from the `before-change-functions' in the current buffer." (interactive) (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-occur-highlights) + (mapc #'delete-overlay org-occur-highlights) (setq org-occur-highlights nil) (setq org-occur-parameters nil) (unless noremove @@ -13746,89 +14123,88 @@ from the `before-change-functions' in the current buffer." (interactive) (org-priority 'down)) -(defun org-priority (&optional action show) +(defun org-priority (&optional action _show) "Change the priority of an item. ACTION can be `set', `up', `down', or a character." (interactive "P") (if (equal action '(4)) (org-show-priority) - (unless org-enable-priority-commands - (user-error "Priority commands are disabled")) - (setq action (or action 'set)) - (let (current new news have remove) - (save-excursion - (org-back-to-heading t) - (if (looking-at org-priority-regexp) + (unless org-enable-priority-commands + (user-error "Priority commands are disabled")) + (setq action (or action 'set)) + (let (current new news have remove) + (save-excursion + (org-back-to-heading t) + (when (looking-at org-priority-regexp) (setq current (string-to-char (match-string 2)) have t)) - (cond - ((eq action 'remove) - (setq remove t new ?\ )) - ((or (eq action 'set) - (if (featurep 'xemacs) (characterp action) (integerp action))) - (if (not (eq action 'set)) - (setq new action) - (message "Priority %c-%c, SPC to remove: " - org-highest-priority org-lowest-priority) - (save-match-data - (setq new (read-char-exclusive)))) - (if (and (= (upcase org-highest-priority) org-highest-priority) - (= (upcase org-lowest-priority) org-lowest-priority)) + (cond + ((eq action 'remove) + (setq remove t new ?\ )) + ((or (eq action 'set) + (integerp action)) + (if (not (eq action 'set)) + (setq new action) + (message "Priority %c-%c, SPC to remove: " + org-highest-priority org-lowest-priority) + (save-match-data + (setq new (read-char-exclusive)))) + (when (and (= (upcase org-highest-priority) org-highest-priority) + (= (upcase org-lowest-priority) org-lowest-priority)) (setq new (upcase new))) - (cond ((equal new ?\ ) (setq remove t)) - ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) - (user-error "Priority must be between `%c' and `%c'" - org-highest-priority org-lowest-priority)))) - ((eq action 'up) - (setq new (if have - (1- current) ; normal cycling - ;; last priority was empty - (if (eq last-command this-command) - org-lowest-priority ; wrap around empty to lowest - ;; default - (if org-priority-start-cycle-with-default - org-default-priority - (1- org-default-priority)))))) - ((eq action 'down) - (setq new (if have - (1+ current) ; normal cycling - ;; last priority was empty - (if (eq last-command this-command) - org-highest-priority ; wrap around empty to highest - ;; default - (if org-priority-start-cycle-with-default - org-default-priority - (1+ org-default-priority)))))) - (t (user-error "Invalid action"))) - (if (or (< (upcase new) org-highest-priority) - (> (upcase new) org-lowest-priority)) + (cond ((equal new ?\ ) (setq remove t)) + ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) + (user-error "Priority must be between `%c' and `%c'" + org-highest-priority org-lowest-priority)))) + ((eq action 'up) + (setq new (if have + (1- current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-lowest-priority ; wrap around empty to lowest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1- org-default-priority)))))) + ((eq action 'down) + (setq new (if have + (1+ current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-highest-priority ; wrap around empty to highest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1+ org-default-priority)))))) + (t (user-error "Invalid action"))) + (when (or (< (upcase new) org-highest-priority) + (> (upcase new) org-lowest-priority)) (if (and (memq action '(up down)) (not have) (not (eq last-command this-command))) - ;; `new' is from default priority + ;; `new' is from default priority (error "The default can not be set, see `org-default-priority' why") - ;; normal cycling: `new' is beyond highest/lowest priority - ;; and is wrapped around to the empty priority + ;; normal cycling: `new' is beyond highest/lowest priority + ;; and is wrapped around to the empty priority (setq remove t))) - (setq news (format "%c" new)) - (if have + (setq news (format "%c" new)) + (if have + (if remove + (replace-match "" t t nil 1) + (replace-match news t t nil 2)) (if remove - (replace-match "" t t nil 1) - (replace-match news t t nil 2)) - (if remove - (user-error "No priority cookie found in line") - (let ((case-fold-search nil)) - (looking-at org-todo-line-regexp)) - (if (match-end 2) - (progn - (goto-char (match-end 2)) - (insert " [#" news "]")) - (goto-char (match-beginning 3)) - (insert "[#" news "] ")))) - (org-preserve-lc (org-set-tags nil 'align))) - (if remove - (message "Priority removed") - (message "Priority of current item set to %s" news))))) + (user-error "No priority cookie found in line") + (let ((case-fold-search nil)) (looking-at org-todo-line-regexp)) + (if (match-end 2) + (progn + (goto-char (match-end 2)) + (insert " [#" news "]")) + (goto-char (match-beginning 3)) + (insert "[#" news "] ")))) + (org-set-tags nil 'align)) + (if remove + (message "Priority removed") + (message "Priority of current item set to %s" news))))) (defun org-show-priority () "Show the priority of the current item. @@ -13863,6 +14239,7 @@ Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") (defvar org-scanner-tags nil "The current tag list while the tags scanner is running.") + (defvar org-trust-scanner-tags nil "Should `org-get-tags-at' use the tags for the scanner. This is for internal dynamical scoping only. @@ -13874,6 +14251,8 @@ obtain a list of properties. Building the tags list for each entry in such a file becomes an N^2 operation - but with this variable set, it scales as N.") +(defvar org--matcher-tags-todo-only nil) + (defun org-scan-tags (action matcher todo-only &optional start-level) "Scan headline tags with inheritance and produce output ACTION. @@ -13882,11 +14261,14 @@ or `agenda' to produce an entry list for an agenda view. It can also be a Lisp form or a function that should be called at each matched headline, in this case the return value is a list of all return values from these calls. -MATCHER is a Lisp form to be evaluated, testing if a given set of tags -qualifies a headline for inclusion. When TODO-ONLY is non-nil, -only lines with a not-done TODO keyword are included in the output. -This should be the same variable that was scoped into -and set by `org-make-tags-matcher' when it constructed MATCHER. +MATCHER is a function accepting three arguments, returning +a non-nil value whenever a given set of tags qualifies a headline +for inclusion. See `org-make-tags-matcher' for more information. +As a special case, it can also be set to t (respectively nil) in +order to match all (respectively none) headline. + +When TODO-ONLY is non-nil, only lines with a not-done TODO +keyword are included in the output. START-LEVEL can be a string with asterisks, reducing the scope to headlines matching this string." @@ -13897,8 +14279,8 @@ headlines matching this string." (concat "\\*\\{" (number-to-string start-level) "\\} ") org-outline-regexp) " *\\(\\<\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) + (mapconcat #'regexp-quote org-todo-keywords-1 "\\|") + "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -13915,8 +14297,9 @@ headlines matching this string." lspos tags tags-list (tags-alist (list (cons 0 org-file-tags))) (llast 0) rtn rtn1 level category i txt - todo marker entry priority) - (when (not (or (member action '(agenda sparse-tree)) (functionp action))) + todo marker entry priority + ts-date ts-date-type ts-date-pair) + (unless (or (member action '(agenda sparse-tree)) (functionp action)) (setq action (list 'lambda nil action))) (save-excursion (goto-char (point-min)) @@ -13927,11 +14310,17 @@ headlines matching this string." (re-search-forward re nil t)) (setq org-map-continue-from nil) (catch :skip - (setq todo (if (match-end 1) (org-match-string-no-properties 2)) - tags (if (match-end 4) (org-match-string-no-properties 4))) + (setq todo + ;; TODO: is the 1-2 difference a bug? + (when (match-end 1) (match-string-no-properties 2)) + tags (when (match-end 4) (match-string-no-properties 4))) (goto-char (setq lspos (match-beginning 0))) (setq level (org-reduced-level (org-outline-level)) category (org-get-category)) + (when (eq action 'agenda) + (setq ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) + ts-date (car ts-date-pair) + ts-date-type (cdr ts-date-pair))) (setq i llast llast level) ;; remove tag lists from same and sublevels (while (>= i level) @@ -13958,18 +14347,20 @@ headlines matching this string." (when (and tags org-use-tag-inheritance (or (not (eq t org-use-tag-inheritance)) org-tags-exclude-from-inheritance)) - ;; selective inheritance, remove uninherited ones + ;; Selective inheritance, remove uninherited ones. (setcdr (car tags-alist) (org-remove-uninherited-tags (cdar tags-alist)))) (when (and ;; eval matcher only when the todo condition is OK (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t) (org-trust-scanner-tags t)) - (eval matcher))) + (if (functionp matcher) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (funcall matcher todo tags-list level)) + matcher)) - ;; Call the skipper, but return t if it does not skip, - ;; so that the `and' form continues evaluating + ;; Call the skipper, but return t if it does not + ;; skip, so that the `and' form continues evaluating. (progn (unless (eq action 'sparse-tree) (org-agenda-skip)) t) @@ -13995,7 +14386,8 @@ headlines matching this string." (if (eq org-tags-match-list-sublevels 'indented) (make-string (1- level) ?.) "") (org-get-heading)) - level category + (make-string level ?\s) + category tags-list) priority (org-get-priority txt)) (goto-char lspos) @@ -14003,7 +14395,9 @@ headlines matching this string." (org-add-props txt props 'org-marker marker 'org-hd-marker marker 'org-category category 'todo-state todo - 'priority priority 'type "tagsmatch") + 'ts-date ts-date + 'priority priority + 'type (concat "tagsmatch" ts-date-type)) (push txt rtn)) ((functionp action) (setq org-map-continue-from nil) @@ -14048,13 +14442,19 @@ headlines matching this string." (defun org-match-sparse-tree (&optional todo-only match) "Create a sparse tree according to tags string MATCH. -MATCH can contain positive and negative selection of tags, like -\"+WORK+URGENT-WITHBOSS\". -If optional argument TODO-ONLY is non-nil, only select lines that are -also TODO lines." + +MATCH is a string with match syntax. It can contain a selection +of tags (\"+work+urgent-boss\"), properties (\"LEVEL>3\"), and +TODO keywords (\"TODO=\\\"WAITING\\\"\") or a combination of +those. See the manual for details. + +If optional argument TODO-ONLY is non-nil, only select lines that +are also TODO tasks." (interactive "P") (org-agenda-prepare-buffers (list (current-buffer))) - (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) + (let ((org--matcher-tags-todo-only todo-only)) + (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) + org--matcher-tags-todo-only))) (defalias 'org-tags-sparse-tree 'org-match-sparse-tree) @@ -14062,15 +14462,17 @@ also TODO lines." (defun org-cached-entry-get (pom property) (if (or (eq t org-use-property-inheritance) (and (stringp org-use-property-inheritance) - (string-match org-use-property-inheritance property)) + (let ((case-fold-search t)) + (string-match-p org-use-property-inheritance property))) (and (listp org-use-property-inheritance) - (member property org-use-property-inheritance))) - ;; Caching is not possible, check it directly + (member-ignore-case property org-use-property-inheritance))) + ;; Caching is not possible, check it directly. (org-entry-get pom property 'inherit) - ;; Get all properties, so that we can do complicated checks easily - (cdr (assoc property (or org-cached-props - (setq org-cached-props - (org-entry-properties pom))))))) + ;; Get all properties, so we can do complicated checks easily. + (cdr (assoc-string property + (or org-cached-props + (setq org-cached-props (org-entry-properties pom))) + t)))) (defun org-global-tags-completion-table (&optional files) "Return the list of all tags in all agenda buffer/files. @@ -14079,186 +14481,173 @@ instead of the agenda files." (save-excursion (org-uniquify (delq nil - (apply 'append + (apply #'append (mapcar (lambda (file) (set-buffer (find-file-noselect file)) - (append (org-get-buffer-tags) - (mapcar (lambda (x) (if (stringp (car-safe x)) - (list (car-safe x)) nil)) - org-tag-alist))) - (if (and files (car files)) - files + (mapcar (lambda (x) + (and (stringp (car-safe x)) + (list (car-safe x)))) + (or org-current-tag-alist (org-get-buffer-tags)))) + (if (car-safe files) files (org-agenda-files)))))))) (defun org-make-tags-matcher (match) "Create the TAGS/TODO matcher form for the selection string MATCH. -The variable `todo-only' is scoped dynamically into this function. -It will be set to t if the matcher restricts matching to TODO entries, -otherwise will not be touched. - -Returns a cons of the selection string MATCH and the constructed -lisp form implementing the matcher. The matcher is to be evaluated -at an Org entry, with point on the headline, and returns t if the -entry matches the selection string MATCH. The returned lisp form -references two variables with information about the entry, which -must be bound around the form's evaluation: todo, the TODO keyword -at the entry (or nil of none); and tags-list, the list of all tags -at the entry including inherited ones. Additionally, the category -of the entry (if any) must be specified as the text property -'org-category on the headline. - -See also `org-scan-tags'. -" - (declare (special todo-only)) - (unless (boundp 'todo-only) - (error "`org-make-tags-matcher' expects todo-only to be scoped in")) +Returns a cons of the selection string MATCH and a function +implementing the matcher. + +The matcher is to be called at an Org entry, with point on the +headline, and returns non-nil if the entry matches the selection +string MATCH. It must be called with three arguments: the TODO +keyword at the entry (or nil if none), the list of all tags at +the entry including inherited ones and the reduced level of the +headline. Additionally, the category of the entry, if any, must +be specified as the text property `org-category' on the headline. + +This function sets the variable `org--matcher-tags-todo-only' to +a non-nil value if the matcher restricts matching to TODO +entries, otherwise it is not touched. + +See also `org-scan-tags'." (unless match ;; Get a new match request, with completion against the global - ;; tags table and the local tags in current buffer + ;; tags table and the local tags in current buffer. (let ((org-last-tags-completion-table (org-uniquify (delq nil (append (org-get-buffer-tags) (org-global-tags-completion-table)))))) - (setq match (org-completing-read-no-i - "Match: " 'org-tags-completion-function nil nil nil - 'org-tags-history)))) + (setq match + (completing-read + "Match: " + 'org-tags-completion-function nil nil nil 'org-tags-history)))) - ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) - minus tag mm - tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms orlist re-p str-p level-p level-op time-p - prop-p pn pv po gv rest (start 0) (ss 0)) - ;; Expand group tags + (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)") + (start 0) + tagsmatch todomatch tagsmatcher todomatcher) + + ;; Expand group tags. (setq match (org-tags-expand match)) ;; Check if there is a TODO part of this match, which would be the - ;; part after a "/". TO make sure that this slash is not part of - ;; a property value to be matched against, we also check that there - ;; is no " after that slash. - ;; First, find the last slash - (while (string-match "/+" match ss) - (setq start (match-beginning 0) ss (match-end 0))) + ;; part after a "/". To make sure that this slash is not part of + ;; a property value to be matched against, we also check that + ;; there is no / after that slash. First, find the last slash. + (let ((s 0)) + (while (string-match "/+" match s) + (setq start (match-beginning 0)) + (setq s (match-end 0)))) (if (and (string-match "/+" match start) - (not (save-match-data (string-match "\"" match start)))) - ;; match contains also a todo-matching request + (not (string-match-p "\"" match start))) + ;; Match contains also a TODO-matching request. (progn - (setq tagsmatch (substring match 0 (match-beginning 0)) - todomatch (substring match (match-end 0))) - (if (string-match "^!" todomatch) - (setq todo-only t todomatch (substring todomatch 1))) - (if (string-match "^\\s-*$" todomatch) - (setq todomatch nil))) - ;; only matching tags - (setq tagsmatch match todomatch nil)) - - ;; Make the tags matcher - (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) - (setq tagsmatcher t) - (setq orterms (org-split-string tagsmatch "|") orlist nil) - (dolist (term orterms) - (while (and (equal (substring term -1) "\\") orterms) - (setq term (concat term "|" (pop orterms)))) ; repair bad split - (while (string-match re term) - (setq rest (substring term (match-end 0)) - minus (and (match-end 1) - (equal (match-string 1 term) "-")) - tag (save-match-data (replace-regexp-in-string - "\\\\-" "-" - (match-string 2 term))) - re-p (equal (string-to-char tag) ?{) - level-p (match-end 4) - prop-p (match-end 5) - mm (cond - (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) - (level-p - (setq level-op (org-op-to-function (match-string 3 term))) - `(,level-op level ,(string-to-number - (match-string 4 term)))) - (prop-p - (setq pn (match-string 5 term) - po (match-string 6 term) - pv (match-string 7 term) - re-p (equal (string-to-char pv) ?{) - str-p (equal (string-to-char pv) ?\") - time-p (save-match-data - (string-match "^\"[[<].*[]>]\"$" pv)) - pv (if (or re-p str-p) (substring pv 1 -1) pv)) - (if time-p (setq pv (org-matcher-time pv))) - (setq po (org-op-to-function po (if time-p 'time str-p))) - (cond - ((equal pn "CATEGORY") - (setq gv '(get-text-property (point) 'org-category))) - ((equal pn "TODO") - (setq gv 'todo)) - (t - (setq gv `(org-cached-entry-get nil ,pn)))) - (if re-p - (if (eq po 'org<>) - `(not (string-match ,pv (or ,gv ""))) - `(string-match ,pv (or ,gv ""))) - (if str-p - `(,po (or ,gv "") ,pv) - `(,po (string-to-number (or ,gv "")) - ,(string-to-number pv) )))) - (t `(member ,tag tags-list))) - mm (if minus (list 'not mm) mm) - term rest) - (push mm tagsmatcher)) - (push (if (> (length tagsmatcher) 1) - (cons 'and tagsmatcher) - (car tagsmatcher)) - orlist) - (setq tagsmatcher nil)) - (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) - (setq tagsmatcher - (list 'progn '(setq org-cached-props nil) tagsmatcher))) - ;; Make the todo matcher - (if (or (not todomatch) (not (string-match "\\S-" todomatch))) - (setq todomatcher t) - (setq orterms (org-split-string todomatch "|") orlist nil) - (dolist (term orterms) - (while (string-match re term) - (setq minus (and (match-end 1) - (equal (match-string 1 term) "-")) - kwd (match-string 2 term) - re-p (equal (string-to-char kwd) ?{) - term (substring term (match-end 0)) - mm (if re-p - `(string-match ,(substring kwd 1 -1) todo) - (list 'equal 'todo kwd)) - mm (if minus (list 'not mm) mm)) - (push mm todomatcher)) - (push (if (> (length todomatcher) 1) - (cons 'and todomatcher) - (car todomatcher)) - orlist) - (setq todomatcher nil)) - (setq todomatcher (if (> (length orlist) 1) - (cons 'or orlist) (car orlist)))) - - ;; Return the string and lisp forms of the matcher - (setq matcher (if todomatcher - (list 'and tagsmatcher todomatcher) - tagsmatcher)) - (when todo-only - (setq matcher (list 'and '(member todo org-not-done-keywords) - matcher))) - (cons match0 matcher))) - -(defun org-tags-expand (match &optional single-as-list downcased) + (setq tagsmatch (substring match 0 (match-beginning 0))) + (setq todomatch (substring match (match-end 0))) + (when (string-prefix-p "!" todomatch) + (setq org--matcher-tags-todo-only t) + (setq todomatch (substring todomatch 1))) + (when (string-match "\\`\\s-*\\'" todomatch) + (setq todomatch nil))) + ;; Only matching tags. + (setq tagsmatch match) + (setq todomatch nil)) + + ;; Make the tags matcher. + (when (org-string-nw-p tagsmatch) + (let ((orlist nil) + (orterms (org-split-string tagsmatch "|")) + term) + (while (setq term (pop orterms)) + (while (and (equal (substring term -1) "\\") orterms) + (setq term (concat term "|" (pop orterms)))) ;repair bad split. + (while (string-match re term) + (let* ((rest (substring term (match-end 0))) + (minus (and (match-end 1) + (equal (match-string 1 term) "-"))) + (tag (save-match-data + (replace-regexp-in-string + "\\\\-" "-" (match-string 2 term)))) + (regexp (eq (string-to-char tag) ?{)) + (levelp (match-end 4)) + (propp (match-end 5)) + (mm + (cond + (regexp `(org-match-any-p ,(substring tag 1 -1) tags-list)) + (levelp + `(,(org-op-to-function (match-string 3 term)) + level + ,(string-to-number (match-string 4 term)))) + (propp + (let* ((gv (pcase (upcase (match-string 5 term)) + ("CATEGORY" + '(get-text-property (point) 'org-category)) + ("TODO" 'todo) + (p `(org-cached-entry-get nil ,p)))) + (pv (match-string 7 term)) + (regexp (eq (string-to-char pv) ?{)) + (strp (eq (string-to-char pv) ?\")) + (timep (string-match-p "^\"[[<].*[]>]\"$" pv)) + (po (org-op-to-function (match-string 6 term) + (if timep 'time strp)))) + (setq pv (if (or regexp strp) (substring pv 1 -1) pv)) + (when timep (setq pv (org-matcher-time pv))) + (cond ((and regexp (eq po 'org<>)) + `(not (string-match ,pv (or ,gv "")))) + (regexp `(string-match ,pv (or ,gv ""))) + (strp `(,po (or ,gv "") ,pv)) + (t + `(,po + (string-to-number (or ,gv "")) + ,(string-to-number pv)))))) + (t `(member ,tag tags-list))))) + (push (if minus `(not ,mm) mm) tagsmatcher) + (setq term rest))) + (push `(and ,@tagsmatcher) orlist) + (setq tagsmatcher nil)) + (setq tagsmatcher `(progn (setq org-cached-props nil) (or ,@orlist))))) + + ;; Make the TODO matcher. + (when (org-string-nw-p todomatch) + (let ((orlist nil)) + (dolist (term (org-split-string todomatch "|")) + (while (string-match re term) + (let* ((minus (and (match-end 1) + (equal (match-string 1 term) "-"))) + (kwd (match-string 2 term)) + (regexp (eq (string-to-char kwd) ?{)) + (mm (if regexp `(string-match ,(substring kwd 1 -1) todo) + `(equal todo ,kwd)))) + (push (if minus `(not ,mm) mm) todomatcher)) + (setq term (substring term (match-end 0)))) + (push (if (> (length todomatcher) 1) + (cons 'and todomatcher) + (car todomatcher)) + orlist) + (setq todomatcher nil)) + (setq todomatcher (cons 'or orlist)))) + + ;; Return the string and function of the matcher. If no + ;; tags-specific or todo-specific matcher exists, match + ;; everything. + (let ((matcher (if (and tagsmatcher todomatcher) + `(and ,tagsmatcher ,todomatcher) + (or tagsmatcher todomatcher t)))) + (when org--matcher-tags-todo-only + (setq matcher `(and (member todo org-not-done-keywords) ,matcher))) + (cons match0 `(lambda (todo tags-list level) ,matcher))))) + +(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded) "Expand group tags in MATCH. This replaces every group tag in MATCH with a regexp tag search. For example, a group tag \"Work\" defined as { Work : Lab Conf } will be replaced like this: - Work => {\\(?:Work\\|Lab\\|Conf\\)} - +Work => +{\\(?:Work\\|Lab\\|Conf\\)} - -Work => -{\\(?:Work\\|Lab\\|Conf\\)} + Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>} + +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} + -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>} Replacing by a regexp preserves the structure of the match. E.g., this expansion @@ -14268,6 +14657,12 @@ E.g., this expansion will match anything tagged with \"Lab\" and \"Home\", or tagged with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". +A group tag in MATCH can contain regular expressions of its own. +For example, a group tag \"Proj\" defined as { Proj : {P@.+} } +will be replaced like this: + + Proj => {\\<\\(?:Proj\\)\\>\\|P@.+} + When the optional argument SINGLE-AS-LIST is non-nil, MATCH is assumed to be a single group tag, and the function will return the list of tags in this group. @@ -14276,34 +14671,113 @@ When DOWNCASE is non-nil, expand downcased TAGS." (if org-group-tags (let* ((case-fold-search t) (stable org-mode-syntax-table) - (tal (or org-tag-groups-alist-for-agenda - org-tag-groups-alist)) - (tal (if downcased - (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal)) - (tml (mapcar 'car tal)) - (rtnmatch match) rpl) - ;; @ and _ are allowed as word-components in tags + (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist)) + (taggroups (if downcased + (mapcar (lambda (tg) (mapcar #'downcase tg)) + taggroups) + taggroups)) + (taggroups-keys (mapcar #'car taggroups)) + (return-match (if downcased (downcase match) match)) + (count 0) + (work-already-expanded tags-already-expanded) + regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped) + ;; @ and _ are allowed as word-components in tags. (modify-syntax-entry ?@ "w" stable) (modify-syntax-entry ?_ "w" stable) - (while (and tml + ;; Temporarily replace regexp-expressions in the match-expression. + (while (string-match "{.+?}" return-match) + (cl-incf count) + (push (match-string 0 return-match) regexps-in-match) + (setq return-match (replace-match (format "<%d>" count) t nil return-match))) + (while (and taggroups-keys (with-syntax-table stable (string-match (concat "\\(?1:[+-]?\\)\\(?2:\\<" - (regexp-opt tml) "\\>\\)") - rtnmatch))) - (let* ((dir (match-string 1 rtnmatch)) - (tag (match-string 2 rtnmatch)) + (regexp-opt taggroups-keys) "\\>\\)") + return-match))) + (let* ((dir (match-string 1 return-match)) + (tag (match-string 2 return-match)) (tag (if downcased (downcase tag) tag))) - (setq tml (delete tag tml)) - (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch))) - (setq rpl (append (org-uniquify rpl) (assoc tag tal))) - (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}")) - (if (stringp rpl) (org-add-props rpl '(grouptag t))) - (setq rtnmatch (replace-match rpl t t rtnmatch))))) + (unless (or (get-text-property 0 'grouptag (match-string 2 return-match)) + (member tag work-already-expanded)) + (setq tags-in-group (assoc tag taggroups)) + (push tag work-already-expanded) + ;; Recursively expand each tag in the group, if the tag hasn't + ;; already been expanded. Restore the match-data after all recursive calls. + (save-match-data + (let (tags-expanded) + (dolist (x (cdr tags-in-group)) + (if (and (member x taggroups-keys) + (not (member x work-already-expanded))) + (setq tags-expanded + (delete-dups + (append + (org-tags-expand x t downcased + work-already-expanded) + tags-expanded))) + (setq tags-expanded + (append (list x) tags-expanded))) + (setq work-already-expanded + (delete-dups + (append tags-expanded + work-already-expanded)))) + (setq tags-in-group + (delete-dups (cons (car tags-in-group) + tags-expanded))))) + ;; Filter tag-regexps from tags. + (setq regexp-in-group-escaped + (delq nil (mapcar (lambda (x) + (if (stringp x) + (and (equal "{" (substring x 0 1)) + (equal "}" (substring x -1)) + x) + x)) + tags-in-group)) + regexp-in-group + (mapcar (lambda (x) + (substring x 1 -1)) + regexp-in-group-escaped) + tags-in-group + (delq nil (mapcar (lambda (x) + (if (stringp x) + (and (not (equal "{" (substring x 0 1))) + (not (equal "}" (substring x -1))) + x) + x)) + tags-in-group))) + ;; If single-as-list, do no more in the while-loop. + (if (not single-as-list) + (progn + (when regexp-in-group + (setq regexp-in-group + (concat "\\|" + (mapconcat 'identity regexp-in-group + "\\|")))) + (setq tags-in-group + (concat dir + "{\\<" + (regexp-opt tags-in-group) + "\\>" + regexp-in-group + "}")) + (when (stringp tags-in-group) + (org-add-props tags-in-group '(grouptag t))) + (setq return-match + (replace-match tags-in-group t t return-match))) + (setq tags-in-group + (append regexp-in-group-escaped tags-in-group)))) + (setq taggroups-keys (delete tag taggroups-keys)))) + ;; Add the regular expressions back into the match-expression again. + (while regexps-in-match + (setq return-match (replace-regexp-in-string (format "<%d>" count) + (pop regexps-in-match) + return-match t t)) + (cl-decf count)) (if single-as-list - (or (reverse rpl) (list rtnmatch)) - rtnmatch)) - (if single-as-list (list (if downcased (downcase match) match)) + (if tags-in-group tags-in-group (list return-match)) + return-match)) + (if single-as-list + (list (if downcased (downcase match) match)) match))) (defun org-op-to-function (op &optional stringp) @@ -14371,7 +14845,7 @@ epoch to the beginning of today (00:00)." (defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param (defvar org-tags-overlay (make-overlay 1 1)) -(org-detach-overlay org-tags-overlay) +(delete-overlay org-tags-overlay) (defun org-get-local-tags-at (&optional pos) "Get a list of tags defined in the current headline." @@ -14405,10 +14879,9 @@ ignore inherited ones." (org-back-to-heading t) (while (not (equal lastpos (point))) (setq lastpos (point)) - (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) + (when (looking-at ".+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$") (setq ltags (org-split-string - (org-match-string-no-properties 1) ":")) + (match-string-no-properties 1) ":")) (when parent (setq ltags (mapcar 'org-add-prop-inherited ltags))) (setq tags (append @@ -14417,7 +14890,7 @@ ignore inherited ones." ltags) tags))) (or org-use-tag-inheritance (throw 'done t)) - (if local (throw 'done t)) + (when local (throw 'done t)) (or (org-up-heading-safe) (error nil)) (setq parent t))) (error nil))))) @@ -14439,7 +14912,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (let (res current) (save-excursion (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") + (if (re-search-forward "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$" (point-at-eol) t) (progn (setq current (match-string 1)) @@ -14465,29 +14938,24 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (run-hooks 'org-after-tags-change-hook)) res)) -(defun org-align-tags-here (to-col) - ;; Assumes that this is a headline - "Align tags on the current headline to TO-COL." - (let ((pos (point)) (col (current-column)) ncol tags-l p) - (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (< pos (match-beginning 2))) - (progn - (setq tags-l (- (match-end 2) (match-beginning 2))) - (goto-char (match-beginning 1)) - (insert " ") - (delete-region (point) (1+ (match-beginning 2))) - (setq ncol (max (current-column) - (1+ col) - (if (> to-col 0) - to-col - (- (abs to-col) tags-l)))) - (setq p (point)) - (insert (make-string (- ncol (current-column)) ?\ )) - (setq ncol (current-column)) - (when indent-tabs-mode (tabify p (point-at-eol))) - (org-move-to-column (min ncol col))) - (goto-char pos)))) +(defun org--align-tags-here (to-col) + "Align tags on the current headline to TO-COL. +Assume point is on a headline." + (let ((pos (point))) + (beginning-of-line) + (if (or (not (looking-at ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (>= pos (match-beginning 2))) + ;; No tags or point within tags: do not align. + (goto-char pos) + (goto-char (match-beginning 1)) + (let ((shift (max (- (if (>= to-col 0) to-col + (- (abs to-col) (string-width (match-string 2)))) + (current-column)) + 1))) + (replace-match (make-string shift ?\s) nil nil nil 1) + ;; Preserve initial position, if possible. In any case, stop + ;; before tags. + (when (< pos (point)) (goto-char pos)))))) (defun org-set-tags-command (&optional arg just-align) "Call the set-tags command for the current entry." @@ -14517,7 +14985,8 @@ If DATA is nil or the empty string, any tags will be removed." (when data (save-excursion (org-back-to-heading t) - (when (looking-at org-complex-heading-regexp) + (when (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) (if (match-end 5) (progn (goto-char (match-beginning 5)) @@ -14528,11 +14997,11 @@ If DATA is nil or the empty string, any tags will be removed." (insert " " data) (org-set-tags nil 'align))) (beginning-of-line 1) - (if (looking-at ".*?\\([ \t]+\\)$") - (delete-region (match-beginning 1) (match-end 1)))))) + (when (looking-at ".*?\\([ \t]+\\)$") + (delete-region (match-beginning 1) (match-end 1)))))) (defun org-align-all-tags () - "Align the tags i all headings." + "Align the tags in all headings." (interactive) (save-excursion (or (ignore-errors (org-back-to-heading t)) @@ -14549,106 +15018,124 @@ When JUST-ALIGN is non-nil, only align tags." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - ;; We don't use ARG and JUST-ALIGN here because these args - ;; are not useful when looping over headlines. - `(org-set-tags) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((re org-outline-regexp-bol) - (current (unless arg (org-get-tags-string))) - (col (current-column)) - (org-setting-tags t) - table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl di tc level) + 'region-start-level + 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + ;; We don't use ARG and JUST-ALIGN here because these args + ;; are not useful when looping over headlines. + #'org-set-tags + org-loop-over-headlines-in-active-region + cl + '(when (org-invisible-p) (org-end-of-subtree nil t)))) + (let ((org-setting-tags t)) (if arg - (save-excursion - (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward re nil t) - (org-set-tags nil t) - (end-of-line 1))) - (message "All tags realigned to column %d" org-tags-column)) - (if just-align - (setq tags current) - ;; Get a new set of tags from the user - (save-excursion - (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))) - org-last-tags-completion-table table - current-tags (org-split-string current ":") - inherited-tags (nreverse - (nthcdr (length current-tags) - (nreverse (org-get-tags-at)))) - tags - (if (or (eq t org-use-fast-tag-selection) - (and org-use-fast-tag-selection - (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection - current-tags inherited-tags table - (if org-fast-tag-selection-include-todo - org-todo-key-alist)) - (let ((org-add-colon-after-tag-completion (< 1 (length table)))) - (org-trim - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history)))))) - (while (string-match "[-+&]+" tags) - ;; No boolean logic, just a list - (setq tags (replace-match ":" t t tags)))) - - (setq tags (replace-regexp-in-string "[,]" ":" tags)) - - (if org-tags-sort-function - (setq tags (mapconcat 'identity - (sort (org-split-string - tags (org-re "[^[:alnum:]_@#%]+")) - org-tags-sort-function) ":"))) - - (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") - (unless (string-match ":$" tags) (setq tags (concat tags ":"))) - (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - - ;; Insert new tags at the correct column - (beginning-of-line 1) - (setq level (or (and (looking-at org-outline-regexp) - (- (match-end 0) (point) 1)) - 1)) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) - ;; compute offset for the case of org-indent-mode active - di (if (org-bound-and-true-p org-indent-mode) - (* (1- org-indent-indentation-per-level) (1- level)) - 0) - p0 (if (equal (char-before) ?*) (1+ (point)) (point)) - tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) - c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) - rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) - (replace-match rpl t t) - (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) - tags) - (t (error "Tags alignment failed"))) - (org-move-to-column col) - (unless just-align - (run-hooks 'org-after-tags-change-hook)))))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-outline-regexp-bol nil t) + (org-set-tags nil t) + (end-of-line)) + (message "All tags realigned to column %d" org-tags-column)) + (let* ((current (org-get-tags-string)) + (tags + (if just-align current + ;; Get a new set of tags from the user. + (save-excursion + (let* ((seen) + (table + (setq + org-last-tags-completion-table + ;; Uniquify tags in alists, yet preserve + ;; structure (i.e., keywords). + (delq nil + (mapcar + (lambda (pair) + (let ((head (car pair))) + (cond ((symbolp head) pair) + ((member head seen) nil) + (t (push head seen) + pair)))) + (append + (or org-current-tag-alist + (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))))))) + (current-tags (org-split-string current ":")) + (inherited-tags + (nreverse (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))))) + (replace-regexp-in-string + "\\([-+&]+\\|,\\)" + ":" + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar #'cdr table)))) + (org-fast-tag-selection + current-tags inherited-tags table + (and org-fast-tag-selection-include-todo + org-todo-key-alist)) + (let ((org-add-colon-after-tag-completion + (< 1 (length table)))) + (org-trim + (completing-read + "Tags: " + #'org-tags-completion-function + nil nil current 'org-tags-history)))))))))) + + (when org-tags-sort-function + (setq tags + (mapconcat + #'identity + (sort (org-split-string tags "[^[:alnum:]_@#%]+") + org-tags-sort-function) + ":"))) + + (if (or (string= ":" tags) + (string= "::" tags)) + (setq tags "")) + (if (not (org-string-nw-p tags)) (setq tags "") + (unless (string-suffix-p ":" tags) (setq tags (concat tags ":"))) + (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags)))) + + ;; Insert new tags at the correct column. + (unless (equal current tags) + (save-excursion + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)) + ;; Remove current tags, if any. + (when (match-end 5) (replace-match "" nil nil nil 5)) + ;; Insert new tags, if any. Otherwise, remove trailing + ;; white spaces. + (end-of-line) + (if (not (equal tags "")) + ;; When text is being inserted on an invisible + ;; region boundary, it can be inadvertently sucked + ;; into invisibility. + (outline-flag-region (point) (progn (insert " " tags) (point)) nil) + (skip-chars-backward " \t") + (delete-region (point) (line-end-position))))) + ;; Align tags, if any. Fix tags column if `org-indent-mode' + ;; is on. + (unless (equal tags "") + (let* ((level (save-excursion + (beginning-of-line) + (skip-chars-forward "\\*"))) + (offset (if (bound-and-true-p org-indent-mode) + (* (1- org-indent-indentation-per-level) + (1- level)) + 0)) + (tags-column + (+ org-tags-column + (if (> org-tags-column 0) (- offset) offset)))) + (org--align-tags-here tags-column)))) + (unless just-align (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. -This works in the agenda, and also in an org-mode buffer." +This works in the agenda, and also in an Org buffer." (interactive (list (region-beginning) (region-end) (let ((org-last-tags-completion-table @@ -14657,37 +15144,37 @@ This works in the agenda, and also in an org-mode buffer." (delq nil (append (org-get-buffer-tags) (org-global-tags-completion-table)))) (org-global-tags-completion-table)))) - (org-icompleting-read + (completing-read "Tag: " 'org-tags-completion-function nil nil nil 'org-tags-history)) (progn (message "[s]et or [r]emove? ") (equal (read-char-exclusive) ?r)))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) + (when (fboundp 'deactivate-mark) (deactivate-mark)) (let ((agendap (equal major-mode 'org-agenda-mode)) l1 l2 m buf pos newhead (cnt 0)) (goto-char end) (setq l2 (1- (org-current-line))) (goto-char beg) (setq l1 (org-current-line)) - (loop for l from l1 to l2 do - (org-goto-line l) - (setq m (get-text-property (point) 'org-hd-marker)) - (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) - (and agendap m)) - (setq buf (if agendap (marker-buffer m) (current-buffer)) - pos (if agendap m (point))) - (with-current-buffer buf - (save-excursion - (save-restriction - (goto-char pos) - (setq cnt (1+ cnt)) - (org-toggle-tag tag (if off 'off 'on)) - (setq newhead (org-get-heading))))) - (and agendap (org-agenda-change-all-lines newhead m)))) + (cl-loop for l from l1 to l2 do + (org-goto-line l) + (setq m (get-text-property (point) 'org-hd-marker)) + (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) + (and agendap m)) + (setq buf (if agendap (marker-buffer m) (current-buffer)) + pos (if agendap m (point))) + (with-current-buffer buf + (save-excursion + (save-restriction + (goto-char pos) + (setq cnt (1+ cnt)) + (org-toggle-tag tag (if off 'off 'on)) + (setq newhead (org-get-heading))))) + (and agendap (org-agenda-change-all-lines newhead m)))) (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) -(defun org-tags-completion-function (string predicate &optional flag) +(defun org-tags-completion-function (string _predicate &optional flag) (let (s1 s2 rtn (ctable org-last-tags-completion-table) (confirm (lambda (x) (stringp (car x))))) (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) @@ -14698,12 +15185,12 @@ This works in the agenda, and also in an org-mode buffer." ((eq flag nil) ;; try completion (setq rtn (try-completion s2 ctable confirm)) - (if (stringp rtn) - (setq rtn - (concat s1 s2 (substring rtn (length s2)) - (if (and org-add-colon-after-tag-completion - (assoc rtn ctable)) - ":" "")))) + (when (stringp rtn) + (setq rtn + (concat s1 s2 (substring rtn (length s2)) + (if (and org-add-colon-after-tag-completion + (assoc rtn ctable)) + ":" "")))) rtn) ((eq flag t) ;; all-completions @@ -14722,8 +15209,8 @@ Also insert END." (defun org-fast-tag-show-exit (flag) (save-excursion (org-goto-line 3) - (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) - (replace-match "")) + (when (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) + (replace-match "")) (when flag (end-of-line 1) (org-move-to-column (- (window-width) 19) t) @@ -14732,11 +15219,8 @@ Also insert END." (defun org-set-current-tags-overlay (current prefix) "Add an overlay to CURRENT tag with PREFIX." (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) - (if (featurep 'xemacs) - (org-overlay-display org-tags-overlay (concat prefix s) - 'secondary-selection) - (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) - (org-overlay-display org-tags-overlay (concat prefix s))))) + (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) + (org-overlay-display org-tags-overlay (concat prefix s)))) (defvar org-last-tag-selection-key nil) (defun org-fast-tag-selection (current inherited table &optional todo-table) @@ -14759,15 +15243,14 @@ Returns the new tags string, or nil to not change the current settings." (ncol (/ (- (window-width) 4) fwidth)) (i-face 'org-done) (c-face 'org-todo) - tg cnt c char c1 c2 ntable tbl rtn + tg cnt e c char c1 c2 ntable tbl rtn ov-start ov-end ov-prefix (exit-after-next org-fast-tag-selection-single-key) (done-keywords org-done-keywords) - groups ingroup) + groups ingroup intaggroup) (save-excursion (beginning-of-line 1) - (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -14788,32 +15271,41 @@ Returns the new tags string, or nil to not change the current settings." (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*")) (org-switch-to-buffer-other-window " *Org tags*")) (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) + (setq-local org-done-keywords done-keywords) (org-fast-tag-insert "Inherited" inherited i-face "\n") (org-fast-tag-insert "Current" current c-face "\n\n") (org-fast-tag-show-exit exit-after-next) (org-set-current-tags-overlay current ov-prefix) (setq tbl fulltable char ?a cnt 0) - (dolist (e tbl) + (while (setq e (pop tbl)) (cond - ((equal (car e) :startgroup) + ((eq (car e) :startgroup) (push '() groups) (setq ingroup t) - (when (not (= cnt 0)) + (unless (zerop cnt) (setq cnt 0) (insert "\n")) (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) - ((equal (car e) :endgroup) + ((eq (car e) :endgroup) (setq ingroup nil cnt 0) (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) + ((eq (car e) :startgrouptag) + (setq intaggroup t) + (unless (zerop cnt) + (setq cnt 0) + (insert "\n")) + (insert "[ ")) + ((eq (car e) :endgrouptag) + (setq intaggroup nil cnt 0) + (insert "]\n")) ((equal e '(:newline)) - (when (not (= cnt 0)) + (unless (zerop cnt) (setq cnt 0) (insert "\n") (setq e (car tbl)) (while (equal (car tbl) '(:newline)) (insert "\n") (setq tbl (cdr tbl))))) - ((equal e '(:grouptags)) nil) + ((equal e '(:grouptags)) (insert " : ")) (t (setq tg (copy-sequence (car e)) c2 nil) (if (cdr e) @@ -14827,27 +15319,27 @@ Returns the new tags string, or nil to not change the current settings." (setq char (1+ char))) (setq c2 c1)) (setq c (or c2 char))) - (if ingroup (push tg (car groups))) + (when ingroup (push tg (car groups))) (setq tg (org-add-props tg nil 'face (cond ((not (assoc tg table)) (org-get-todo-face tg)) ((member tg current) c-face) ((member tg inherited) i-face)))) - (if (equal (caar tbl) :grouptags) - (org-add-props tg nil 'face 'org-tag-group)) - (if (and (= cnt 0) (not ingroup)) (insert " ")) + (when (equal (caar tbl) :grouptags) + (org-add-props tg nil 'face 'org-tag-group)) + (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " ")) (insert "[" c "] " tg (make-string (- fwidth 4 (length tg)) ?\ )) (push (cons tg c) ntable) - (when (= (setq cnt (1+ cnt)) ncol) + (when (= (cl-incf cnt) ncol) (insert "\n") - (if ingroup (insert " ")) + (when (or ingroup intaggroup) (insert " ")) (setq cnt 0))))) (setq ntable (nreverse ntable)) (insert "\n") (goto-char (point-min)) - (if (not expert) (org-fit-window-to-buffer)) + (unless expert (org-fit-window-to-buffer)) (setq rtn (catch 'exit (while t @@ -14873,53 +15365,51 @@ Returns the new tags string, or nil to not change the current settings." (org-fit-window-to-buffer))) ((or (= c ?\C-g) (and (= c ?q) (not (rassoc c ntable)))) - (org-detach-overlay org-tags-overlay) + (delete-overlay org-tags-overlay) (setq quit-flag t)) ((= c ?\ ) (setq current nil) - (if exit-after-next (setq exit-after-next 'now))) + (when exit-after-next (setq exit-after-next 'now))) ((= c ?\t) (condition-case nil - (setq tg (org-icompleting-read + (setq tg (completing-read "Tag: " (or buffer-tags (with-current-buffer buf - (org-get-buffer-tags))))) + (setq buffer-tags + (org-get-buffer-tags)))))) (quit (setq tg ""))) (when (string-match "\\S-" tg) - (add-to-list 'buffer-tags (list tg)) + (cl-pushnew (list tg) buffer-tags :test #'equal) (if (member tg current) (setq current (delete tg current)) (push tg current))) - (if exit-after-next (setq exit-after-next 'now))) + (when exit-after-next (setq exit-after-next 'now))) ((setq e (rassoc c todo-table) tg (car e)) (with-current-buffer buf (save-excursion (org-todo tg))) - (if exit-after-next (setq exit-after-next 'now))) + (when exit-after-next (setq exit-after-next 'now))) ((setq e (rassoc c ntable) tg (car e)) (if (member tg current) (setq current (delete tg current)) - (loop for g in groups do - (if (member tg g) - (mapc (lambda (x) - (setq current (delete x current))) - g))) + (cl-loop for g in groups do + (when (member tg g) + (dolist (x g) (setq current (delete x current))))) (push tg current)) - (if exit-after-next (setq exit-after-next 'now)))) + (when exit-after-next (setq exit-after-next 'now)))) ;; Create a sorted list (setq current (sort current (lambda (a b) (assoc b (cdr (memq (assoc a ntable) ntable)))))) - (if (eq exit-after-next 'now) (throw 'exit t)) + (when (eq exit-after-next 'now) (throw 'exit t)) (goto-char (point-min)) (beginning-of-line 2) (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) - (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) + (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -14929,7 +15419,7 @@ Returns the new tags string, or nil to not change the current settings." ((member tg inherited) i-face) (t (get-text-property (match-beginning 1) 'face)))))) (goto-char (point-min))))) - (org-detach-overlay org-tags-overlay) + (delete-overlay org-tags-overlay) (if rtn (mapconcat 'identity current ":") nil)))) @@ -14940,8 +15430,8 @@ Returns the new tags string, or nil to not change the current settings." (user-error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (org-match-string-no-properties 1) + (if (looking-at ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + (match-string-no-properties 1) ""))) (defun org-get-tags () @@ -14950,19 +15440,20 @@ Returns the new tags string, or nil to not change the current settings." (defun org-get-buffer-tags () "Get a table of all tags used in the buffer, for completion." - (let (tags) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) - (when (equal (char-after (point-at-bol 0)) ?*) - (mapc (lambda (x) (add-to-list 'tags x)) - (org-split-string (org-match-string-no-properties 1) ":"))))) - (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags) - (mapcar 'list tags))) + (org-with-wide-buffer + (goto-char (point-min)) + (let ((tag-re (concat org-outline-regexp-bol + "\\(?:.*?[ \t]\\)?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) + tags) + (while (re-search-forward tag-re nil t) + (dolist (tag (org-split-string (match-string-no-properties 1) ":")) + (push tag tags))) + (mapcar #'list (append org-file-tags (org-uniquify tags)))))) ;;;; The mapping API +(defvar org-agenda-skip-comment-trees) +(defvar org-agenda-skip-function) (defun org-map-entries (func &optional match scope &rest skip) "Call FUNC at each headline selected by MATCH in SCOPE. @@ -15032,13 +15523,12 @@ a *different* entry, you cannot use these techniques." (car (org-delete-all '(comment archive) skip))) (org-tags-match-list-sublevels t) (start-level (eq scope 'region-start-level)) - matcher file res + matcher res org-todo-keywords-for-agenda org-done-keywords-for-agenda org-todo-keyword-alist-for-agenda - org-drawers-for-agenda org-tag-alist-for-agenda - todo-only) + org--matcher-tags-todo-only) (cond ((eq match t) (setq matcher t)) @@ -15071,7 +15561,9 @@ a *different* entry, you cannot use these techniques." (progn (org-agenda-prepare-buffers (and buffer-file-name (list buffer-file-name))) - (setq res (org-scan-tags func matcher todo-only start-level))) + (setq res + (org-scan-tags + func matcher org--matcher-tags-todo-only start-level))) ;; Get the right scope (cond ((and scope (listp scope) (symbolp (car scope))) @@ -15088,22 +15580,21 @@ a *different* entry, you cannot use these techniques." (org-agenda-prepare-buffers scope) (dolist (file scope) (with-current-buffer (org-find-base-buffer-visiting file) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (setq res (append res (org-scan-tags func matcher todo-only)))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (setq res + (append + res + (org-scan-tags + func matcher org--matcher-tags-todo-only))))))))) res))) -;;;; Properties - -;;; Setting and retrieving properties +;;; Properties API (defconst org-special-properties - '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T") - "The special properties valid in Org-mode. - + '("ALLTAGS" "BLOCKED" "CLOCKSUM" "CLOCKSUM_T" "CLOSED" "DEADLINE" "FILE" + "ITEM" "PRIORITY" "SCHEDULED" "TAGS" "TIMESTAMP" "TIMESTAMP_IA" "TODO") + "The special properties valid in Org mode. These are properties that are not defined in the property drawer, but in some other way.") @@ -15112,59 +15603,86 @@ but in some other way.") "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" - "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" + "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" "UNNUMBERED" "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") - "Some properties that are used by Org-mode for various purposes. + "Some properties that are used by Org mode for various purposes. Being in this list makes sure that they are offered for completion.") -(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the last line of a property drawer.") - -(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-drawer-re - (concat "\\(" org-property-start-re "\\)[^\000]*\\(" - org-property-end-re "\\)\n?") - "Matches an entire property drawer.") +(defun org--valid-property-p (property) + "Non nil when string PROPERTY is a valid property name." + (not + (or (equal property "") + (string-match-p "\\s-" property)))) + +(defun org--update-property-plist (key val props) + "Associate KEY to VAL in alist PROPS. +Modifications are made by side-effect. Return new alist." + (let* ((appending (string= (substring key -1) "+")) + (key (if appending (substring key 0 -1) key)) + (old (assoc-string key props t))) + (if (not old) (cons (cons key val) props) + (setcdr old (if appending (concat (cdr old) " " val) val)) + props))) + +(defun org-get-property-block (&optional beg force) + "Return the (beg . end) range of the body of the property drawer. +BEG is the beginning of the current subtree, or of the part +before the first headline. If it is not given, it will be found. +If the drawer does not exist, create it if FORCE is non-nil, or +return nil." + (org-with-wide-buffer + (when beg (goto-char beg)) + (unless (org-before-first-heading-p) + (let ((beg (cond (beg) + ((or (not (featurep 'org-inlinetask)) + (org-inlinetask-in-task-p)) + (org-back-to-heading t)) + (t (org-with-limited-levels (org-back-to-heading t)))))) + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (cond ((looking-at org-property-drawer-re) + (forward-line) + (cons (point) (progn (goto-char (match-end 0)) + (line-beginning-position)))) + (force + (goto-char beg) + (org-insert-property-drawer) + (let ((pos (save-excursion (search-forward ":END:") + (line-beginning-position)))) + (cons pos pos)))))))) -(defconst org-clock-drawer-re - (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" - org-property-end-re "\\)\n?") - "Matches an entire clock drawer.") +(defun org-at-property-p () + "Non-nil when point is inside a property drawer. +See `org-property-re' for match data, if applicable." + (save-excursion + (beginning-of-line) + (and (looking-at org-property-re) + (let ((property-drawer (save-match-data (org-get-property-block)))) + (and property-drawer + (>= (point) (car property-drawer)) + (< (point) (cdr property-drawer))))))) (defun org-property-action () "Do an action on properties." (interactive) - (let (c) - (org-at-property-p) - (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") - (setq c (read-char-exclusive)) - (cond - ((equal c ?s) - (call-interactively 'org-set-property)) - ((equal c ?d) - (call-interactively 'org-delete-property)) - ((equal c ?D) - (call-interactively 'org-delete-property-globally)) - ((equal c ?c) - (call-interactively 'org-compute-property-at-point)) - (t (user-error "No such property action %c" c))))) + (unless (org-at-property-p) (user-error "Not at a property")) + (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") + (let ((c (read-char-exclusive))) + (cl-case c + (?s (call-interactively #'org-set-property)) + (?d (call-interactively #'org-delete-property)) + (?D (call-interactively #'org-delete-property-globally)) + (?c (call-interactively #'org-compute-property-at-point)) + (otherwise (user-error "No such property action %c" c))))) (defun org-inc-effort () "Increment the value of the effort property in the current entry." (interactive) (org-set-effort nil t)) -(defvar org-clock-effort) ;; Defined in org-clock.el -(defvar org-clock-current-task) ;; Defined in org-clock.el +(defvar org-clock-effort) ; Defined in org-clock.el. +(defvar org-clock-current-task) ; Defined in org-clock.el. (defun org-set-effort (&optional value increment) "Set the effort property of the current entry. With numerical prefix arg, use the nth allowed value, 0 stands for the @@ -15172,7 +15690,7 @@ With numerical prefix arg, use the nth allowed value, 0 stands for the When INCREMENT is non-nil, set the property to the next allowed value." (interactive "P") - (if (equal value 0) (setq value 10)) + (when (equal value 0) (setq value 10)) (let* ((completion-ignore-case t) (prop org-effort-property) (cur (org-entry-get nil prop)) @@ -15186,7 +15704,7 @@ When INCREMENT is non-nil, set the property to the next allowed value." (or (car (nth (1- value) allowed)) (car (org-last allowed)))) ((and allowed increment) - (or (caadr (member (list cur) allowed)) + (or (cl-caadr (member (list cur) allowed)) (user-error "Allowed effort values are not set"))) (allowed (message "Select 1-9,0, [RET%s]: %s" @@ -15196,231 +15714,295 @@ When INCREMENT is non-nil, set the property to the next allowed value." (if (equal rpl ?\r) cur (setq rpl (- rpl ?0)) - (if (equal rpl 0) (setq rpl 10)) + (when (equal rpl 0) (setq rpl 10)) (if (and (> rpl 0) (<= rpl (length allowed))) (car (nth (1- rpl) allowed)) (org-completing-read "Effort: " allowed nil)))) (t - (let (org-completion-use-ido org-completion-use-iswitchb) - (org-completing-read - (concat "Effort " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") - ": ") - existing nil nil "" nil cur)))))) + (org-completing-read + (concat "Effort" (and cur (string-match "\\S-" cur) + (concat " [" cur "]")) + ": ") + existing nil nil "" nil cur))))) (unless (equal (org-entry-get nil prop) val) (org-entry-put nil prop val)) - (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) - (when (string= heading org-clock-current-task) - (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort)) + (org-refresh-property + '((effort . identity) + (effort-minutes . org-duration-string-to-minutes)) + val) + (when (equal heading (bound-and-true-p org-clock-current-task)) + (setq org-clock-effort (get-text-property (point-at-bol) 'effort)) (org-clock-update-mode-line)) (message "%s is now %s" prop val))) -(defun org-at-property-p () - "Is cursor inside a property drawer?" - (save-excursion - (when (equal 'node-property (car (org-element-at-point))) - (beginning-of-line 1) - (looking-at org-property-re)))) +(defun org-entry-properties (&optional pom which) + "Get all properties of the current entry. + +When POM is a buffer position, get all properties from the entry +there instead. + +This includes the TODO keyword, the tags, time strings for +deadline, scheduled, and clocking, and any additional properties +defined in the entry. -(defun org-get-property-block (&optional beg end force) - "Return the (beg . end) range of the body of the property drawer. -BEG and END are the beginning and end of the current subtree, or of -the part before the first headline. If they are not given, they will -be found. If the drawer does not exist and FORCE is non-nil, create -the drawer." - (catch 'exit - (save-excursion - (let* ((beg (or beg (and (org-before-first-heading-p) (point-min)) - (progn (org-back-to-heading t) (point)))) - (end (or end (and (not (outline-next-heading)) (point-max)) - (point)))) - (goto-char beg) - (if (re-search-forward org-property-start-re end t) - (setq beg (1+ (match-end 0))) - (if force - (save-excursion - (org-insert-property-drawer) - (setq end (progn (outline-next-heading) (point)))) - (throw 'exit nil)) - (goto-char beg) - (if (re-search-forward org-property-start-re end t) - (setq beg (1+ (match-end 0))))) - (if (re-search-forward org-property-end-re end t) - (setq end (match-beginning 0)) - (or force (throw 'exit nil)) - (goto-char beg) - (setq end beg) - (org-indent-line) - (insert ":END:\n")) - (cons beg end))))) - -(defun org-entry-properties (&optional pom which specific) - "Get all properties of the entry at point-or-marker POM. -This includes the TODO keyword, the tags, time strings for deadline, -scheduled, and clocking, and any additional properties defined in the -entry. The return value is an alist, keys may occur multiple times -if the property key was used several times. -POM may also be nil, in which case the current entry is used. If WHICH is nil or `all', get all properties. If WHICH is -`special' or `standard', only get that subclass. If WHICH -is a string only get exactly this property. SPECIFIC can be a string, the -specific property we are interested in. Specifying it can speed -things up because then unnecessary parsing is avoided." - (setq which (or which 'all)) - (org-with-wide-buffer - (org-with-point-at pom - (let ((clockstr (substring org-clock-string 0 -1)) - (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) - (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum clocksumt) - (when (and (derived-mode-p 'org-mode) - (ignore-errors (org-back-to-heading t))) - (setq beg (point)) - (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes) - clocksumt (get-text-property (point) :org-clock-minutes-today)) - (outline-next-heading) - (setq end (point)) - (when (memq which '(all special)) - ;; Get the special properties, like TODO and tags - (goto-char beg) - (when (and (or (not specific) (string= specific "TODO")) - (looking-at org-todo-line-regexp) (match-end 2)) - (push (cons "TODO" (org-match-string-no-properties 2)) props)) - (when (and (or (not specific) (string= specific "PRIORITY")) - (looking-at org-priority-regexp)) - (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (or (not specific) (string= specific "FILE")) - (push (cons "FILE" buffer-file-name) props)) - (when (and (or (not specific) (string= specific "TAGS")) - (setq value (org-get-tags-string)) - (string-match "\\S-" value)) - (push (cons "TAGS" value) props)) - (when (and (or (not specific) (string= specific "ALLTAGS")) - (setq value (org-get-tags-at))) - (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") - ":")) - props)) - (when (or (not specific) (string= specific "BLOCKED")) - (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) - (when (or (not specific) - (member specific - '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" - "TIMESTAMP" "TIMESTAMP_IA"))) - (catch 'match - (while (and (re-search-forward org-maybe-keyword-time-regexp end t) - (not (text-property-any 0 (length (match-string 0)) - 'face 'font-lock-comment-face - (match-string 0)))) - (setq key (if (match-end 1) - (substring (org-match-string-no-properties 1) - 0 -1)) - string (if (equal key clockstr) - (org-trim - (buffer-substring-no-properties - (match-beginning 3) (goto-char - (point-at-eol)))) - (substring (org-match-string-no-properties 3) - 1 -1))) - ;; Get the correct property name from the key. This is - ;; necessary if the user has configured time keywords. - (setq key1 (concat key ":")) - (cond - ((not key) - (setq key - (if (= (char-after (match-beginning 3)) ?\[) - "TIMESTAMP_IA" "TIMESTAMP"))) - ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) - ((equal key1 org-deadline-string) (setq key "DEADLINE")) - ((equal key1 org-closed-string) (setq key "CLOSED")) - ((equal key1 org-clock-string) (setq key "CLOCK"))) - (if (and specific (equal key specific) (not (equal key "CLOCK"))) - (progn - (push (cons key string) props) - ;; no need to search further if match is found - (throw 'match t)) - (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props))))))) - - (when (memq which '(all standard)) - ;; Get the standard properties, like :PROP: ... - (setq range (org-get-property-block beg end)) - (when range - (goto-char (car range)) - (while (re-search-forward org-property-re - (cdr range) t) - (setq key (org-match-string-no-properties 2) - value (org-trim (or (org-match-string-no-properties 3) ""))) - (unless (member key excluded) - (push (cons key (or value "")) props))))) - (if clocksum - (push (cons "CLOCKSUM" - (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) - props)) - (if clocksumt - (push (cons "CLOCKSUM_T" - (org-columns-number-to-string (/ (float clocksumt) 60.) - 'add_times)) - props)) - (unless (assoc "CATEGORY" props) - (push (cons "CATEGORY" (org-get-category)) props)) - (append sum-props (nreverse props))))))) +`special' or `standard', only get that subclass. If WHICH is +a string, only get that property. + +Return value is an alist. Keys are properties, as upcased +strings." + (org-with-point-at pom + (when (and (derived-mode-p 'org-mode) + (ignore-errors (org-back-to-heading t))) + (catch 'exit + (let* ((beg (point)) + (specific (and (stringp which) (upcase which))) + (which (cond ((not specific) which) + ((member specific org-special-properties) 'special) + (t 'standard))) + props) + ;; Get the special properties, like TODO and TAGS. + (when (memq which '(nil all special)) + (when (or (not specific) (string= specific "CLOCKSUM")) + (let ((clocksum (get-text-property (point) :org-clock-minutes))) + (when clocksum + (push (cons "CLOCKSUM" + (org-minutes-to-clocksum-string clocksum)) + props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "CLOCKSUM_T")) + (let ((clocksumt (get-text-property (point) + :org-clock-minutes-today))) + (when clocksumt + (push (cons "CLOCKSUM_T" + (org-minutes-to-clocksum-string clocksumt)) + props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "ITEM")) + (let ((case-fold-search nil)) + (when (looking-at org-complex-heading-regexp) + (push (cons "ITEM" + (let ((title (match-string-no-properties 4))) + (if (org-string-nw-p title) + (org-remove-tabs title) + ""))) + props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "TODO")) + (let ((case-fold-search nil)) + (when (and (looking-at org-todo-line-regexp) (match-end 2)) + (push (cons "TODO" (match-string-no-properties 2)) props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "PRIORITY")) + (push (cons "PRIORITY" + (if (looking-at org-priority-regexp) + (match-string-no-properties 2) + (char-to-string org-default-priority))) + props) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "FILE")) + (push (cons "FILE" (buffer-file-name (buffer-base-buffer))) + props) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "TAGS")) + (let ((value (org-string-nw-p (org-get-tags-string)))) + (when value (push (cons "TAGS" value) props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "ALLTAGS")) + (let ((value (org-get-tags-at))) + (when value + (push (cons "ALLTAGS" + (format ":%s:" (mapconcat #'identity value ":"))) + props))) + (when specific (throw 'exit props))) + (when (or (not specific) (string= specific "BLOCKED")) + (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props) + (when specific (throw 'exit props))) + (when (or (not specific) + (member specific '("CLOSED" "DEADLINE" "SCHEDULED"))) + (forward-line) + (when (looking-at-p org-planning-line-re) + (end-of-line) + (let ((bol (line-beginning-position)) + ;; Backward compatibility: time keywords used to + ;; be configurable (before 8.3). Make sure we + ;; get the correct keyword. + (key-assoc `(("CLOSED" . ,org-closed-string) + ("DEADLINE" . ,org-deadline-string) + ("SCHEDULED" . ,org-scheduled-string)))) + (dolist (pair (if specific (list (assoc specific key-assoc)) + key-assoc)) + (save-excursion + (when (search-backward (cdr pair) bol t) + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (and (looking-at org-ts-regexp-both) + (push (cons (car pair) + (match-string-no-properties 0)) + props))))))) + (when specific (throw 'exit props))) + (when (or (not specific) + (member specific '("TIMESTAMP" "TIMESTAMP_IA"))) + (let ((find-ts + (lambda (end ts) + ;; Fix next time-stamp before END. TS is the + ;; list of time-stamps found so far. + (let ((ts ts) + (regexp (cond + ((string= specific "TIMESTAMP") + org-ts-regexp) + ((string= specific "TIMESTAMP_IA") + org-ts-regexp-inactive) + ((assoc "TIMESTAMP_IA" ts) + org-ts-regexp) + ((assoc "TIMESTAMP" ts) + org-ts-regexp-inactive) + (t org-ts-regexp-both)))) + (catch 'next + (while (re-search-forward regexp end t) + (backward-char) + (let ((object (org-element-context))) + ;; Accept to match timestamps in node + ;; properties, too. + (when (memq (org-element-type object) + '(node-property timestamp)) + (let ((type + (org-element-property :type object))) + (cond + ((and (memq type '(active active-range)) + (not (equal specific "TIMESTAMP_IA"))) + (unless (assoc "TIMESTAMP" ts) + (push (cons "TIMESTAMP" + (org-element-property + :raw-value object)) + ts) + (when specific (throw 'exit ts)))) + ((and (memq type '(inactive inactive-range)) + (not (string= specific "TIMESTAMP"))) + (unless (assoc "TIMESTAMP_IA" ts) + (push (cons "TIMESTAMP_IA" + (org-element-property + :raw-value object)) + ts) + (when specific (throw 'exit ts)))))) + ;; Both timestamp types are found, + ;; move to next part. + (when (= (length ts) 2) (throw 'next ts))))) + ts))))) + (goto-char beg) + ;; First look for timestamps within headline. + (let ((ts (funcall find-ts (line-end-position) nil))) + (if (= (length ts) 2) (setq props (nconc ts props)) + ;; Then find timestamps in the section, skipping + ;; planning line. + (let ((end (save-excursion (outline-next-heading)))) + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (setq props (nconc (funcall find-ts end ts) props)))))))) + ;; Get the standard properties, like :PROP:. + (when (memq which '(nil all standard)) + ;; If we are looking after a specific property, delegate + ;; to `org-entry-get', which is faster. However, make an + ;; exception for "CATEGORY", since it can be also set + ;; through keywords (i.e. #+CATEGORY). + (if (and specific (not (equal specific "CATEGORY"))) + (let ((value (org-entry-get beg specific nil t))) + (throw 'exit (and value (list (cons specific value))))) + (let ((range (org-get-property-block beg))) + (when range + (let ((end (cdr range)) seen-base) + (goto-char (car range)) + ;; Unlike to `org--update-property-plist', we + ;; handle the case where base values is found + ;; after its extension. We also forbid standard + ;; properties to be named as special properties. + (while (re-search-forward org-property-re end t) + (let* ((key (upcase (match-string-no-properties 2))) + (extendp (string-match-p "\\+\\'" key)) + (key-base (if extendp (substring key 0 -1) key)) + (value (match-string-no-properties 3))) + (cond + ((member-ignore-case key-base org-special-properties)) + (extendp + (setq props + (org--update-property-plist key value props))) + ((member key seen-base)) + (t (push key seen-base) + (let ((p (assoc-string key props t))) + (if p (setcdr p (concat value " " (cdr p))) + (push (cons key value) props)))))))))))) + (unless (assoc "CATEGORY" props) + (push (cons "CATEGORY" (org-get-category beg)) props) + (when (string= specific "CATEGORY") (throw 'exit props))) + ;; Return value. + props))))) + +(defun org--property-local-values (property literal-nil) + "Return value for PROPERTY in current entry. +Value is a list whose car is the base value for PROPERTY and cdr +a list of accumulated values. Return nil if neither is found in +the entry. Also return nil when PROPERTY is set to \"nil\", +unless LITERAL-NIL is non-nil." + (let ((range (org-get-property-block))) + (when range + (goto-char (car range)) + (let* ((case-fold-search t) + (end (cdr range)) + (value + ;; Base value. + (save-excursion + (let ((v (and (re-search-forward + (org-re-property property nil t) end t) + (match-string-no-properties 3)))) + (list (if literal-nil v (org-not-nil v))))))) + ;; Find additional values. + (let* ((property+ (org-re-property (concat property "+") nil t))) + (while (re-search-forward property+ end t) + (push (match-string-no-properties 3) value))) + ;; Return final values. + (and (not (equal value '(nil))) (nreverse value)))))) + +(defun org--property-global-value (property literal-nil) + "Return value for PROPERTY in current buffer. +Return value is a string. Return nil if property is not set +globally. Also return nil when PROPERTY is set to \"nil\", +unless LITERAL-NIL is non-nil." + (let ((global + (cdr (or (assoc-string property org-file-properties t) + (assoc-string property org-global-properties t) + (assoc-string property org-global-properties-fixed t))))) + (if literal-nil global (org-not-nil global)))) (defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry or content at point-or-marker POM. -If INHERIT is non-nil and the entry does not have the property, -then also check higher levels of the hierarchy. -If INHERIT is the symbol `selective', use inheritance only if the setting -in `org-use-property-inheritance' selects PROPERTY for inheritance. -If the property is present but empty, the return value is the empty string. -If the property is not present at all, nil is returned. - -Return the value as a string. -If LITERAL-NIL is set, return the string value \"nil\" as a string, -do not interpret it as the list atom nil. This is used for inheritance -when a \"nil\" value can supersede a non-nil value higher up the hierarchy." +If INHERIT is non-nil and the entry does not have the property, +then also check higher levels of the hierarchy. If INHERIT is +the symbol `selective', use inheritance only if the setting in +`org-use-property-inheritance' selects PROPERTY for inheritance. + +If the property is present but empty, the return value is the +empty string. If the property is not present at all, nil is +returned. In any other case, return the value as a string. +Search is case-insensitive. + +If LITERAL-NIL is set, return the string value \"nil\" as +a string, do not interpret it as the list atom nil. This is used +for inheritance when a \"nil\" value can supersede a non-nil +value higher up the hierarchy." (org-with-point-at pom - (if (and inherit (if (eq inherit 'selective) - (org-property-inherit-p property) - t)) - (org-entry-get-with-inheritance property literal-nil) - (if (member property org-special-properties) - ;; We need a special property. Use `org-entry-properties' - ;; to retrieve it, but specify the wanted property - (cdr (assoc property (org-entry-properties nil 'special property))) - (org-with-wide-buffer - (let ((range (org-get-property-block))) - (when (and range (not (eq (car range) (cdr range))) - (save-excursion - (goto-char (car range)) - (re-search-forward - (concat (org-re-property property) "\\|" - (org-re-property (concat property "+"))) - (cdr range) t))) - (let* ((props - (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 3) - (org-match-string-no-properties 3) "") - props))))) - val) - (goto-char (car range)) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val))))))))))) + (cond + ((member-ignore-case property (cons "CATEGORY" org-special-properties)) + ;; We need a special property. Use `org-entry-properties' to + ;; retrieve it, but specify the wanted property. + (cdr (assoc-string property (org-entry-properties nil property)))) + ((and inherit + (or (not (eq inherit 'selective)) (org-property-inherit-p property))) + (org-entry-get-with-inheritance property literal-nil)) + (t + (let* ((local (org--property-local-values property literal-nil)) + (value (and local (mapconcat #'identity (delq nil local) " ")))) + (if literal-nil value (org-not-nil value))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. @@ -15430,26 +16012,26 @@ If yes, return this value. If not, return the current value of the variable." (read prop) (symbol-value var)))) -(defun org-entry-delete (pom property &optional delete-empty-drawer) - "Delete the property PROPERTY from entry at point-or-marker POM. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." +(defun org-entry-delete (pom property) + "Delete PROPERTY from entry at point-or-marker POM. +Accumulated properties, i.e. PROPERTY+, are also removed. Return +non-nil when a property was removed." (org-with-point-at pom - (if (member property org-special-properties) - nil ; cannot delete these properties. - (let ((range (org-get-property-block))) - (if (and range - (goto-char (car range)) - (re-search-forward - (org-re-property property nil t) - (cdr range) t)) - (progn - (delete-region (match-beginning 0) (1+ (point-at-eol))) - (and delete-empty-drawer - (org-remove-empty-drawer-at - delete-empty-drawer (car range))) - t) - nil))))) + (pcase (org-get-property-block) + (`(,begin . ,origin) + (let* ((end (copy-marker origin)) + (re (org-re-property + (concat (regexp-quote property) "\\+?") t t))) + (goto-char begin) + (while (re-search-forward re end t) + (delete-region (match-beginning 0) (line-beginning-position 2))) + ;; If drawer is empty, remove it altogether. + (when (= begin end) + (delete-region (line-beginning-position 0) + (line-beginning-position 2))) + ;; Return non-nil if some property was removed. + (prog1 (/= end origin) (set-marker end nil)))) + (_ nil)))) ;; Multi-values properties are properties that contain multiple values ;; These values are assumed to be single words, separated by whitespace. @@ -15526,24 +16108,29 @@ If the value found is \"nil\", return nil to show that the property should be considered as undefined (this is the meaning of nil here). However, if LITERAL-NIL is set, return the string value \"nil\" instead." (move-marker org-entry-property-inherited-from nil) - (let (tmp) - (save-excursion - (save-restriction - (widen) - (catch 'ex - (while t - (when (setq tmp (org-entry-get nil property nil literal-nil)) - (or (ignore-errors (org-back-to-heading t)) - (goto-char (point-min))) - (move-marker org-entry-property-inherited-from (point)) - (throw 'ex tmp)) - (or (ignore-errors (org-up-heading-safe)) - (throw 'ex nil)))))) - (setq tmp (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))) - (if literal-nil tmp (org-not-nil tmp)))) + (org-with-wide-buffer + (let (value) + (catch 'exit + (while t + (let ((v (org--property-local-values property literal-nil))) + (when v + (setq value + (concat (mapconcat #'identity (delq nil v) " ") + (and value " ") + value))) + (cond + ((car v) + (org-back-to-heading t) + (move-marker org-entry-property-inherited-from (point)) + (throw 'exit nil)) + ((org-up-heading-safe)) + (t + (let ((global (org--property-global-value property literal-nil))) + (cond ((not global)) + (value (setq value (concat global " " value))) + (t (setq value global)))) + (throw 'exit nil)))))) + (if literal-nil value (org-not-nil value))))) (defvar org-property-changed-functions nil "Hook called when the value of a property has changed. @@ -15552,177 +16139,188 @@ and the new value.") (defun org-entry-put (pom property value) "Set PROPERTY to VALUE for entry at point-or-marker POM. -If the value is nil, it is converted to the empty string. -If it is not a string, an error is raised." + +If the value is nil, it is converted to the empty string. If it +is not a string, an error is raised. Also raise an error on +invalid property names. + +PROPERTY can be any regular property (see +`org-special-properties'). It can also be \"TODO\", +\"PRIORITY\", \"SCHEDULED\" and \"DEADLINE\". + +For the last two properties, VALUE may have any of the special +values \"earlier\" and \"later\". The function then increases or +decreases scheduled or deadline date by one day." (cond ((null value) (setq value "")) - ((not (stringp value)) - (error "Properties values should be strings."))) + ((not (stringp value)) (error "Properties values should be strings")) + ((not (org--valid-property-p property)) + (user-error "Invalid property name: \"%s\"" property))) (org-with-point-at pom - (org-back-to-heading t) - (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) - range) + (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) + (org-back-to-heading t) + (org-with-limited-levels (org-back-to-heading t))) + (let ((beg (point))) (cond ((equal property "TODO") - (when (and (string-match "\\S-" value) - (not (member value org-todo-keywords-1))) - (user-error "\"%s\" is not a valid TODO state" value)) - (if (or (not value) - (not (string-match "\\S-" value))) - (setq value 'none)) + (cond ((not (org-string-nw-p value)) (setq value 'none)) + ((not (member value org-todo-keywords-1)) + (user-error "\"%s\" is not a valid TODO state" value))) (org-todo value) (org-set-tags nil 'align)) ((equal property "PRIORITY") - (org-priority (if (and value (string-match "\\S-" value)) - (string-to-char value) ?\ )) + (org-priority (if (org-string-nw-p value) (string-to-char value) ?\s)) (org-set-tags nil 'align)) - ((equal property "CLOCKSUM") - (if (not (re-search-forward - (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t)) - (error "Cannot find a clock log") - (goto-char (- (match-end 1) 2)) - (cond - ((eq value 'earlier) (org-timestamp-down)) - ((eq value 'later) (org-timestamp-up))) - (org-clock-sum-current-item))) ((equal property "SCHEDULED") - (if (re-search-forward org-scheduled-time-regexp end t) - (cond - ((eq value 'earlier) (org-timestamp-change -1 'day)) - ((eq value 'later) (org-timestamp-change 1 'day)) - (t (call-interactively 'org-schedule))) - (call-interactively 'org-schedule))) + (forward-line) + (if (and (looking-at-p org-planning-line-re) + (re-search-forward + org-scheduled-time-regexp (line-end-position) t)) + (cond ((string= value "earlier") (org-timestamp-change -1 'day)) + ((string= value "later") (org-timestamp-change 1 'day)) + ((string= value "") (org-schedule '(4))) + (t (org-schedule nil value))) + (if (member value '("earlier" "later" "")) + (call-interactively #'org-schedule) + (org-schedule nil value)))) ((equal property "DEADLINE") - (if (re-search-forward org-deadline-time-regexp end t) - (cond - ((eq value 'earlier) (org-timestamp-change -1 'day)) - ((eq value 'later) (org-timestamp-change 1 'day)) - (t (call-interactively 'org-deadline))) - (call-interactively 'org-deadline))) + (forward-line) + (if (and (looking-at-p org-planning-line-re) + (re-search-forward + org-deadline-time-regexp (line-end-position) t)) + (cond ((string= value "earlier") (org-timestamp-change -1 'day)) + ((string= value "later") (org-timestamp-change 1 'day)) + ((string= value "") (org-deadline '(4))) + (t (org-deadline nil value))) + (if (member value '("earlier" "later" "")) + (call-interactively #'org-deadline) + (org-deadline nil value)))) ((member property org-special-properties) - (error "The %s property can not yet be set with `org-entry-put'" - property)) - (t ; a non-special property - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 - (setq range (org-get-property-block beg end 'force)) + (error "The %s property cannot be set with `org-entry-put'" property)) + (t + (let* ((range (org-get-property-block beg 'force)) + (end (cdr range)) + (case-fold-search t)) (goto-char (car range)) - (if (re-search-forward - (org-re-property property nil t) (cdr range) t) - (progn - (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char (cdr range)) + (if (re-search-forward (org-re-property property nil t) end t) + (progn (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char end) (insert "\n") - (backward-char 1) - (org-indent-line)) + (backward-char)) (insert ":" property ":") - (and value (insert " " value)) + (when value (insert " " value)) (org-indent-line))))) (run-hook-with-args 'org-property-changed-functions property value))) -(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) +(defun org-buffer-property-keys + (&optional specials defaults columns ignore-malformed) "Get all property keys in the current buffer. -With INCLUDE-SPECIALS, also list the special properties that reflect things -like tags and TODO state. -With INCLUDE-DEFAULTS, also include properties that has special meaning -internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING -and others. -With INCLUDE-COLUMNS, also include property names given in COLUMN -formats in the current buffer." - (let (rtn range cfmt s p) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-property-start-re nil t) - (setq range (org-get-property-block)) - (goto-char (car range)) - (while (re-search-forward org-property-re - (cdr range) t) - (add-to-list 'rtn (org-match-string-no-properties 2))) - (outline-next-heading)))) - (when include-specials - (setq rtn (append org-special-properties rtn))) +When SPECIALS is non-nil, also list the special properties that +reflect things like tags and TODO state. - (when include-defaults - (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties) - (add-to-list 'rtn org-effort-property)) +When DEFAULTS is non-nil, also include properties that has +special meaning internally: ARCHIVE, CATEGORY, SUMMARY, +DESCRIPTION, LOCATION, and LOGGING and others. - (when include-columns - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward - "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)" - nil t) - (setq cfmt (match-string 2) s 0) - (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)") - cfmt s) - (setq s (match-end 0) - p (match-string 1 cfmt)) - (unless (or (equal p "ITEM") - (member p org-special-properties)) - (add-to-list 'rtn (match-string 1 cfmt)))))))) - - (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) +When COLUMNS in non-nil, also include property names given in +COLUMN formats in the current buffer. + +When IGNORE-MALFORMED is non-nil, malformed drawer repair will not be +automatically performed, such drawers will be silently ignored." + (let ((case-fold-search t) + (props (append + (and specials org-special-properties) + (and defaults (cons org-effort-property org-default-properties)) + nil))) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-property-start-re nil t) + (let ((range (org-get-property-block))) + (catch 'skip + (unless range + (when (and (not ignore-malformed) + (not (org-before-first-heading-p)) + (y-or-n-p (format "Malformed drawer at %d, repair?" + (line-beginning-position)))) + (org-get-property-block nil t)) + (throw 'skip nil)) + (goto-char (car range)) + (let ((begin (car range)) + (end (cdr range))) + ;; Make sure that found property block is not located + ;; before current point, as it would generate an infloop. + ;; It can happen, for example, in the following + ;; situation: + ;; + ;; * Headline + ;; :PROPERTIES: + ;; ... + ;; :END: + ;; *************** Inlinetask + ;; #+BEGIN_EXAMPLE + ;; :PROPERTIES: + ;; #+END_EXAMPLE + ;; + (if (< begin (point)) (throw 'skip nil) (goto-char begin)) + (while (< (point) end) + (let ((p (progn (looking-at org-property-re) + (match-string-no-properties 2)))) + ;; Only add true property name, not extension symbol. + (push (if (not (string-match-p "\\+\\'" p)) p + (substring p 0 -1)) + props)) + (forward-line)))) + (outline-next-heading))) + (when columns + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*\\(?:#\\+\\|:\\)COLUMNS:" nil t) + (let ((element (org-element-at-point))) + (when (memq (org-element-type element) '(keyword node-property)) + (let ((value (org-element-property :value element)) + (start 0)) + (while (string-match "%[0-9]*\\(\\S-+\\)" value start) + (setq start (match-end 0)) + (let ((p (match-string-no-properties 1 value))) + (unless (member-ignore-case p org-special-properties) + (push p props)))))))))) + (sort (delete-dups props) (lambda (a b) (string< (upcase a) (upcase b)))))) (defun org-property-values (key) - "Return a list of all values of property KEY in the current buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((re (org-re-property key)) - values) - (while (re-search-forward re nil t) - (add-to-list 'values (org-trim (match-string 3)))) - (delete "" values))))) + "List all non-nil values of property KEY in current buffer." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t) + (re (org-re-property key)) + values) + (while (re-search-forward re nil t) + (push (org-entry-get (point) key) values)) + (delete-dups values)))) (defun org-insert-property-drawer () "Insert a property drawer into the current entry." - (org-back-to-heading t) - (looking-at org-outline-regexp) - (let ((indent (if org-adapt-indentation - (- (match-end 0) (match-beginning 0)) - 0)) - (beg (point)) - (re (concat "^[ \t]*" org-keyword-time-regexp)) - end hiddenp) - (outline-next-heading) - (setq end (point)) - (goto-char beg) - (while (re-search-forward re end t)) - (setq hiddenp (outline-invisible-p)) - (end-of-line 1) - (and (equal (char-after) ?\n) (forward-char 1)) - (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") - (if (member (match-string 1) '("CLOCK:" ":END:")) - ;; just skip this line - (beginning-of-line 2) - ;; Drawer start, find the end - (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t) - (beginning-of-line 1))) - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r") - (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n))) - (forward-char 1)) - (goto-char (point-at-eol)) - (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) - (beginning-of-line 0) - (org-indent-to-column indent) - (beginning-of-line 2) - (org-indent-to-column indent) - (beginning-of-line 0) - (if hiddenp - (save-excursion - (org-back-to-heading t) - (hide-entry)) - (org-flag-drawer t)))) + (org-with-wide-buffer + (if (or (not (featurep 'org-inlinetask)) (org-inlinetask-in-task-p)) + (org-back-to-heading t) + (org-with-limited-levels (org-back-to-heading t))) + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (unless (looking-at-p org-property-drawer-re) + ;; Make sure we start editing a line from current entry, not from + ;; next one. It prevents extending text properties or overlays + ;; belonging to the latter. + (when (bolp) (backward-char)) + (let ((begin (1+ (point))) + (inhibit-read-only t)) + (insert "\n:PROPERTIES:\n:END:") + (when (eobp) (insert "\n")) + (org-indent-region begin (point)))))) (defun org-insert-drawer (&optional arg drawer) "Insert a drawer at point. +When optional argument ARG is non-nil, insert a property drawer. + Optional argument DRAWER, when non-nil, is a string representing drawer's name. Otherwise, the user is prompted for a name. @@ -15731,23 +16329,14 @@ instead. Point is left between drawer's boundaries." (interactive "P") - (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer - "LOGBOOK")) - ;; SYSTEM-DRAWERS is a list of drawer names that are used - ;; internally by Org. They are meant to be inserted - ;; automatically. - (system-drawers `("CLOCK" ,logbook "PROPERTIES")) - ;; Remove system drawers from list. Note: For some reason, - ;; `org-completing-read' ignores the predicate while - ;; `completing-read' handles it fine. - (drawer (if arg "PROPERTIES" - (or drawer - (completing-read - "Drawer: " org-drawers - (lambda (d) (not (member d system-drawers)))))))) + (let* ((drawer (if arg "PROPERTIES" + (or drawer (read-from-minibuffer "Drawer: "))))) (cond ;; With C-u, fall back on `org-insert-property-drawer' (arg (org-insert-property-drawer)) + ;; Check validity of suggested drawer's name. + ((not (string-match-p org-drawer-regexp (format ":%s:" drawer))) + (user-error "Invalid drawer name")) ;; With an active region, insert a drawer at point. ((not (org-region-active-p)) (progn @@ -15813,38 +16402,25 @@ This is computed according to `org-property-set-functions-alist'." (funcall set-function prompt allowed nil (not (get-text-property 0 'org-unrestricted (caar allowed)))) - (let (org-completion-use-ido org-completion-use-iswitchb) - (funcall set-function prompt - (mapcar 'list (org-property-values property)) - nil nil "" nil cur))))) + (funcall set-function prompt + (mapcar 'list (org-property-values property)) + nil nil "" nil cur)))) (org-trim val))) (defvar org-last-set-property nil) (defvar org-last-set-property-value nil) (defun org-read-property-name () "Read a property name." - (let* ((completion-ignore-case t) - (keys (org-buffer-property-keys nil t t)) - (default-prop (or (save-excursion - (save-match-data - (beginning-of-line) - (and (looking-at "^\\s-*:\\([^:\n]+\\):") - (null (string= (match-string 1) "END")) - (match-string 1)))) - org-last-set-property)) - (property (org-icompleting-read - (concat "Property" - (if default-prop (concat " [" default-prop "]") "") - ": ") - (mapcar 'list keys) - nil nil nil nil - default-prop))) - (if (member property keys) - property - (or (cdr (assoc (downcase property) - (mapcar (lambda (x) (cons (downcase x) x)) - keys))) - property)))) + (let ((completion-ignore-case t) + (default-prop (or (and (org-at-property-p) + (match-string-no-properties 2)) + org-last-set-property))) + (org-completing-read + (concat "Property" + (if default-prop (concat " [" default-prop "]") "") + ": ") + (mapcar #'list (org-buffer-property-keys nil t t)) + nil nil nil nil default-prop))) (defun org-set-property-and-value (use-last) "Allow to set [PROPERTY]: [value] direction from prompt. @@ -15865,26 +16441,52 @@ When use-default, don't even ask, just use the last (defun org-set-property (property value) "In the current entry, set PROPERTY to VALUE. + When called interactively, this will prompt for a property name, offering completion on existing and default properties. And then it will prompt for a value, offering completion either on allowed values (via an inherited xxx_ALL property) or on existing values in other instances of this property -in the current file." +in the current file. + +Throw an error when trying to set a property with an invalid name." (interactive (list nil nil)) - (let* ((property (or property (org-read-property-name))) - (value (or value (org-read-property-value property))) - (fn (cdr (assoc property org-properties-postprocess-alist)))) - (setq org-last-set-property property) - (setq org-last-set-property-value (concat property ": " value)) - ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall fn value))) - (unless (equal (org-entry-get nil property) value) - (org-entry-put nil property value)))) - -(defun org-delete-property (property &optional delete-empty-drawer) - "In the current entry, delete PROPERTY. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." + (let ((property (or property (org-read-property-name)))) + ;; `org-entry-put' also makes the following check, but this one + ;; avoids polluting `org-last-set-property' and + ;; `org-last-set-property-value' needlessly. + (unless (org--valid-property-p property) + (user-error "Invalid property name: \"%s\"" property)) + (let ((value (or value (org-read-property-value property))) + (fn (cdr (assoc-string property org-properties-postprocess-alist t)))) + (setq org-last-set-property property) + (setq org-last-set-property-value (concat property ": " value)) + ;; Possibly postprocess the inserted value: + (when fn (setq value (funcall fn value))) + (unless (equal (org-entry-get nil property) value) + (org-entry-put nil property value))))) + +(defun org-find-property (property &optional value) + "Find first entry in buffer that sets PROPERTY. + +When optional argument VALUE is non-nil, only consider an entry +if it contains PROPERTY set to this value. If PROPERTY should be +explicitly set to nil, use string \"nil\" for VALUE. + +Return position where the entry begins, or nil if there is no +such entry. If narrowing is in effect, only search the visible +part of the buffer." + (save-excursion + (goto-char (point-min)) + (let ((case-fold-search t) + (re (org-re-property property nil (not value) value))) + (catch 'exit + (while (re-search-forward re nil t) + (when (if value (org-at-property-p) + (org-entry-get (point) property nil t)) + (throw 'exit (progn (org-back-to-heading t) (point))))))))) + +(defun org-delete-property (property) + "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) (cat (org-entry-get (point) "CATEGORY")) @@ -15892,33 +16494,30 @@ an empty drawer to delete." (props (if cat props0 (delete `("CATEGORY" . ,(org-get-category)) props0))) (prop (if (< 1 (length props)) - (org-icompleting-read "Property: " props nil t) + (completing-read "Property: " props nil t) (caar props)))) (list prop))) (if (not property) (message "No property to delete in this entry") - (org-entry-delete nil property delete-empty-drawer) + (org-entry-delete nil property) (message "Property \"%s\" deleted" property))) (defun org-delete-property-globally (property) - "Remove PROPERTY globally, from all entries." + "Remove PROPERTY globally, from all entries. +This function ignores narrowing, if any." (interactive (let* ((completion-ignore-case t) - (prop (org-icompleting-read + (prop (completing-read "Globally remove property: " - (mapcar 'list (org-buffer-property-keys))))) + (mapcar #'list (org-buffer-property-keys))))) (list prop))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward - (org-re-property property) - nil t) - (setq cnt (1+ cnt)) - (delete-region (match-beginning 0) (1+ (point-at-eol)))) - (message "Property \"%s\" removed from %d entries" property cnt))))) + (org-with-wide-buffer + (goto-char (point-min)) + (let ((count 0) + (re (org-re-property (concat (regexp-quote property) "\\+?") t t))) + (while (re-search-forward re nil t) + (when (org-entry-delete (point) property) (cl-incf count))) + (message "Property \"%s\" removed from %d entries" property count)))) (defvar org-columns-current-fmt-compiled) ; defined in org-colview.el @@ -15929,9 +16528,9 @@ then applies it to the property in the column format's scope." (interactive) (unless (org-at-property-p) (user-error "Not at a property")) - (let ((prop (org-match-string-no-properties 2))) + (let ((prop (match-string-no-properties 2))) (org-columns-get-format-and-top-level) - (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) + (unless (nth 3 (assoc-string prop org-columns-current-fmt-compiled t)) (user-error "No operator defined for property %s" prop)) (org-columns-compute prop))) @@ -15958,6 +16557,7 @@ completion." (while (>= n org-highest-priority) (push (char-to-string n) vals) (setq n (1- n))))) + ((equal property "CATEGORY")) ((member property org-special-properties)) ((setq vals (run-hook-with-args-until-success 'org-property-allowed-value-functions property))) @@ -15976,7 +16576,7 @@ completion." (org-add-props (car vals) '(org-unrestricted t))) (if table (mapcar 'list vals) vals))) -(defun org-property-previous-allowed-value (&optional previous) +(defun org-property-previous-allowed-value (&optional _previous) "Switch to the next allowed value for this property." (interactive) (org-property-next-allowed-value t)) @@ -15996,21 +16596,22 @@ completion." nval) (unless allowed (user-error "Allowed values for this property have not been defined")) - (if previous (setq allowed (reverse allowed))) - (if (member value allowed) - (setq nval (car (cdr (member value allowed))))) + (when previous (setq allowed (reverse allowed))) + (when (member value allowed) + (setq nval (car (cdr (member value allowed))))) (setq nval (or nval (car allowed))) - (if (equal nval value) - (user-error "Only one allowed value for this property")) + (when (equal nval value) + (user-error "Only one allowed value for this property")) (org-at-property-p) (replace-match (concat " :" key ": " nval) t t) (org-indent-line) (beginning-of-line 1) (skip-chars-forward " \t") (when (equal prop org-effort-property) - (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)) + (org-refresh-property + '((effort . identity) + (effort-minutes . org-duration-string-to-minutes)) + nval) (when (string= org-clock-current-task heading) (setq org-clock-effort nval) (org-clock-update-mode-line))) @@ -16035,31 +16636,28 @@ only headings." (level 1) (lmin 1) (lmax 1) - limit re end found pos heading cnt flevel) + end found flevel) (unless buffer (error "File not found :%s" file)) (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (dolist (heading path) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-at-heading-p) - (point-marker))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (dolist (heading path) + (let ((re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (cnt 0)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (when (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) + (when (= cnt 0) + (error "Heading not found on level %d: %s" lmax heading)) + (when (> cnt 1) + (error "Heading not unique on level %d: %s" lmax heading)) + (goto-char found) + (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t))))) + (when (org-at-heading-p) + (point-marker)))))) (defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) "Find node HEADING in BUFFER. @@ -16069,24 +16667,22 @@ If POS-ONLY is set, return just the position instead of a marker. The heading text must match exact, but it may have a TODO keyword, a priority cookie and tags in the standard locations." (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let (case-fold-search) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) nil t) - (if pos-only - (match-beginning 0) - (move-marker (make-marker) (match-beginning 0))))))))) + (org-with-wide-buffer + (goto-char (point-min)) + (let (case-fold-search) + (when (re-search-forward + (format org-complex-heading-regexp-format + (regexp-quote heading)) nil t) + (if pos-only + (match-beginning 0) + (move-marker (make-marker) (match-beginning 0)))))))) (defun org-find-exact-heading-in-directory (heading &optional dir) "Find Org node headline HEADING in all .org files in directory DIR. When the target headline is found, return a marker to this location." (let ((files (directory-files (or dir default-directory) - nil "\\`[^.#].*\\.org\\'")) - file visiting m buffer) + t "\\`[^.#].*\\.org\\'")) + visiting m buffer) (catch 'found (dolist (file files) (message "trying %s" file) @@ -16105,19 +16701,10 @@ Return the position where this entry starts, or nil if there is no such entry." (interactive "sID: ") (let ((id (cond ((stringp ident) ident) - ((symbol-name ident) (symbol-name ident)) + ((symbolp ident) (symbol-name ident)) ((numberp ident) (number-to-string ident)) - (t (error "IDENT %s must be a string, symbol or number" ident)))) - (case-fold-search nil)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (re-search-forward - (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") - nil t) - (org-back-to-heading t) - (point)))))) + (t (error "IDENT %s must be a string, symbol or number" ident))))) + (org-with-wide-buffer (org-find-property "ID" id)))) ;;;; Timestamps @@ -16128,17 +16715,16 @@ Return the position where this entry starts, or nil if there is no such entry." (defun org-time-stamp (arg &optional inactive) "Prompt for a date/time and insert a time stamp. + If the user specifies a time like HH:MM or if this command is called with at least one prefix argument, the time stamp contains -the date and the time. Otherwise, only the date is be included. +the date and the time. Otherwise, only the date is included. -All parts of a date not specified by the user is filled in from -the current date/time. So if you just press return without -typing anything, the time stamp will represent the current -date/time. +All parts of a date not specified by the user are filled in from +the timestamp at point, if any, or the current date/time +otherwise. -If there is already a timestamp at the cursor, it will be -modified. +If there is already a timestamp at the cursor, it is replaced. With two universal prefix arguments, insert an active timestamp with the current time without prompting the user. @@ -16146,57 +16732,56 @@ with the current time without prompting the user. When called from lisp, the timestamp is inactive if INACTIVE is non-nil." (interactive "P") - (let* ((ts nil) - (default-time - ;; Default time is either today, or, when entering a range, - ;; the range start. - (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) - (save-excursion - (re-search-backward - (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses - (- (point) 20) t))) - (apply 'encode-time (org-parse-time-string (match-string 1))) - (current-time))) - (default-input (and ts (org-get-compact-tod ts))) - (repeater (save-excursion - (save-match-data - (beginning-of-line) - (when (re-search-forward - "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - (save-excursion (progn (end-of-line) (point))) t) - (match-string 0))))) - org-time-was-given org-end-time-was-given time) + (let* ((ts (cond + ((org-at-date-range-p t) + (match-string (if (< (point) (- (match-beginning 2) 2)) 1 2))) + ((org-at-timestamp-p t) (match-string 0)))) + ;; Default time is either the timestamp at point or today. + ;; When entering a range, only the range start is considered. + (default-time (if (not ts) (current-time) + (apply #'encode-time (org-parse-time-string ts)))) + (default-input (and ts (org-get-compact-tod ts))) + (repeater (and ts + (string-match "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ts) + (match-string 0 ts))) + org-time-was-given + org-end-time-was-given + (time + (and (if (equal arg '(16)) (current-time) + ;; Preserve `this-command' and `last-command'. + (let ((this-command this-command) + (last-command last-command)) + (org-read-date + arg 'totime nil nil default-time default-input + inactive)))))) (cond - ((and (org-at-timestamp-p t) - (memq last-command '(org-time-stamp org-time-stamp-inactive)) - (memq this-command '(org-time-stamp org-time-stamp-inactive))) + ((and ts + (memq last-command '(org-time-stamp org-time-stamp-inactive)) + (memq this-command '(org-time-stamp org-time-stamp-inactive))) (insert "--") - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil - default-time default-input inactive))) (org-insert-time-stamp time (or org-time-was-given arg) inactive)) - ((org-at-timestamp-p t) - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input inactive))) - (when (org-at-timestamp-p t) ; just to get the match data - ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) - (replace-match "") + (ts + ;; Make sure we're on a timestamp. When in the middle of a date + ;; range, move arbitrarily to range end. + (unless (org-at-timestamp-p t) + (skip-chars-forward "-") + (org-at-timestamp-p t)) + (replace-match "") + (setq org-last-changed-timestamp + (org-insert-time-stamp + time (or org-time-was-given arg) + inactive nil nil (list org-end-time-was-given))) + (when repeater + (backward-char) + (insert " " repeater) (setq org-last-changed-timestamp - (org-insert-time-stamp - time (or org-time-was-given arg) - inactive nil nil (list org-end-time-was-given))) - (when repeater (goto-char (1- (point))) (insert " " repeater) - (setq org-last-changed-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater ">")))) + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater ">"))) (message "Timestamp updated")) - ((equal arg '(16)) - (org-insert-time-stamp (current-time) t inactive)) - (t - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input inactive))) - (org-insert-time-stamp time (or org-time-was-given arg) inactive - nil nil (list org-end-time-was-given)))))) + ((equal arg '(16)) (org-insert-time-stamp time t inactive)) + (t (org-insert-time-stamp + time (or org-time-was-given arg) inactive nil nil + (list org-end-time-was-given)))))) ;; FIXME: can we use this for something else, like computing time differences? (defun org-get-compact-tod (s) @@ -16211,7 +16796,7 @@ non-nil." (if (not t2) t1 (setq dh (- h2 h1) dm (- m2 m1)) - (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) + (when (< dm 0) (setq dm (+ dm 60) dh (1- dh))) (concat t1 "+" (number-to-string dh) (and (/= 0 dm) (format ":%02d" dm))))))) @@ -16226,7 +16811,7 @@ So these are more for recording a certain time/date." (defvar org-date-ovl (make-overlay 1 1)) (overlay-put org-date-ovl 'face 'org-date-selected) -(org-detach-overlay org-date-ovl) +(delete-overlay org-date-ovl) (defvar org-ans1) ; dynamically scoped parameter (defvar org-ans2) ; dynamically scoped parameter @@ -16243,13 +16828,14 @@ So these are more for recording a certain time/date." (defvar org-read-date-inactive) (defvar org-read-date-minibuffer-local-map - (let* ((org-replace-disputed-keys nil) - (map (make-sparse-keymap))) + (let* ((map (make-sparse-keymap))) (set-keymap-parent map minibuffer-local-map) (org-defkey map (kbd ".") (lambda () (interactive) ;; Are we at the beginning of the prompt? - (if (looking-back "^[^:]+: ") + (if (looking-back "^[^:]+: " + (let ((inhibit-field-text-motion t)) + (line-beginning-position))) (org-eval-in-calendar '(calendar-goto-today)) (insert ".")))) (org-defkey map (kbd "C-.") @@ -16316,7 +16902,8 @@ So these are more for recording a certain time/date." (defvar org-defdecode) (defvar org-with-time) -(defun org-read-date (&optional org-with-time to-time from-string prompt +(defvar calendar-setup) ; Dynamically scoped. +(defun org-read-date (&optional with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. The prompt will suggest to enter an ISO date, but you can also enter anything @@ -16360,8 +16947,8 @@ If you don't like the calendar, turn it off with With optional argument TO-TIME, the date will immediately be converted to an internal time. -With an optional argument ORG-WITH-TIME, the prompt will suggest to -also insert a time. Note that when ORG-WITH-TIME is not set, you can +With an optional argument WITH-TIME, the prompt will suggest to +also insert a time. Note that when WITH-TIME is not set, you can still enter a time, and this function will inform the calling routine about this change. The calling routine may then choose to change the format used to insert the time stamp into the buffer to include the time. @@ -16370,75 +16957,90 @@ the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is the time/date that is used for everything that is not specified by the user." (require 'parse-time) - (let* ((org-time-stamp-rounding-minutes - (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) + (let* ((org-with-time with-time) + (org-time-stamp-rounding-minutes + (if (equal org-with-time '(16)) + '(0 0) + org-time-stamp-rounding-minutes)) (org-dcst org-display-custom-times) (ct (org-current-time)) (org-def (or org-overriding-default-time default-time ct)) (org-defdecode (decode-time org-def)) - (dummy (progn - (when (< (nth 2 org-defdecode) org-extend-today-until) - (setcar (nthcdr 2 org-defdecode) -1) - (setcar (nthcdr 1 org-defdecode) 59) - (setq org-def (apply 'encode-time org-defdecode) - org-defdecode (decode-time org-def))))) - (mouse-autoselect-window nil) ; Don't let the mouse jump - (calendar-frame-setup nil) - (calendar-setup nil) + (cur-frame (selected-frame)) + (mouse-autoselect-window nil) ; Don't let the mouse jump + (calendar-setup + (and (eq calendar-setup 'calendar-only) 'calendar-only)) (calendar-move-hook nil) (calendar-view-diary-initially-flag nil) (calendar-view-holidays-initially-flag nil) - (timestr (format-time-string - (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def)) - (prompt (concat (if prompt (concat prompt " ") "") - (format "Date+time [%s]: " timestr))) - ans (org-ans0 "") org-ans1 org-ans2 final) - - (cond - (from-string (setq ans from-string)) - (org-read-date-popup-calendar - (save-excursion - (save-window-excursion - (calendar) - (org-eval-in-calendar '(setq cursor-type nil) t) - (unwind-protect - (progn - (calendar-forward-day (- (time-to-days org-def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map - (copy-keymap org-read-date-minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map [mouse-1] 'org-calendar-select-mouse) - (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (unwind-protect - (progn - (use-local-map map) - (setq org-read-date-inactive inactive) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - (bury-buffer "*Calendar*"))))) - - (t ; Naked prompt only - (unwind-protect - (setq ans (read-string prompt default-input - 'org-read-date-history timestr)) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) + ans (org-ans0 "") org-ans1 org-ans2 final cal-frame) + ;; Rationalize `org-def' and `org-defdecode', if required. + (when (< (nth 2 org-defdecode) org-extend-today-until) + (setf (nth 2 org-defdecode) -1) + (setf (nth 1 org-defdecode) 59) + (setq org-def (apply #'encode-time org-defdecode)) + (setq org-defdecode (decode-time org-def))) + (let* ((timestr (format-time-string + (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") + org-def)) + (prompt (concat (if prompt (concat prompt " ") "") + (format "Date+time [%s]: " timestr)))) + (cond + (from-string (setq ans from-string)) + (org-read-date-popup-calendar + (save-excursion + (save-window-excursion + (calendar) + (when (eq calendar-setup 'calendar-only) + (setq cal-frame + (window-frame (get-buffer-window "*Calendar*" 'visible))) + (select-frame cal-frame)) + (org-eval-in-calendar '(setq cursor-type nil) t) + (unwind-protect + (progn + (calendar-forward-day (- (time-to-days org-def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) + (unwind-protect + (progn + (use-local-map map) + (setq org-read-date-inactive inactive) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 + (read-string prompt + default-input + 'org-read-date-history + nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans + (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + (bury-buffer "*Calendar*") + (when cal-frame + (delete-frame cal-frame) + (select-frame-set-input-focus cur-frame)))))) + + (t ; Naked prompt only + (unwind-protect + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil)))))) (setq final (org-read-date-analyze ans org-def org-defdecode)) @@ -16499,13 +17101,18 @@ user." (make-overlay (1- (point-at-eol)) (point-at-eol))) (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) -(defun org-read-date-analyze (ans org-def org-defdecode) +(defun org-read-date-analyze (ans def defdecode) "Analyze the combined answer of the date prompt." ;; FIXME: cleanup and comment - (let ((nowdecode (decode-time)) + ;; Pass `current-time' result to `decode-time' (instead of calling + ;; without arguments) so that only `current-time' has to be + ;; overriden in tests. + (let ((org-def def) + (org-defdecode defdecode) + (nowdecode (decode-time (current-time))) delta deltan deltaw deltadef year month day hour minute second wday pm h2 m2 tl wday1 - iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) + iso-year iso-weekday iso-week iso-date futurep kill-year) (setq org-read-date-analyze-futurep nil org-read-date-analyze-forced-year nil) (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) @@ -16521,11 +17128,11 @@ user." ;; info and postpone interpreting it until the rest of the parsing ;; is done. (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) - (setq iso-year (if (match-end 1) - (org-small-year-to-year - (string-to-number (match-string 1 ans)))) - iso-weekday (if (match-end 3) - (string-to-number (match-string 3 ans))) + (setq iso-year (when (match-end 1) + (org-small-year-to-year + (string-to-number (match-string 1 ans)))) + iso-weekday (when (match-end 3) + (string-to-number (match-string 3 ans))) iso-week (string-to-number (match-string 2 ans))) (setq ans (replace-match "" t t ans))) @@ -16538,7 +17145,7 @@ user." (string-to-number (format-time-string "%Y")))) month (string-to-number (match-string 3 ans)) day (string-to-number (match-string 4 ans))) - (if (< year 100) (setq year (+ 2000 year))) + (setq year (org-small-year-to-year year)) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) @@ -16562,26 +17169,26 @@ user." (string-to-number (format-time-string "%Y")))) month (string-to-number (match-string 1 ans)) day (string-to-number (match-string 2 ans))) - (if (< year 100) (setq year (+ 2000 year))) + (setq year (org-small-year-to-year year)) (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) t nil ans))) ;; Help matching am/pm times, because `parse-time-string' does not do that. ;; If there is a time with am/pm, and *no* time without it, we convert ;; so that matching will be successful. - (loop for i from 1 to 2 do ; twice, for end time as well - (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) - (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) - (setq hour (string-to-number (match-string 1 ans)) - minute (if (match-end 3) - (string-to-number (match-string 3 ans)) - 0) - pm (equal ?p - (string-to-char (downcase (match-string 4 ans))))) - (if (and (= hour 12) (not pm)) - (setq hour 0) - (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) - (setq ans (replace-match (format "%02d:%02d" hour minute) - t t ans)))) + (cl-loop for i from 1 to 2 do ; twice, for end time as well + (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) + (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) + (setq hour (string-to-number (match-string 1 ans)) + minute (if (match-end 3) + (string-to-number (match-string 3 ans)) + 0) + pm (equal ?p + (string-to-char (downcase (match-string 4 ans))))) + (if (and (= hour 12) (not pm)) + (setq hour 0) + (when (and pm (< hour 12)) (setq hour (+ 12 hour)))) + (setq ans (replace-match (format "%02d:%02d" hour minute) + t t ans)))) ;; Check if a time range is given as a duration (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) @@ -16590,7 +17197,7 @@ user." minute (string-to-number (match-string 2 ans)) m2 (+ minute (if (match-end 5) (string-to-number (match-string 5 ans))0))) - (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) + (when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) t t ans))) @@ -16605,16 +17212,35 @@ user." (setq tl (parse-time-string ans) day (or (nth 3 tl) (nth 3 org-defdecode)) - month (or (nth 4 tl) - (if (and org-read-date-prefer-future - (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode))) - (prog1 (1+ (nth 4 nowdecode)) (setq futurep t)) - (nth 4 org-defdecode))) - year (or (and (not kill-year) (nth 5 tl)) - (if (and org-read-date-prefer-future - (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode))) - (prog1 (1+ (nth 5 nowdecode)) (setq futurep t)) - (nth 5 org-defdecode))) + month + (cond ((nth 4 tl)) + ((not org-read-date-prefer-future) (nth 4 org-defdecode)) + ;; Day was specified. Make sure DAY+MONTH + ;; combination happens in the future. + ((nth 3 tl) + (setq futurep t) + (if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode)) + (nth 4 nowdecode))) + (t (nth 4 org-defdecode))) + year + (cond ((and (not kill-year) (nth 5 tl))) + ((not org-read-date-prefer-future) (nth 5 org-defdecode)) + ;; Month was guessed in the future and is at least + ;; equal to NOWDECODE's. Fix year accordingly. + (futurep + (if (or (> month (nth 4 nowdecode)) + (>= day (nth 3 nowdecode))) + (nth 5 nowdecode) + (1+ (nth 5 nowdecode)))) + ;; Month was specified. Make sure MONTH+YEAR + ;; combination happens in the future. + ((nth 4 tl) + (setq futurep t) + (cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode)) + ((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode))) + ((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode))) + (t (nth 5 nowdecode)))) + (t (nth 5 org-defdecode))) hour (or (nth 2 tl) (nth 2 org-defdecode)) minute (or (nth 1 tl) (nth 1 org-defdecode)) second (or (nth 0 tl) 0) @@ -16643,7 +17269,7 @@ user." day (or iso-weekday wday 1) wday nil ; to make sure that the trigger below does not match iso-date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso + (calendar-iso-to-absolute (list iso-week day year)))) ; FIXME: Should we also push ISO weeks into the future? ; (when (and org-read-date-prefer-future @@ -16652,7 +17278,7 @@ user." ; (time-to-days (current-time)))) ; (setq year (1+ year) ; iso-date (calendar-gregorian-from-absolute - ; (calendar-absolute-from-iso + ; (calendar-iso-to-absolute ; (list iso-week day year))))) (setq month (car iso-date) year (nth 2 iso-date) @@ -16660,7 +17286,10 @@ user." (deltan (setq futurep nil) (unless deltadef - (let ((now (decode-time))) + ;; Pass `current-time' result to `decode-time' (instead of + ;; calling without arguments) so that only `current-time' has + ;; to be overriden in tests. + (let ((now (decode-time (current-time)))) (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) @@ -16672,17 +17301,17 @@ user." (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) (unless (equal wday wday1) (setq day (+ day (% (- wday wday1 -7) 7)))))) - (if (and (boundp 'org-time-was-given) - (nth 2 tl)) - (setq org-time-was-given t)) - (if (< year 100) (setq year (+ 2000 year))) + (when (and (boundp 'org-time-was-given) + (nth 2 tl)) + (setq org-time-was-given t)) + (when (< year 100) (setq year (+ 2000 year))) ;; Check of the date is representable (if org-read-date-force-compatible-dates (progn - (if (< year 1970) - (setq year 1970 org-read-date-analyze-forced-year t)) - (if (> year 2037) - (setq year 2037 org-read-date-analyze-forced-year t))) + (when (< year 1970) + (setq year 1970 org-read-date-analyze-forced-year t)) + (when (> year 2037) + (setq year 2037 org-read-date-analyze-forced-year t))) (condition-case nil (ignore (encode-time second minute hour day month year)) (error @@ -16722,12 +17351,11 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to (if wday1 (progn (setq delta (mod (+ 7 (- wday1 wday)) 7)) - (if (= delta 0) (setq delta 7)) - (if (= dir ?-) - (progn - (setq delta (- delta 7)) - (if (= delta 0) (setq delta -7)))) - (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) + (when (= delta 0) (setq delta 7)) + (when (= dir ?-) + (setq delta (- delta 7)) + (when (= delta 0) (setq delta -7))) + (when (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) (list delta "d" rel)) (list (* n (if (= dir ?-) -1 1)) what rel))))) @@ -16736,23 +17364,14 @@ DEF-FLAG is t when a double ++ or -- indicates shift relative to The internal representation needed by the calendar is (month day year). This is a wrapper to handle the brain-dead convention in calendar that user function argument order change dependent on argument order." - (if (boundp 'calendar-date-style) - (cond - ((eq calendar-date-style 'american) - (list arg1 arg2 arg3)) - ((eq calendar-date-style 'european) - (list arg2 arg1 arg3)) - ((eq calendar-date-style 'iso) - (list arg2 arg3 arg1))) - (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3))))) + (pcase calendar-date-style + (`american (list arg1 arg2 arg3)) + (`european (list arg2 arg1 arg3)) + (`iso (list arg2 arg3 arg1)))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. -When KEEPDATE is non-nil, update `org-ans2' from the cursor date, -otherwise stick to the current value of `org-ans2'." +Unless KEEPDATE is non-nil, update `org-ans2' to the cursor date." (let ((sf (selected-frame)) (sw (selected-window))) (select-window (get-buffer-window "*Calendar*" t)) @@ -16763,7 +17382,7 @@ otherwise stick to the current value of `org-ans2'." (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) (select-window sw) - (org-select-frame-set-input-focus sf))) + (select-frame-set-input-focus sf))) (defun org-calendar-select () "Return to `org-read-date' with the date currently selected. @@ -16773,10 +17392,11 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) + (when (active-minibuffer-window) (exit-minibuffer)))) (defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) "Insert a date stamp for the date given by the internal TIME. +See `format-time-string' for the format of TIME. WITH-HM means use the stamp format that includes the time of the day. INACTIVE means use square brackets instead of angular ones, so that the stamp will not contribute to the agenda. @@ -16785,7 +17405,7 @@ stamp. The command returns the inserted time stamp." (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) stamp) - (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (when inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) (insert-before-markers (or pre "")) (when (listp extra) (setq extra (car extra)) @@ -16808,14 +17428,12 @@ The command returns the inserted time stamp." (unless org-display-custom-times (let ((p (point-min)) (bmp (buffer-modified-p))) (while (setq p (next-single-property-change p 'display)) - (if (and (get-text-property p 'display) - (eq (get-text-property p 'face) 'org-date)) - (remove-text-properties - p (setq p (next-single-property-change p 'display)) - '(display t)))) + (when (and (get-text-property p 'display) + (eq (get-text-property p 'face) 'org-date)) + (remove-text-properties + p (setq p (next-single-property-change p 'display)) + '(display t)))) (set-buffer-modified-p bmp))) - (if (featurep 'xemacs) - (remove-text-properties (point-min) (point-max) '(end-glyph t))) (org-restart-font-lock) (setq org-table-may-need-update t) (if org-display-custom-times @@ -16828,8 +17446,8 @@ The command returns the inserted time stamp." t1 w1 with-hm tf time str w2 (off 0)) (save-match-data (setq t1 (org-parse-time-string ts t)) - (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) - (setq off (- (match-end 0) (match-beginning 0))))) + (when (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) + (setq off (- (match-end 0) (match-beginning 0))))) (setq end (- end off)) (setq w1 (- end beg) with-hm (and (nth 1 t1) (nth 2 t1)) @@ -16840,41 +17458,10 @@ The command returns the inserted time stamp." (substring tf 1 -1) (apply 'encode-time time)) nil 'mouse-face 'highlight) w2 (length str)) - (if (not (= w2 w1)) - (add-text-properties (1+ beg) (+ 2 beg) - (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) - (if (featurep 'xemacs) - (progn - (put-text-property beg end 'invisible t) - (put-text-property beg end 'end-glyph (make-glyph str))) - (put-text-property beg end 'display str)))) - -(defun org-translate-time (string) - "Translate all timestamps in STRING to custom format. -But do this only if the variable `org-display-custom-times' is set." - (when org-display-custom-times - (save-match-data - (let* ((start 0) - (re org-ts-regexp-both) - t1 with-hm inactive tf time str beg end) - (while (setq start (string-match re string start)) - (setq beg (match-beginning 0) - end (match-end 0) - t1 (save-match-data - (org-parse-time-string (substring string beg end) t)) - with-hm (and (nth 1 t1) (nth 2 t1)) - inactive (equal (substring string beg (1+ beg)) "[") - tf (funcall (if with-hm 'cdr 'car) - org-time-stamp-custom-formats) - time (org-fix-decoded-time t1) - str (format-time-string - (concat - (if inactive "[" "<") (substring tf 1 -1) - (if inactive "]" ">")) - (apply 'encode-time time)) - string (replace-match str t t string) - start (+ start (length str))))))) - string) + (unless (= w2 w1) + (add-text-properties (1+ beg) (+ 2 beg) + (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) + (put-text-property beg end 'display str))) (defun org-fix-decoded-time (time) "Set 0 instead of nil for the first 6 elements of time. @@ -16882,19 +17469,17 @@ Don't touch the rest." (let ((n 0)) (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) -(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") - (defun org-time-stamp-to-now (timestamp-string &optional seconds) "Difference between TIMESTAMP-STRING and now in days. If SECONDS is non-nil, return the difference in seconds." - (let ((fdiff (if seconds 'float-time 'time-to-days))) + (let ((fdiff (if seconds #'float-time #'time-to-days))) (- (funcall fdiff (org-time-string-to-time timestamp-string)) (funcall fdiff (current-time))))) -(defun org-deadline-close (timestamp-string &optional ndays) +(defun org-deadline-close-p (timestamp-string &optional ndays) "Is the time in TIMESTAMP-STRING close to the current date?" (setq ndays (or ndays (org-get-wdays timestamp-string))) - (and (< (org-time-stamp-to-now timestamp-string) ndays) + (and (<= (org-time-stamp-to-now timestamp-string) ndays) (not (org-entry-is-done-p)))) (defun org-get-wdays (ts &optional delay zero-delay) @@ -16930,14 +17515,15 @@ This is used by `org-read-date' in a temporary keymap for the calendar buffer." (let* ((date (calendar-cursor-to-date)) (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) + (when (active-minibuffer-window) (exit-minibuffer)))) (defun org-check-deadlines (ndays) "Check if there are any deadlines due or past due. A deadline is considered due if it happens within `org-deadline-warning-days' days from today's date. If the deadline appears in an entry marked DONE, -it is not shown. The prefix arg NDAYS can be used to test that many -days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." +it is not shown. A numeric prefix argument NDAYS can be used to test that +many days. If the prefix is a raw `\\[universal-argument]', all deadlines \ +are shown." (interactive "P") (let* ((org-warn-days (cond @@ -16947,8 +17533,7 @@ days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are s (case-fold-search nil) (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) (callback - (lambda () (org-deadline-close (match-string 1) org-warn-days)))) - + (lambda () (org-deadline-close-p (match-string 1) org-warn-days)))) (message "%d deadlines past-due or due within %d days" (org-occur regexp nil callback) org-warn-days))) @@ -16966,39 +17551,61 @@ Allowed values for TYPE are: When TYPE is nil, fall back on returning a regexp that matches both scheduled and deadline timestamps." - (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9>\r\n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)") - ((eq type 'active) org-ts-regexp) - ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]") - ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) - ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) - ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)\\]")) - ((eq type 'scheduled-or-deadline) - (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) - -(defun org-check-before-date (date) - "Check if there are deadlines or scheduled entries before DATE." + (cl-case type + (all org-ts-regexp-both) + (active org-ts-regexp) + (inactive org-ts-regexp-inactive) + (scheduled org-scheduled-time-regexp) + (deadline org-deadline-time-regexp) + (closed org-closed-time-regexp) + (otherwise + (concat "\\<" + (regexp-opt (list org-deadline-string org-scheduled-string)) + " *<\\([^>]+\\)>")))) + +(defun org-check-before-date (d) + "Check if there are deadlines or scheduled entries before date D." (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - (lambda () (time-less-p - (org-time-string-to-time (match-string 1)) - (org-time-string-to-time date))))) + (let* ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (ts-type org-ts-type) + (callback + (lambda () + (let ((match (match-string 1))) + (and (if (memq ts-type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) + (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time d))))))) (message "%d entries before %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) -(defun org-check-after-date (date) - "Check if there are deadlines or scheduled entries after DATE." +(defun org-check-after-date (d) + "Check if there are deadlines or scheduled entries after date D." (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - (lambda () (not - (time-less-p - (org-time-string-to-time (match-string 1)) - (org-time-string-to-time date)))))) + (let* ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (ts-type org-ts-type) + (callback + (lambda () + (let ((match (match-string 1))) + (and (if (memq ts-type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) + (not (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time d)))))))) (message "%d entries after %s" - (org-occur regexp nil callback) date))) + (org-occur regexp nil callback) + d))) (defun org-check-dates-range (start-date end-date) "Check for deadlines/scheduled entries between START-DATE and END-DATE." @@ -17007,15 +17614,22 @@ both scheduled and deadline timestamps." (let ((case-fold-search nil) (regexp (org-re-timestamp org-ts-type)) (callback - (lambda () - (let ((match (match-string 1))) - (and - (not (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time start-date))) - (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time end-date))))))) + (let ((type org-ts-type)) + (lambda () + (let ((match (match-string 1))) + (and + (if (memq type '(active inactive all)) + (eq (org-element-type (save-excursion + (backward-char) + (org-element-context))) + 'timestamp) + (org-at-planning-p)) + (not (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time start-date))) + (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time end-date)))))))) (message "%d entries between %s and %s" (org-occur regexp nil callback) start-date end-date))) @@ -17034,8 +17648,8 @@ days in order to avoid rounding problems." (unless (org-at-date-range-p t) (goto-char (point-at-bol)) (re-search-forward org-tr-regexp-both (point-at-eol) t)) - (if (not (org-at-date-range-p t)) - (user-error "Not at a time-stamp range, and none found in current line"))) + (unless (org-at-date-range-p t) + (user-error "Not at a time-stamp range, and none found in current line"))) (let* ((ts1 (match-string 1)) (ts2 (match-string 2)) (havetime (or (> (length ts1) 15) (> (length ts2) 15))) @@ -17073,27 +17687,31 @@ days in order to avoid rounding problems." (setq align t) (and (looking-at " *|") (goto-char (match-end 0)))) (goto-char match-end)) - (if (looking-at - "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") - (replace-match "")) - (if negative (insert " -")) + (when (looking-at + "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") + (replace-match "")) + (when negative (insert " -")) (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) (insert " " (format fh h m)))) - (if align (org-table-align)) + (when align (org-table-align)) (message "Time difference inserted"))))) (defun org-make-tdiff-string (y d h m) (let ((fmt "") (l nil)) - (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") - l (push y l))) - (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") - l (push d l))) - (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") - l (push h l))) - (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") - l (push m l))) + (when (> y 0) + (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ")) + (push y l)) + (when (> d 0) + (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ")) + (push d l)) + (when (> h 0) + (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ")) + (push h l)) + (when (> m 0) + (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ")) + (push m l)) (apply 'format fmt (nreverse l)))) (defun org-time-string-to-time (s &optional buffer pos) @@ -17110,28 +17728,40 @@ days in order to avoid rounding problems." "Convert a timestamp string to a number of seconds." (float-time (org-time-string-to-time s))) -(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) - "Convert a time stamp to an absolute day number. -If there is a specifier for a cyclic time stamp, get the closest -date to DAYNR. -PREFER and SHOW-ALL are passed through to `org-closest-date'. -The variable `date' is bound by the calendar when this is called." +(org-define-error 'org-diary-sexp-no-match "Unable to match diary sexp") + +(defun org-time-string-to-absolute (s &optional daynr prefer buffer pos) + "Convert time stamp S to an absolute day number. + +If DAYNR in non-nil, and there is a specifier for a cyclic time +stamp, get the closest date to DAYNR. If PREFER is +`past' (respectively `future') return a date past (respectively +after) or equal to DAYNR. + +POS is the location of time stamp S, as a buffer position in +BUFFER. + +Diary sexp timestamps are matched against DAYNR, when non-nil. +If matching fails or DAYNR is nil, `org-diary-sexp-no-match' is +signalled." (cond - ((and daynr (string-match "\\`%%\\((.*)\\)" s)) - (if (org-diary-sexp-entry (match-string 1 s) "" date) + ((string-match "\\`%%\\((.*)\\)" s) + ;; Sexp timestamp: try to match DAYNR, if available, since we're + ;; only able to match individual dates. If it fails, raise an + ;; error. + (if (and daynr + (org-diary-sexp-entry + (match-string 1 s) "" (calendar-gregorian-from-absolute daynr))) daynr - (+ daynr 1000))) - ((and daynr (string-match "\\+[0-9]+[hdwmy]" s)) - (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr - (time-to-days (current-time))) (match-string 0 s) - prefer show-all)) + (signal 'org-diary-sexp-no-match (list s)))) + (daynr (org-closest-date s daynr prefer)) (t (time-to-days (condition-case errdata - (apply 'encode-time (org-parse-time-string s)) + (apply #'encode-time (org-parse-time-string s)) (error (error "Bad timestamp `%s'%s\nError was: %s" - s (if (not (and buffer pos)) - "" - (format-message " at %d in buffer `%s'" pos buffer)) + s + (if (not (and buffer pos)) "" + (format-message " at %d in buffer `%s'" pos buffer)) (cdr errdata)))))))) (defun org-days-to-iso-week (days) @@ -17141,43 +17771,46 @@ The variable `date' is bound by the calendar when this is called." (defun org-small-year-to-year (year) "Convert 2-digit years into 4-digit years. -38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037. -The year 2000 cannot be abbreviated. Any year larger than 99 -is returned unchanged." - (if (< year 38) - (setq year (+ 2000 year)) - (if (< year 100) - (setq year (+ 1900 year)))) - year) +YEAR is expanded into one of the 30 next years, if possible, or +into a past one. Any year larger than 99 is returned unchanged." + (if (>= year 100) year + (let* ((current (string-to-number (format-time-string "%Y" (current-time)))) + (century (/ current 100)) + (offset (- year (% current 100)))) + (cond ((> offset 30) (+ (* (1- century) 100) year)) + ((> offset -70) (+ (* century 100) year)) + (t (+ (* (1+ century) 100) year)))))) (defun org-time-from-absolute (d) "Return the time corresponding to date D. D may be an absolute day number, or a calendar-type list (month day year)." - (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) + (when (numberp d) (setq d (calendar-gregorian-from-absolute d))) (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) +(defvar org-agenda-current-date) (defun org-calendar-holiday () - "List of holidays, for Diary display in Org-mode." + "List of holidays, for Diary display in Org mode." (require 'holidays) - (let ((hl (funcall - (if (fboundp 'calendar-check-holidays) - 'calendar-check-holidays 'check-calendar-holidays) date))) - (if hl (mapconcat 'identity hl "; ")))) + (let ((hl (calendar-check-holidays org-agenda-current-date))) + (and hl (mapconcat #'identity hl "; ")))) -(defun org-diary-sexp-entry (sexp entry date) - "Process a SEXP diary ENTRY for DATE." +(defun org-diary-sexp-entry (sexp entry d) + "Process a SEXP diary ENTRY for date D." (require 'diary-lib) - (let ((result (if calendar-debug-sexp - (let ((stack-trace-on-error t)) - (eval (car (read-from-string sexp)))) - (condition-case nil - (eval (car (read-from-string sexp))) - (error - (beep) - (message "Bad sexp at line %d in %s: %s" - (org-current-line) - (buffer-file-name) sexp) - (sleep-for 2)))))) + ;; `org-anniversary' and alike expect ENTRY and DATE to be bound + ;; dynamically. + (let* ((sexp `(let ((entry ,entry) + (date ',d)) + ,(car (read-from-string sexp)))) + (result (if calendar-debug-sexp (eval sexp) + (condition-case nil + (eval sexp) + (error + (beep) + (message "Bad sexp at line %d in %s: %s" + (org-current-line) + (buffer-file-name) sexp) + (sleep-for 2)))))) (cond ((stringp result) (split-string result "; ")) ((and (consp result) (not (consp (cdr result))) @@ -17189,9 +17822,7 @@ D may be an absolute day number, or a calendar-type list (month day year)." (defun org-diary-to-ical-string (frombuf) "Get iCalendar entries from diary entries in buffer FROMBUF. This uses the icalendar.el library." - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) + (let* ((tmpdir temporary-file-directory) (tmpfile (make-temp-name (expand-file-name "orgics" tmpdir))) buf rtn b e) @@ -17200,125 +17831,146 @@ This uses the icalendar.el library." (setq buf (find-buffer-visiting tmpfile)) (set-buffer buf) (goto-char (point-min)) - (if (re-search-forward "^BEGIN:VEVENT" nil t) - (setq b (match-beginning 0))) + (when (re-search-forward "^BEGIN:VEVENT" nil t) + (setq b (match-beginning 0))) (goto-char (point-max)) - (if (re-search-backward "^END:VEVENT" nil t) - (setq e (match-end 0))) + (when (re-search-backward "^END:VEVENT" nil t) + (setq e (match-end 0))) (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) (kill-buffer buf) (delete-file tmpfile) rtn)) -(defun org-closest-date (start current change prefer show-all) - "Find the date closest to CURRENT that is consistent with START and CHANGE. -When PREFER is `past', return a date that is either CURRENT or past. -When PREFER is `future', return a date that is either CURRENT or future. -When SHOW-ALL is nil, only return the current occurrence of a time stamp." - ;; Make the proper lists from the dates - (catch 'exit - (let ((a1 '(("h" . hour) - ("d" . day) - ("w" . week) - ("m" . month) - ("y" . year))) - (shour (nth 2 (org-parse-time-string start))) - dn dw sday cday n1 n2 n0 - d m y y1 y2 date1 date2 nmonths nm ny m2) - - (setq start (org-date-to-gregorian start) - current (org-date-to-gregorian - (if show-all - current - (time-to-days (current-time)))) - sday (calendar-absolute-from-gregorian start) - cday (calendar-absolute-from-gregorian current)) - - (if (<= cday sday) (throw 'exit sday)) - - (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) - (setq dn (string-to-number (match-string 1 change)) - dw (cdr (assoc (match-string 2 change) a1))) - (user-error "Invalid change specifier: %s" change)) - (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) - (cond - ((eq dw 'hour) - (let ((missing-hours - (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until) - dn))) - (setq n1 (if (zerop missing-hours) cday - (- cday (1+ (floor (/ missing-hours 24))))) - n2 (+ cday (floor (/ (- dn missing-hours) 24)))))) - ((eq dw 'day) - (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) - n2 (+ n1 dn))) - ((eq dw 'year) - (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) - (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) - (setq date1 (list m d y1) - n1 (calendar-absolute-from-gregorian date1) - date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) - n2 (calendar-absolute-from-gregorian date2))) - ((eq dw 'month) - ;; approx number of month between the two dates - (setq nmonths (floor (/ (- cday sday) 30.436875))) - ;; How often does dn fit in there? - (setq d (nth 1 start) m (car start) y (nth 2 start) - nm (* dn (max 0 (1- (floor (/ nmonths dn))))) - m (+ m nm) - ny (floor (/ m 12)) - y (+ y ny) - m (- m (* ny 12))) - (while (> m 12) (setq m (- m 12) y (1+ y))) - (setq n1 (calendar-absolute-from-gregorian (list m d y))) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) - (while (<= n2 cday) - (setq n1 n2 m m2 y y2) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) - ;; Make sure n1 is the earlier date - (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2)) - (if show-all - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (= cday n1) n1 n2))))))) - -(defun org-date-to-gregorian (date) - "Turn any specification of DATE into a Gregorian date for the calendar." - (cond ((integerp date) (calendar-gregorian-from-absolute date)) - ((and (listp date) (= (length date) 3)) date) - ((stringp date) - (setq date (org-parse-time-string date)) - (list (nth 4 date) (nth 3 date) (nth 5 date))) - ((listp date) - (list (nth 4 date) (nth 3 date) (nth 5 date))))) - -(defun org-parse-time-string (s &optional nodefault) - "Parse the standard Org-mode time string. +(defun org-closest-date (start current prefer) + "Return closest date to CURRENT starting from START. + +CURRENT and START are both time stamps. + +When PREFER is `past', return a date that is either CURRENT or +past. When PREFER is `future', return a date that is either +CURRENT or future. + +Only time stamps with a repeater are modified. Any other time +stamp stay unchanged. In any case, return value is an absolute +day number." + (if (not (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)" start)) + ;; No repeater. Do not shift time stamp. + (time-to-days (apply #'encode-time (org-parse-time-string start))) + (let ((value (string-to-number (match-string 1 start))) + (type (match-string 2 start))) + (if (= 0 value) + ;; Repeater with a 0-value is considered as void. + (time-to-days (apply #'encode-time (org-parse-time-string start))) + (let* ((base (org-date-to-gregorian start)) + (target (org-date-to-gregorian current)) + (sday (calendar-absolute-from-gregorian base)) + (cday (calendar-absolute-from-gregorian target)) + n1 n2) + ;; If START is already past CURRENT, just return START. + (if (<= cday sday) sday + ;; Compute closest date before (N1) and closest date past + ;; (N2) CURRENT. + (pcase type + ("h" + (let ((missing-hours + (mod (+ (- (* 24 (- cday sday)) + (nth 2 (org-parse-time-string start))) + org-extend-today-until) + value))) + (setf n1 (if (= missing-hours 0) cday + (- cday (1+ (/ missing-hours 24))))) + (setf n2 (+ cday (/ (- value missing-hours) 24))))) + ((or "d" "w") + (let ((value (if (equal type "w") (* 7 value) value))) + (setf n1 (+ sday (* value (/ (- cday sday) value)))) + (setf n2 (+ n1 value)))) + ("m" + (let* ((add-months + (lambda (d n) + ;; Add N months to gregorian date D, i.e., + ;; a list (MONTH DAY YEAR). Return a valid + ;; gregorian date. + (let ((m (+ (nth 0 d) n))) + (list (mod m 12) + (nth 1 d) + (+ (/ m 12) (nth 2 d)))))) + (months ; Complete months to TARGET. + (* (/ (+ (* 12 (- (nth 2 target) (nth 2 base))) + (- (nth 0 target) (nth 0 base)) + ;; If START's day is greater than + ;; TARGET's, remove incomplete month. + (if (> (nth 1 target) (nth 1 base)) 0 -1)) + value) + value)) + (before (funcall add-months base months))) + (setf n1 (calendar-absolute-from-gregorian before)) + (setf n2 + (calendar-absolute-from-gregorian + (funcall add-months before value))))) + (_ + (let* ((d (nth 1 base)) + (m (nth 0 base)) + (y (nth 2 base)) + (years ; Complete years to TARGET. + (* (/ (- (nth 2 target) + y + ;; If START's month and day are + ;; greater than TARGET's, remove + ;; incomplete year. + (if (or (> (nth 0 target) m) + (and (= (nth 0 target) m) + (> (nth 1 target) d))) + 0 + 1)) + value) + value)) + (before (list m d (+ y years)))) + (setf n1 (calendar-absolute-from-gregorian before)) + (setf n2 (calendar-absolute-from-gregorian + (list m d (+ (nth 2 before) value))))))) + ;; Handle PREFER parameter, if any. + (cond + ((eq prefer 'past) (if (= cday n2) n2 n1)) + ((eq prefer 'future) (if (= cday n1) n1 n2)) + (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))))))))) + +(defun org-date-to-gregorian (d) + "Turn any specification of date D into a Gregorian date for the calendar." + (cond ((integerp d) (calendar-gregorian-from-absolute d)) + ((and (listp d) (= (length d) 3)) d) + ((stringp d) + (let ((d (org-parse-time-string d))) + (list (nth 4 d) (nth 3 d) (nth 5 d)))) + ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) + +(defun org-parse-time-string (s &optional nodefault zone) + "Parse the standard Org time string. + This should be a lot faster than the normal `parse-time-string'. -If time is not given, defaults to 0:00. However, with optional NODEFAULT, -hour and minute fields will be nil if not given." + +If time is not given, defaults to 0:00. However, with optional +NODEFAULT, hour and minute fields will be nil if not given. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, ‘wall’ for system wall clock time, or a string as +in the TZ environment variable." (cond ((string-match org-ts-regexp0 s) (list 0 - (if (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (if (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) + (when (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (when (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) (string-to-number (match-string 4 s)) (string-to-number (match-string 3 s)) (string-to-number (match-string 2 s)) - nil nil nil)) + nil nil zone)) ((string-match "^<[^>]+>$" s) + ;; FIXME: `decode-time' needs to be called with ZONE as its + ;; second argument. However, this requires at least Emacs + ;; 25.1. We can do it when we switch to this version as our + ;; minimal requirement. (decode-time (seconds-to-time (org-matcher-time s)))) - (t (error "Not a standard Org-mode time string: %s" s)))) + (t (error "Not a standard Org time string: %s" s)))) (defun org-timestamp-up (&optional arg) "Increase the date item at the cursor by one. @@ -17355,14 +18007,21 @@ With prefix ARG, change that many days." (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) (defun org-at-timestamp-p (&optional inactive-ok) - "Determine if the cursor is in or at a timestamp." + "Non-nil if point is inside a timestamp. + +When optional argument INACTIVE-OK is non-nil, also consider +inactive timestamps. + +When this function returns a non-nil value, match data is set +according to `org-ts-regexp3' or `org-ts-regexp2', depending on +INACTIVE-OK." (interactive) (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) (pos (point)) (ans (or (looking-at tsr) (save-excursion (skip-chars-backward "^[<\n\r\t") - (if (> (point) (point-min)) (backward-char 1)) + (when (> (point) (point-min)) (backward-char 1)) (and (looking-at tsr) (> (- (match-end 0) pos) -1)))))) (and ans @@ -17403,8 +18062,8 @@ With prefix ARG, change that many days." (defun org-at-clock-log-p nil "Is the cursor on the clock log line?" (save-excursion - (move-beginning-of-line 1) - (looking-at "^[ \t]*CLOCK:"))) + (beginning-of-line) + (looking-at org-clock-line-re))) (defvar org-clock-history) ; defined in org-clock.el (defvar org-clock-adjust-closest nil) ; defined in org-clock.el @@ -17420,19 +18079,19 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." org-ts-what extra rem ts time time0 fixnext clrgx) - (if (not (org-at-timestamp-p t)) - (user-error "Not at a timestamp")) + (unless (org-at-timestamp-p t) + (user-error "Not at a timestamp")) (if (and (not what) (eq org-ts-what 'bracket)) (org-toggle-timestamp-type) ;; Point isn't on brackets. Remember the part of the time-stamp ;; the point was in. Indeed, size of time-stamps may change, ;; but point must be kept in the same category nonetheless. (setq origin-cat org-ts-what) - (if (and (not what) (not (eq org-ts-what 'day)) - org-display-custom-times - (get-text-property (point) 'display) - (not (get-text-property (1- (point)) 'display))) - (setq org-ts-what 'day)) + (when (and (not what) (not (eq org-ts-what 'day)) + org-display-custom-times + (get-text-property (point) 'display) + (not (get-text-property (1- (point)) 'display))) + (setq org-ts-what 'day)) (setq org-ts-what (or what org-ts-what) inactive (= (char-after (match-beginning 0)) ?\[) ts (match-string 0)) @@ -17441,26 +18100,28 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" ts) (setq extra (match-string 1 ts)) - (if suppress-tmp-delay - (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) - (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) - (setq with-hm t)) + (when suppress-tmp-delay + (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) + (when (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) + (setq with-hm t)) (setq time0 (org-parse-time-string ts)) (when (and updown (eq org-ts-what 'minute) (not current-prefix-arg)) ;; This looks like s-up and s-down. Change by one rounding step. (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) - (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) + (unless (= 0 (setq rem (% (nth 1 time0) dm))) (setcar (cdr time0) (+ (nth 1 time0) (if (> n 0) (- rem) (- dm rem)))))) (setq time - (encode-time (or (car time0) 0) - (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) - (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) - (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) - (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) - (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)))) + (apply #'encode-time + (or (car time0) 0) + (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) + (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) + (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) + (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) + (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) + (nthcdr 6 time0))) (when (and (member org-ts-what '(hour minute)) extra (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) @@ -17470,15 +18131,15 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." n dm))) (when (integerp org-ts-what) (setq extra (org-modify-ts-extra extra org-ts-what n dm))) - (if (eq what 'calendar) - (let ((cal-date (org-get-date-from-calendar))) - (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month - (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day - (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year - (setcar time0 (or (car time0) 0)) - (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) - (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) - (setq time (apply 'encode-time time0)))) + (when (eq what 'calendar) + (let ((cal-date (org-get-date-from-calendar))) + (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month + (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day + (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year + (setcar time0 (or (car time0) 0)) + (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) + (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) + (setq time (apply 'encode-time time0)))) ;; Insert the new time-stamp, and ensure point stays in the same ;; category as before (i.e. not after the last position in that ;; category). @@ -17489,17 +18150,21 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (goto-char pos)) (save-match-data (looking-at org-ts-regexp3) - (goto-char (cond - ;; `day' category ends before `hour' if any, or at - ;; the end of the day name. - ((eq origin-cat 'day) - (min (or (match-beginning 7) (1- (match-end 5))) origin)) - ((eq origin-cat 'hour) (min (match-end 7) origin)) - ((eq origin-cat 'minute) (min (1- (match-end 8)) origin)) - ((integerp origin-cat) (min (1- (match-end 0)) origin)) - ;; `year' and `month' have both fixed size: point - ;; couldn't have moved into another part. - (t origin)))) + (goto-char + (pcase origin-cat + ;; `day' category ends before `hour' if any, or at the end + ;; of the day name. + (`day (min (or (match-beginning 7) (1- (match-end 5))) origin)) + (`hour (min (match-end 7) origin)) + (`minute (min (1- (match-end 8)) origin)) + ((pred integerp) (min (1- (match-end 0)) origin)) + ;; Point was right after the time-stamp. However, the + ;; time-stamp length might have changed, so refer to + ;; (match-end 0) instead. + (`after (match-end 0)) + ;; `year' and `month' have both fixed size: point couldn't + ;; have moved into another part. + (_ origin)))) ;; Update clock if on a CLOCK line. (org-clock-update-time-maybe) ;; Maybe adjust the closest clock in `org-clock-history' @@ -17508,11 +18173,12 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (< 1 (length (delq nil (mapcar 'marker-position org-clock-history)))))) (message "No clock to adjust") - (cond ((save-excursion ; fix previous clock? + (cond ((save-excursion ; fix previous clock? (re-search-backward org-ts-regexp0 nil t) - (org-looking-back (concat org-clock-string " \\["))) + (looking-back (concat org-clock-string " \\[") + (line-beginning-position))) (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) - ((save-excursion ; fix next clock? + ((save-excursion ; fix next clock? (re-search-backward org-ts-regexp0 nil t) (looking-at (concat org-ts-regexp0 "\\] =>"))) (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) @@ -17521,8 +18187,8 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (let* ((p (save-excursion (org-back-to-heading t))) (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) (clfixnth - (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100)))) - (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) + (+ fixnext (- (length cl) (or (length (member (apply 'min cl) cl)) 100)))) + (clfixpos (unless (> 0 clfixnth) (nth clfixnth org-clock-history)))) (if (not clfixpos) (message "No clock to adjust") (save-excursion @@ -17536,10 +18202,10 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (file-name-nondirectory (buffer-file-name)) (org-get-heading t t))))))))) ;; Try to recenter the calendar window, if any. - (if (and org-calendar-follow-timestamp-change - (get-buffer-window "*Calendar*" t) - (memq org-ts-what '(day month year))) - (org-recenter-calendar (time-to-days time)))))) + (when (and org-calendar-follow-timestamp-change + (get-buffer-window "*Calendar*" t) + (memq org-ts-what '(day month year))) + (org-recenter-calendar (time-to-days time)))))) (defun org-modify-ts-extra (s pos n dm) "Change the different parts of the lead-time and repeat fields in timestamp." @@ -17553,13 +18219,13 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." h (string-to-number (match-string 2 s))) (if (org-pos-in-match-range pos 2) (setq h (+ h n)) - (setq n (* dm (org-no-warnings (signum n)))) - (when (not (= 0 (setq rem (% m dm)))) + (setq n (* dm (with-no-warnings (signum n)))) + (unless (= 0 (setq rem (% m dm))) (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) (setq m (+ m n))) - (if (< m 0) (setq m (+ m 60) h (1- h))) - (if (> m 59) (setq m (- m 60) h (1+ h))) - (setq h (min 24 (max 0 h))) + (when (< m 0) (setq m (+ m 60) h (1- h))) + (when (> m 59) (setq m (- m 60) h (1+ h))) + (setq h (mod h 24)) (setq ng 1 new (format "-%02d:%02d" h m))) ((org-pos-in-match-range pos 6) (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) @@ -17578,14 +18244,14 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." (substring s (match-end ng)))))) s)) -(defun org-recenter-calendar (date) - "If the calendar is visible, recenter it to DATE." +(defun org-recenter-calendar (d) + "If the calendar is visible, recenter it to date D." (let ((cwin (get-buffer-window "*Calendar*" t))) (when cwin (let ((calendar-move-hook nil)) (with-selected-window cwin - (calendar-goto-date (if (listp date) date - (calendar-gregorian-from-absolute date)))))))) + (calendar-goto-date + (if (listp d) d (calendar-gregorian-from-absolute d)))))))) (defun org-goto-calendar (&optional arg) "Go to the Emacs calendar at the current date. @@ -17596,17 +18262,17 @@ A prefix ARG can be used to force the current date." (calendar-move-hook nil) (calendar-view-holidays-initially-flag nil) (calendar-view-diary-initially-flag nil)) - (if (or (org-at-timestamp-p) - (save-excursion - (beginning-of-line 1) - (looking-at (concat ".*" tsr)))) - (let ((d1 (time-to-days (current-time))) - (d2 (time-to-days - (org-time-string-to-time (match-string 1))))) - (setq diff (- d2 d1)))) + (when (or (org-at-timestamp-p) + (save-excursion + (beginning-of-line 1) + (looking-at (concat ".*" tsr)))) + (let ((d1 (time-to-days (current-time))) + (d2 (time-to-days + (org-time-string-to-time (match-string 1))))) + (setq diff (- d2 d1)))) (calendar) (calendar-goto-today) - (if (and diff (not arg)) (calendar-forward-day diff)))) + (when (and diff (not arg)) (calendar-forward-day diff)))) (defun org-get-date-from-calendar () "Return a list (month day year) of date at point in calendar." @@ -17625,7 +18291,8 @@ If there is already a time stamp at the cursor position, update it." (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) (defcustom org-effort-durations - `(("h" . 60) + `(("min" . 1) + ("h" . 60) ("d" . ,(* 60 8)) ("w" . ,(* 60 8 5)) ("m" . ,(* 60 8 5 4)) @@ -17641,7 +18308,8 @@ minutes. For example, if the value of this variable is ((\"hours\" . 60)), then an effort string \"2hours\" is equivalent to 120 minutes." :group 'org-agenda - :version "24.1" + :version "26.1" + :package-version '(Org . "8.3") :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) @@ -17734,10 +18402,6 @@ The format is determined by `org-time-clocksum-format', ;; return formatted time duration clocksum)))) -(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) -(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string - "Org mode version 8.0") - (defun org-hours-to-clocksum-string (n) (org-minutes-to-clocksum-string (* n 60))) @@ -17793,19 +18457,21 @@ tables are not re-aligned, etc." :version "24.3" :group 'org-agenda) -(defcustom org-agenda-ignore-drawer-properties nil +(defcustom org-agenda-ignore-properties nil "Avoid updating text properties when building the agenda. -Properties are used to prepare buffers for effort estimates, appointments, -and subtree-local categories. -If you don't use these in the agenda, you can add them to this list and -agenda building will be a bit faster. +Properties are used to prepare buffers for effort estimates, +appointments, statistics and subtree-local categories. +If you don't use these in the agenda, you can add them to this +list and agenda building will be a bit faster. The value is a list, with zero or more of the symbols `effort', `appt', -or `category'." +`stats' or `category'." :type '(set :greedy t (const effort) (const appt) + (const stats) (const category)) - :version "24.3" + :version "26.1" + :package-version '(Org . "8.3") :group 'org-agenda) (defun org-duration-string-to-minutes (s &optional output-to-string) @@ -17821,25 +18487,25 @@ Entries containing a colon are interpreted as H:MM by (regexp-opt (mapcar 'car org-effort-durations)) "\\)"))) (while (string-match re s) - (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) - (string-to-number (match-string 1 s)))) + (cl-incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) + (string-to-number (match-string 1 s)))) (setq s (replace-match "" nil t s))) (setq result (floor result)) - (incf result (org-hh:mm-string-to-minutes s)) + (cl-incf result (org-hh:mm-string-to-minutes s)) (if output-to-string (number-to-string result) result))) ;;;; Files (defun org-save-all-org-buffers () - "Save all Org-mode buffers without user confirmation." + "Save all Org buffers without user confirmation." (interactive) - (message "Saving all Org-mode buffers...") + (message "Saving all Org buffers...") (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) (when (featurep 'org-id) (org-id-locations-save)) - (message "Saving all Org-mode buffers... done")) + (message "Saving all Org buffers... done")) (defun org-revert-all-org-buffers () - "Revert all Org-mode buffers. + "Revert all Org buffers. Prompt for confirmation when there are unsaved changes. Be sure you know what you are doing before letting this function overwrite your changes. @@ -17856,13 +18522,11 @@ changes from another. I believe the procedure must be like this: (user-error "Abort")) (save-excursion (save-window-excursion - (mapc - (lambda (b) - (when (and (with-current-buffer b (derived-mode-p 'org-mode)) - (with-current-buffer b buffer-file-name)) - (org-pop-to-buffer-same-window b) - (revert-buffer t 'no-confirm))) - (buffer-list)) + (dolist (b (buffer-list)) + (when (and (with-current-buffer b (derived-mode-p 'org-mode)) + (with-current-buffer b buffer-file-name)) + (pop-to-buffer-same-window b) + (revert-buffer t 'no-confirm))) (when (and (featurep 'org-id) org-id-track-globally) (org-id-locations-load))))) @@ -17871,29 +18535,19 @@ changes from another. I believe the procedure must be like this: ;;;###autoload (defun org-switchb (&optional arg) "Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead." +With `\\[universal-argument]' prefix, restrict available buffers to files. + +With `\\[universal-argument] \\[universal-argument]' \ +prefix, restrict available buffers to agenda files." (interactive "P") - (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) - ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list)))) - (org-completion-use-iswitchb org-completion-use-iswitchb) - (org-completion-use-ido org-completion-use-ido)) - (unless (or org-completion-use-ido org-completion-use-iswitchb) - (setq org-completion-use-iswitchb t)) - (org-pop-to-buffer-same-window - (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) - -;;; Define some older names previously used for this functionality -;;;###autoload -(defalias 'org-ido-switchb 'org-switchb) -;;;###autoload -(defalias 'org-iswitchb 'org-switchb) + (let ((blist (org-buffer-list + (cond ((equal arg '(4)) 'files) + ((equal arg '(16)) 'agenda))))) + (pop-to-buffer-same-window + (completing-read "Org buffer: " + (mapcar #'list (mapcar #'buffer-name blist)) + nil t)))) (defun org-buffer-list (&optional predicate exclude-tmp) "Return a list of Org buffers. @@ -17968,8 +18622,10 @@ used by the agenda files. If ARCHIVE is `ifmode', do this only if "Return non-nil, if FILE is an agenda file. If FILE is omitted, use the file associated with the current buffer." - (member (or file (buffer-file-name)) - (org-agenda-files t))) + (let ((fname (or file (buffer-file-name)))) + (and fname + (member (file-truename fname) + (mapcar #'file-truename (org-agenda-files t)))))) (defun org-edit-agenda-file-list () "Edit the list of agenda files. @@ -17981,15 +18637,15 @@ the buffer and restores the previous window configuration." (if (stringp org-agenda-files) (let ((cw (current-window-configuration))) (find-file org-agenda-files) - (org-set-local 'org-window-configuration cw) - (org-add-hook 'after-save-hook - (lambda () - (set-window-configuration - (prog1 org-window-configuration - (kill-buffer (current-buffer)))) - (org-install-agenda-files-menu) - (message "New agenda file list installed")) - nil 'local) + (setq-local org-window-configuration cw) + (add-hook 'after-save-hook + (lambda () + (set-window-configuration + (prog1 org-window-configuration + (kill-buffer (current-buffer)))) + (org-install-agenda-files-menu) + (message "New agenda file list installed")) + nil 'local) (message "%s" (substitute-command-keys "Edit list and finish with \\[save-buffer]"))) (customize-variable 'org-agenda-files))) @@ -18039,19 +18695,16 @@ un-expanded file names." If the current buffer visits an agenda file, find the next one in the list. If the current buffer does not, find the first agenda file." (interactive) - (let* ((fs (org-agenda-files t)) - (files (append fs (list (car fs)))) - (tcf (if buffer-file-name (file-truename buffer-file-name))) + (let* ((fs (or (org-agenda-files t) + (user-error "No agenda files"))) + (files (copy-sequence fs)) + (tcf (and buffer-file-name (file-truename buffer-file-name))) file) - (unless files (user-error "No agenda files")) - (catch 'exit - (dolist (file files) - (if (equal (file-truename file) tcf) - (when (car files) - (find-file (car files)) - (throw 'exit t)))) - (find-file (car fs))) - (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer))))) + (when tcf + (while (and (setq file (pop files)) + (not (equal (file-truename file) tcf))))) + (find-file (car (or files fs))) + (when (buffer-base-buffer) (pop-to-buffer-same-window (buffer-base-buffer))))) (defun org-agenda-file-to-front (&optional to-end) "Move/add the current file to the top of the agenda file list. @@ -18069,7 +18722,7 @@ end of the list." x had) (setq x (assoc ctf file-alist) had x) - (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) + (unless x (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) (if to-end (setq file-alist (append (delq x file-alist) (list x))) (setq file-alist (cons x (delq x file-alist)))) @@ -18090,15 +18743,15 @@ Optional argument FILE means use this file instead of the current." (afile (abbreviate-file-name file)) (files (delq nil (mapcar (lambda (x) - (if (equal true-file - (file-truename x)) - nil x)) + (unless (equal true-file + (file-truename x)) + x)) (org-agenda-files t))))) (if (not (= (length files) (length (org-agenda-files t)))) (progn (org-store-new-agenda-file-list files) (org-install-agenda-files-menu) - (message "Removed file: %s" afile)) + (message "Removed from Org Agenda list: %s" afile)) (message "File was not in list: %s (not removed)" afile)))) (defun org-file-menu-entry (file) @@ -18106,7 +18759,7 @@ Optional argument FILE means use this file instead of the current." (defun org-check-agenda-file (file) "Make sure FILE exists. If not, ask user what to do." - (when (not (file-exists-p file)) + (unless (file-exists-p file) (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" (abbreviate-file-name file)) (let ((r (downcase (read-char-exclusive)))) @@ -18114,17 +18767,18 @@ Optional argument FILE means use this file instead of the current." ((equal r ?r) (org-remove-file file) (throw 'nextfile t)) - (t (error "Abort")))))) + (t (user-error "Abort")))))) (defun org-get-agenda-file-buffer (file) - "Get a buffer visiting FILE. If the buffer needs to be created, add -it to the list of buffers which might be released later." + "Get an agenda buffer visiting FILE. +If the buffer needs to be created, add it to the list of buffers +which might be released later." (let ((buf (org-find-base-buffer-visiting file))) (if buf buf ; just return it ;; Make a new buffer and remember it (setq buf (find-file-noselect file)) - (if buf (push buf org-agenda-new-buffers)) + (when buf (push buf org-agenda-new-buffers)) buf))) (defun org-release-buffers (blist) @@ -18149,7 +18803,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - file re pos) + re pos) (setq org-tag-alist-for-agenda nil org-tag-groups-alist-for-agenda nil) (save-excursion @@ -18161,20 +18815,15 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (org-check-agenda-file file) (set-buffer (org-get-agenda-file-buffer file))) (widen) - (org-set-regexps-and-options-for-tags) + (org-set-regexps-and-options 'tags-only) (setq pos (point)) - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (search-forward "#+setupfile" nil t) - ;; Don't set all regexps and options systematically as - ;; this is only run for setting agenda tags from setup - ;; file - (org-set-regexps-and-options))) - (or (memq 'category org-agenda-ignore-drawer-properties) + (or (memq 'category org-agenda-ignore-properties) (org-refresh-category-properties)) - (or (memq 'effort org-agenda-ignore-drawer-properties) - (org-refresh-properties org-effort-property 'org-effort)) - (or (memq 'appt org-agenda-ignore-drawer-properties) + (or (memq 'stats org-agenda-ignore-properties) + (org-refresh-stats-properties)) + (or (memq 'effort org-agenda-ignore-properties) + (org-refresh-effort-properties)) + (or (memq 'appt org-agenda-ignore-properties) (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) (setq org-todo-keywords-for-agenda (append org-todo-keywords-for-agenda org-todo-keywords-1)) @@ -18182,31 +18831,32 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (append org-done-keywords-for-agenda org-done-keywords)) (setq org-todo-keyword-alist-for-agenda (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) - (setq org-drawers-for-agenda - (append org-drawers-for-agenda org-drawers)) (setq org-tag-alist-for-agenda (org-uniquify (append org-tag-alist-for-agenda - org-tag-alist - org-tag-persistent-alist))) - (if org-group-tags - (setq org-tag-groups-alist-for-agenda - (org-uniquify-alist - (append org-tag-groups-alist-for-agenda org-tag-groups-alist)))) + org-current-tag-alist))) + ;; Merge current file's tag groups into global + ;; `org-tag-groups-alist-for-agenda'. + (when org-group-tags + (dolist (alist org-tag-groups-alist) + (let ((old (assoc (car alist) org-tag-groups-alist-for-agenda))) + (if old + (setcdr old (org-uniquify (append (cdr old) (cdr alist)))) + (push alist org-tag-groups-alist-for-agenda))))) (org-with-silent-modifications (save-excursion (remove-text-properties (point-min) (point-max) pall) (when org-agenda-skip-archived-trees (goto-char (point-min)) (while (re-search-forward rea nil t) - (if (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (when (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) (goto-char (point-min)) - (setq re (format org-heading-keyword-regexp-format - org-comment-string)) + (setq re (format "^\\*+ .*\\<%s\\>" org-comment-string)) (while (re-search-forward re nil t) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc)))) + (when (save-match-data (org-in-commented-heading-p t)) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc))))) (goto-char pos))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) @@ -18223,7 +18873,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) (org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) (org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) -(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) +(org-defkey org-cdlatex-mode-map "\C-c{" 'org-cdlatex-environment-indent) (defvar org-cdlatex-texmathp-advice-is-done nil "Flag remembering if we have applied the advice to texmathp already.") @@ -18231,7 +18881,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (define-minor-mode org-cdlatex-mode "Toggle the minor `org-cdlatex-mode'. This mode supports entering LaTeX environment and math in LaTeX fragments -in Org-mode. +in Org mode. \\{org-cdlatex-mode-map}" nil " OCDL" nil (when org-cdlatex-mode @@ -18241,11 +18891,11 @@ in Org-mode. (unless org-cdlatex-texmathp-advice-is-done (setq org-cdlatex-texmathp-advice-is-done t) (defadvice texmathp (around org-math-always-on activate) - "Always return t in org-mode buffers. + "Always return t in Org buffers. This is because we want to insert math symbols without dollars even outside -the LaTeX math segments. If Orgmode thinks that point is actually inside -an embedded LaTeX fragment, let texmathp do its job. -\\[org-cdlatex-mode-map]" +the LaTeX math segments. If Org mode thinks that point is actually inside +an embedded LaTeX fragment, let `texmathp' do its job. +`\\[org-cdlatex-mode-map]'" (interactive) (let (p) (cond @@ -18257,8 +18907,8 @@ an embedded LaTeX fragment, let texmathp do its job. (let ((p (org-inside-LaTeX-fragment-p))) (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) (setq ad-return-value t - texmathp-why '("Org-mode embedded math" . 0)) - (if p ad-do-it))))))))) + texmathp-why '("Org mode embedded math" . 0)) + (when p ad-do-it))))))))) (defun turn-on-org-cdlatex () "Unconditionally turn on `org-cdlatex-mode'." @@ -18283,7 +18933,7 @@ It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is (cdlatex-tab) t) ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) -(defun org-cdlatex-underscore-caret (&optional arg) +(defun org-cdlatex-underscore-caret (&optional _arg) "Execute `cdlatex-sub-superscript' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -18292,7 +18942,7 @@ Revert to the normal definition outside of these fragments." (let (org-cdlatex-mode) (call-interactively (key-binding (vector last-input-event)))))) -(defun org-cdlatex-math-modify (&optional arg) +(defun org-cdlatex-math-modify (&optional _arg) "Execute `cdlatex-math-modify' in LaTeX fragments. Revert to the normal definition outside of these fragments." (interactive "P") @@ -18301,21 +18951,66 @@ Revert to the normal definition outside of these fragments." (let (org-cdlatex-mode) (call-interactively (key-binding (vector last-input-event)))))) +(defun org-cdlatex-environment-indent (&optional environment item) + "Execute `cdlatex-environment' and indent the inserted environment. + +ENVIRONMENT and ITEM are passed to `cdlatex-environment'. + +The inserted environment is indented to current indentation +unless point is at the beginning of the line, in which the +environment remains unintended." + (interactive) + ;; cdlatex-environment always return nil. Therefore, capture output + ;; first and determine if an environment was selected. + (let* ((beg (point-marker)) + (end (copy-marker (point) t)) + (inserted (progn + (ignore-errors (cdlatex-environment environment item)) + (< beg end))) + ;; Figure out how many lines to move forward after the + ;; environment has been inserted. + (lines (when inserted + (save-excursion + (- (cl-loop while (< beg (point)) + with x = 0 + do (forward-line -1) + (cl-incf x) + finally return x) + (if (progn (goto-char beg) + (and (progn (skip-chars-forward " \t") (eolp)) + (progn (skip-chars-backward " \t") (bolp)))) + 1 0))))) + (env (org-trim (delete-and-extract-region beg end)))) + (when inserted + ;; Get indentation of next line unless at column 0. + (let ((ind (if (bolp) 0 + (save-excursion + (org-return-indent) + (prog1 (org-get-indentation) + (when (progn (skip-chars-forward " \t") (eolp)) + (delete-region beg (point))))))) + (bol (progn (skip-chars-backward " \t") (bolp)))) + ;; Insert a newline before environment unless at column zero + ;; to "escape" the current line. Insert a newline if + ;; something is one the same line as \end{ENVIRONMENT}. + (insert + (concat (unless bol "\n") env + (when (and (skip-chars-forward " \t") (not (eolp))) "\n"))) + (unless (zerop ind) + (save-excursion + (goto-char beg) + (while (< (point) end) + (unless (eolp) (indent-line-to ind)) + (forward-line)))) + (goto-char beg) + (forward-line lines) + (indent-line-to ind))) + (set-marker beg nil) + (set-marker end nil))) ;;;; LaTeX fragments -(defvar org-latex-regexps - '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) - ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) - ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) - "Regular expressions for matching embedded LaTeX.") - (defun org-inside-LaTeX-fragment-p () "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing @@ -18358,7 +19053,7 @@ looks only before point, not after." (while (re-search-backward "\\$\\$" lim t) (setq dd-on (not dd-on))) (goto-char pos) - (if dd-on (cons "$$" m)))))) + (when dd-on (cons "$$" m)))))) (defun org-inside-latex-macro-p () "Is point inside a LaTeX macro or its arguments?" @@ -18366,179 +19061,226 @@ looks only before point, not after." (org-in-regexp "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) -(defvar org-latex-fragment-image-overlays nil - "List of overlays carrying the images of latex fragments.") -(make-variable-buffer-local 'org-latex-fragment-image-overlays) +(defun org--format-latex-make-overlay (beg end image &optional imagetype) + "Build an overlay between BEG and END using IMAGE file. +Argument IMAGETYPE is the extension of the displayed image, +as a string. It defaults to \"png\"." + (let ((ov (make-overlay beg end)) + (imagetype (or (intern imagetype) 'png))) + (overlay-put ov 'org-overlay-type 'org-latex-overlay) + (overlay-put ov 'evaporate t) + (overlay-put ov + 'modification-hooks + (list (lambda (o _flag _beg _end &optional _l) + (delete-overlay o)))) + (overlay-put ov + 'display + (list 'image :type imagetype :file image :ascent 'center)))) + +(defun org--list-latex-overlays (&optional beg end) + "List all Org LaTeX overlays in current buffer. +Limit to overlays between BEG and END when those are provided." + (cl-remove-if-not + (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay)) + (overlays-in (or beg (point-min)) (or end (point-max))))) + +(defun org-remove-latex-fragment-image-overlays (&optional beg end) + "Remove all overlays with LaTeX fragment images in current buffer. +When optional arguments BEG and END are non-nil, remove all +overlays between them instead. Return a non-nil value when some +overlays were removed, nil otherwise." + (let ((overlays (org--list-latex-overlays beg end))) + (mapc #'delete-overlay overlays) + overlays)) + +(defun org-toggle-latex-fragment (&optional arg) + "Preview the LaTeX fragment at point, or all locally or globally. -(defun org-remove-latex-fragment-image-overlays () - "Remove all overlays with LaTeX fragment images in current buffer." - (mapc 'delete-overlay org-latex-fragment-image-overlays) - (setq org-latex-fragment-image-overlays nil)) +If the cursor is on a LaTeX fragment, create the image and overlay +it over the source code, if there is none. Remove it otherwise. +If there is no fragment at point, display all fragments in the +current section. -(defun org-preview-latex-fragment (&optional subtree) - "Preview the LaTeX fragment at point, or all locally or globally. -If the cursor is in a LaTeX fragment, create the image and overlay -it over the source code. If there is no fragment at point, display -all fragments in the current text, from one headline to the next. With -prefix SUBTREE, display all fragments in the current subtree. With a -double prefix arg \\[universal-argument] \\[universal-argument], or when \ -the cursor is before the first headline, -display all fragments in the buffer. -The images can be removed again with \\[org-ctrl-c-ctrl-c]." +With prefix ARG, preview or clear image for all fragments in the +current subtree or in the whole buffer when used before the first +headline. With a prefix ARG `\\[universal-argument] \ +\\[universal-argument]' preview or clear images +for all fragments in the buffer." (interactive "P") - (unless buffer-file-name - (user-error "Can't preview LaTeX fragment in a non-file buffer")) (when (display-graphic-p) - (org-remove-latex-fragment-image-overlays) - (save-excursion - (save-restriction - (let (beg end at msg) + (catch 'exit + (save-excursion + (let (beg end msg) (cond - ((or (equal subtree '(16)) - (not (save-excursion - (re-search-backward org-outline-regexp-bol nil t)))) - (setq beg (point-min) end (point-max) - msg "Creating images for buffer...%s")) - ((equal subtree '(4)) - (org-back-to-heading) - (setq beg (point) end (org-end-of-subtree t) - msg "Creating images for subtree...%s")) + ((or (equal arg '(16)) + (and (equal arg '(4)) + (org-with-limited-levels (org-before-first-heading-p)))) + (if (org-remove-latex-fragment-image-overlays) + (progn (message "LaTeX fragments images removed from buffer") + (throw 'exit nil)) + (setq msg "Creating images for buffer..."))) + ((equal arg '(4)) + (org-with-limited-levels (org-back-to-heading t)) + (setq beg (point)) + (setq end (progn (org-end-of-subtree t) (point))) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn + (message "LaTeX fragment images removed from subtree") + (throw 'exit nil)) + (setq msg "Creating images for subtree..."))) + ((let ((datum (org-element-context))) + (when (memq (org-element-type datum) + '(latex-environment latex-fragment)) + (setq beg (org-element-property :begin datum)) + (setq end (org-element-property :end datum)) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn (message "LaTeX fragment image removed") + (throw 'exit nil)) + (setq msg "Creating image..."))))) (t - (if (setq at (org-inside-LaTeX-fragment-p)) - (goto-char (max (point-min) (- (cdr at) 2))) - (org-back-to-heading)) - (setq beg (point) end (progn (outline-next-heading) (point)) - msg (if at "Creating image...%s" - "Creating images for entry...%s")))) - (message msg "") - (narrow-to-region beg end) - (goto-char beg) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer - org-latex-create-formula-image-program) - (message msg "done. Use `C-c C-c' to remove images.")))))) - -(defun org-format-latex (prefix &optional dir overlays msg at - forbuffer processing-type) - "Replace LaTeX fragments with links to an image, and produce images. + (org-with-limited-levels + (setq beg (if (org-at-heading-p) (line-beginning-position) + (outline-previous-heading) + (point))) + (setq end (progn (outline-next-heading) (point))) + (if (org-remove-latex-fragment-image-overlays beg end) + (progn + (message "LaTeX fragment images removed from section") + (throw 'exit nil)) + (setq msg "Creating images for section..."))))) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (org-format-latex + (concat org-preview-latex-image-directory "org-ltximg") + beg end + ;; Emacs cannot overlay images from remote hosts. Create + ;; it in `temporary-file-directory' instead. + (if (or (not file) (file-remote-p file)) + temporary-file-directory + default-directory) + 'overlays msg 'forbuffer org-preview-latex-default-process)) + (message (concat msg "done"))))))) + +(defun org-format-latex + (prefix &optional beg end dir overlays msg forbuffer processing-type) + "Replace LaTeX fragments with links to an image. + +The function takes care of creating the replacement image. + +Only consider fragments between BEG and END when those are +provided. + +When optional argument OVERLAYS is non-nil, display the image on +top of the fragment instead of replacing it. + +PROCESSING-TYPE is the conversion method to use, as a symbol. + Some of the options can be changed using the variable -`org-format-latex-options'." - (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) - (let* ((prefixnodir (file-name-nondirectory prefix)) - (absprefix (expand-file-name prefix dir)) - (todir (file-name-directory absprefix)) - (opt org-format-latex-options) - (optnew org-format-latex-options) - (matchers (plist-get opt :matchers)) - (re-list org-latex-regexps) - (cnt 0) txt hash link beg end re checkdir - string - m n block-type block linkfile movefile ov) - ;; Check the different regular expressions - (dolist (e re-list) - (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e) - block (if block-type "\n\n" "")) - (when (member m matchers) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (when (and (or (not at) (equal (cdr at) (match-beginning n))) - (or (not overlays) - (not (eq (get-char-property (match-beginning n) - 'org-overlay-type) - 'org-latex-overlay)))) - (cond - ((eq processing-type 'verbatim)) - ((eq processing-type 'mathjax) - ;; Prepare for MathJax processing. - (setq string (match-string n)) - (when (member m '("$" "$1")) - (save-excursion - (delete-region (match-beginning n) (match-end n)) - (goto-char (match-beginning n)) - (insert (concat "\\(" (substring string 1 -1) "\\)"))))) - ((or (eq processing-type 'dvipng) - (eq processing-type 'imagemagick)) - ;; Process to an image. - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt)) - (let ((face (face-at-point)) - (fg (plist-get opt :foreground)) - (bg (plist-get opt :background)) - ;; Ensure full list is printed. - print-length print-level) - (when forbuffer - ;; Get the colors from the face at point. +`org-format-latex-options', which see." + (when (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) + (unless (eq processing-type 'verbatim) + (let* ((math-regexp "\\$\\|\\\\[([]\\|^[ \t]*\\\\begin{[A-Za-z0-9*]+}") + (cnt 0) + checkdir-flag) + (goto-char (or beg (point-min))) + ;; Optimize overlay creation: (info "(elisp) Managing Overlays"). + (when (and overlays (memq processing-type '(dvipng imagemagick))) + (overlay-recenter (or end (point-max)))) + (while (re-search-forward math-regexp end t) + (unless (and overlays + (eq (get-char-property (point) 'org-overlay-type) + 'org-latex-overlay)) + (let* ((context (org-element-context)) + (type (org-element-type context))) + (when (memq type '(latex-environment latex-fragment)) + (let ((block-type (eq type 'latex-environment)) + (value (org-element-property :value context)) + (beg (org-element-property :begin context)) + (end (save-excursion + (goto-char (org-element-property :end context)) + (skip-chars-backward " \r\t\n") + (point)))) + (cond + ((eq processing-type 'mathjax) + ;; Prepare for MathJax processing. + (if (not (string-match "\\`\\$\\$?" value)) + (goto-char end) + (delete-region beg end) + (if (string= (match-string 0 value) "$$") + (insert "\\[" (substring value 2 -2) "\\]") + (insert "\\(" (substring value 1 -1) "\\)")))) + ((assq processing-type org-preview-latex-process-alist) + ;; Process to an image. + (cl-incf cnt) (goto-char beg) - (when (eq fg 'auto) - (setq fg (face-attribute face :foreground nil 'default))) - (when (eq bg 'auto) - (setq bg (face-attribute face :background nil 'default))) - (setq optnew (copy-sequence opt)) - (plist-put optnew :foreground fg) - (plist-put optnew :background bg)) - (setq hash (sha1 (prin1-to-string - (list org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist - org-format-latex-options - forbuffer txt fg bg))) - linkfile (format "%s_%s.png" prefix hash) - movefile (format "%s_%s.png" absprefix hash))) - (setq link (concat block "[[file:" linkfile "]]" block)) - (if msg (message msg cnt)) - (goto-char beg) - (unless checkdir ; Ensure the directory exists. - (setq checkdir t) - (or (file-directory-p todir) (make-directory todir t))) - (unless (file-exists-p movefile) - (org-create-formula-image - txt movefile optnew forbuffer processing-type)) - (if overlays - (progn - (mapc (lambda (o) - (if (eq (overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (delete-overlay o))) - (overlays-in beg end)) - (setq ov (make-overlay beg end)) - (overlay-put ov 'org-overlay-type 'org-latex-overlay) - (if (featurep 'xemacs) + (let* ((processing-info + (cdr (assq processing-type org-preview-latex-process-alist))) + (face (face-at-point)) + ;; Get the colors from the face at point. + (fg + (let ((color (plist-get org-format-latex-options + :foreground))) + (if (and forbuffer (eq color 'auto)) + (face-attribute face :foreground nil 'default) + color))) + (bg + (let ((color (plist-get org-format-latex-options + :background))) + (if (and forbuffer (eq color 'auto)) + (face-attribute face :background nil 'default) + color))) + (hash (sha1 (prin1-to-string + (list org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist + org-format-latex-options + forbuffer value fg bg)))) + (imagetype (or (plist-get processing-info :image-output-type) "png")) + (absprefix (expand-file-name prefix dir)) + (linkfile (format "%s_%s.%s" prefix hash imagetype)) + (movefile (format "%s_%s.%s" absprefix hash imagetype)) + (sep (and block-type "\n\n")) + (link (concat sep "[[file:" linkfile "]]" sep)) + (options + (org-combine-plists + org-format-latex-options + `(:foreground ,fg :background ,bg)))) + (when msg (message msg cnt)) + (unless checkdir-flag ; Ensure the directory exists. + (setq checkdir-flag t) + (let ((todir (file-name-directory absprefix))) + (unless (file-directory-p todir) + (make-directory todir t)))) + (unless (file-exists-p movefile) + (org-create-formula-image + value movefile options forbuffer processing-type)) + (if overlays (progn - (overlay-put ov 'invisible t) - (overlay-put - ov 'end-glyph - (make-glyph (vector 'png :file movefile)))) - (overlay-put - ov 'display - (list 'image :type 'png :file movefile :ascent 'center))) - (push ov org-latex-fragment-image-overlays) - (goto-char end)) - (delete-region beg end) - (insert (org-add-props link - (list 'org-latex-src - (replace-regexp-in-string - "\"" "" txt) - 'org-latex-src-embed-type - (if block-type 'paragraph 'character)))))) - ((eq processing-type 'mathml) - ;; Process to MathML - (unless (save-match-data (org-format-latex-mathml-available-p)) - (user-error "LaTeX to MathML converter not configured")) - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt)) - (if msg (message msg cnt)) - (goto-char beg) - (delete-region beg end) - (insert (org-format-latex-as-mathml - txt block-type prefix dir))) - (t - (error "Unknown conversion type %s for LaTeX fragments" - processing-type))))))))) + (dolist (o (overlays-in beg end)) + (when (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (org--format-latex-make-overlay beg end movefile imagetype) + (goto-char end)) + (delete-region beg end) + (insert + (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string "\"" "" value) + 'org-latex-src-embed-type + (if block-type 'paragraph 'character))))))) + ((eq processing-type 'mathml) + ;; Process to MathML. + (unless (org-format-latex-mathml-available-p) + (user-error "LaTeX to MathML converter not configured")) + (cl-incf cnt) + (when msg (message msg cnt)) + (goto-char beg) + (delete-region beg end) + (insert (org-format-latex-as-mathml + value block-type prefix dir))) + (t + (error "Unknown conversion process %s for LaTeX fragments" + processing-type))))))))))) (defun org-create-math-formula (latex-frag &optional mathml-file) "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. @@ -18553,20 +19295,25 @@ inspection." (buffer-substring-no-properties (region-beginning) (region-end))))) (read-string "LaTeX Fragment: " frag nil frag)))) - (unless latex-frag (error "Invalid LaTeX fragment")) - (let* ((tmp-in-file (file-relative-name - (make-temp-name (expand-file-name "ltxmathml-in")))) - (ignore (write-region latex-frag nil tmp-in-file)) + (unless latex-frag (user-error "Invalid LaTeX fragment")) + (let* ((tmp-in-file + (let ((file (file-relative-name + (make-temp-name (expand-file-name "ltxmathml-in"))))) + (write-region latex-frag nil file) + file)) (tmp-out-file (file-relative-name (make-temp-name (expand-file-name "ltxmathml-out")))) (cmd (format-spec org-latex-to-mathml-convert-command - `((?j . ,(shell-quote-argument - (expand-file-name org-latex-to-mathml-jar-file))) + `((?j . ,(and org-latex-to-mathml-jar-file + (shell-quote-argument + (expand-file-name + org-latex-to-mathml-jar-file)))) (?I . ,(shell-quote-argument tmp-in-file)) + (?i . ,latex-frag) (?o . ,(shell-quote-argument tmp-out-file))))) mathml shell-command-output) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (unless (org-format-latex-mathml-available-p) (user-error "LaTeX to MathML converter not configured"))) (message "Running %s" cmd) @@ -18576,11 +19323,10 @@ inspection." (with-current-buffer (find-file-noselect tmp-out-file t) (goto-char (point-min)) (when (re-search-forward - (concat - (regexp-quote - "") - "\\(.\\|\n\\)*" - (regexp-quote "")) nil t) + (format "]*?%s[^>]*?>\\(.\\|\n\\)*" + (regexp-quote + "xmlns=\"http://www.w3.org/1998/Math/MathML\"")) + nil t) (prog1 (match-string 0) (kill-buffer)))))) (cond (mathml @@ -18588,7 +19334,7 @@ inspection." (concat "\n" mathml)) (when mathml-file (write-region mathml nil mathml-file)) - (when (org-called-interactively-p 'any) + (when (called-interactively-p 'any) (message mathml))) ((message "LaTeX to MathML conversion failed") (message shell-command-output))) @@ -18627,186 +19373,117 @@ inspection." ;; Failed conversion. Return the LaTeX fragment verbatim latex-frag))) -(defun org-create-formula-image (string tofile options buffer &optional type) - "Create an image from LaTeX source using dvipng or convert. -This function calls either `org-create-formula-image-with-dvipng' -or `org-create-formula-image-with-imagemagick' depending on the -value of `org-latex-create-formula-image-program' or on the value -of the optional TYPE variable. - -Note: ultimately these two function should be combined as they -share a good deal of logic." - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (funcall - (case (or type org-latex-create-formula-image-program) - ('dvipng - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - #'org-create-formula-image-with-dvipng) - ('imagemagick - (org-check-external-command - "convert" "you need to install imagemagick") - #'org-create-formula-image-with-imagemagick) - (t (error - "Invalid value of `org-latex-create-formula-image-program'"))) - string tofile options buffer)) - -(declare-function org-export-get-backend "ox" (name)) -(declare-function org-export--get-global-options "ox" (&optional backend)) -(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-guess-babel-language "ox-latex" (header info)) -(defun org-create-formula--latex-header () - "Return LaTeX header appropriate for previewing a LaTeX snippet." - (let ((info (org-combine-plists (org-export--get-global-options - (org-export-get-backend 'latex)) - (org-export--get-inbuffer-options - (org-export-get-backend 'latex))))) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist t - (plist-get info :latex-header))) - info))) - -;; This function borrows from Ganesh Swami's latex2png.el -(defun org-create-formula-image-with-dvipng (string tofile options buffer) - "This calls dvipng." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) +(defun org--get-display-dpi () + "Get the DPI of the display. +The function assumes that the display has the same pixel width in +the horizontal and vertical directions." + (if (display-graphic-p) + (round (/ (display-pixel-height) + (/ (display-mm-height) 25.4))) + (error "Attempt to calculate the dpi of a non-graphic display"))) + +(defun org-create-formula-image + (string tofile options buffer &optional processing-type) + "Create an image from LaTeX source using external processes. + +The LaTeX STRING is saved to a temporary LaTeX file, then +converted to an image file by process PROCESSING-TYPE defined in +`org-preview-latex-process-alist'. A nil value defaults to +`org-preview-latex-default-process'. + +The generated image file is eventually moved to TOFILE. + +The OPTIONS argument controls the size, foreground color and +background color of the generated image. + +When BUFFER non-nil, this function is used for LaTeX previewing. +Otherwise, it is used to deal with LaTeX snippets showed in +a HTML file." + (let* ((processing-type (or processing-type + org-preview-latex-default-process)) + (processing-info + (cdr (assq processing-type org-preview-latex-process-alist))) + (programs (plist-get processing-info :programs)) + (error-message (or (plist-get processing-info :message) "")) + (use-xcolor (plist-get processing-info :use-xcolor)) + (image-input-type (plist-get processing-info :image-input-type)) + (image-output-type (plist-get processing-info :image-output-type)) + (post-clean (or (plist-get processing-info :post-clean) + '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log" + ".svg" ".png" ".jpg" ".jpeg" ".out"))) + (latex-header + (or (plist-get processing-info :latex-header) + (org-latex-make-preamble + (org-export-get-environment (org-export-get-backend 'latex)) + org-format-latex-header + 'snippet))) + (latex-compiler (plist-get processing-info :latex-compiler)) + (image-converter (plist-get processing-info :image-converter)) + (tmpdir temporary-file-directory) (texfilebase (make-temp-name (expand-file-name "orgtex" tmpdir))) (texfile (concat texfilebase ".tex")) - (dvifile (concat texfilebase ".dvi")) - (pngfile (concat texfilebase ".png")) - (fnh (if (featurep 'xemacs) - (font-height (face-font 'default)) - (face-attribute 'default :height nil))) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (image-size-adjust (or (plist-get processing-info :image-size-adjust) + '(1.0 . 1.0))) + (scale (* (if buffer (car image-size-adjust) (cdr image-size-adjust)) + (or (plist-get options (if buffer :scale :html-scale)) 1.0))) + (dpi (* scale (if buffer (org--get-display-dpi) 140.0))) (fg (or (plist-get options (if buffer :foreground :html-foreground)) "Black")) (bg (or (plist-get options (if buffer :background :html-background)) - "Transparent"))) - (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) - (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) - (if (eq bg 'default) (setq bg (org-dvipng-color :background)) - (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) - (let ((latex-header (org-create-formula--latex-header))) + "Transparent")) + (log-buf (get-buffer-create "*Org Preview LaTeX Output*")) + (resize-mini-windows nil)) ;Fix Emacs flicker when creating image. + (dolist (program programs) + (org-check-external-command program error-message)) + (if use-xcolor + (progn (if (eq fg 'default) + (setq fg (org-latex-color :foreground)) + (setq fg (org-latex-color-format fg))) + (if (eq bg 'default) + (setq bg (org-latex-color :background)) + (setq bg (org-latex-color-format + (if (string= bg "Transparent") "white" bg)))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n"))) + (if (eq fg 'default) + (setq fg (org-dvipng-color :foreground)) + (unless (string= fg "Transparent") + (setq fg (org-dvipng-color-format fg)))) + (if (eq bg 'default) + (setq bg (org-dvipng-color :background)) + (unless (string= bg "Transparent") + (setq bg (org-dvipng-color-format bg)))) (with-temp-file texfile (insert latex-header) (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) - (let ((dir default-directory)) - (condition-case nil - (progn - (cd tmpdir) - (call-process "latex" nil nil nil texfile)) - (error nil)) - (cd dir)) - (if (not (file-exists-p dvifile)) - (progn (message "Failed to create dvi file from %s" texfile) nil) - (condition-case nil - (if (featurep 'xemacs) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-T" "tight" - "-o" pngfile - dvifile) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-D" dpi - ;;"-x" scale "-y" scale - "-T" "tight" - "-o" pngfile - dvifile)) - (error nil)) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) - -(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) -(defun org-create-formula-image-with-imagemagick (string tofile options buffer) - "This calls convert, which is included into imagemagick." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) - (texfilebase (make-temp-name - (expand-file-name "orgtex" tmpdir))) - (texfile (concat texfilebase ".tex")) - (pdffile (concat texfilebase ".pdf")) - (pngfile (concat texfilebase ".png")) - (fnh (if (featurep 'xemacs) - (font-height (face-font 'default)) - (face-attribute 'default :height nil))) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) - (fg (or (plist-get options (if buffer :foreground :html-foreground)) - "black")) - (bg (or (plist-get options (if buffer :background :html-background)) - "white"))) - (if (eq fg 'default) (setq fg (org-latex-color :foreground)) - (setq fg (org-latex-color-format fg))) - (if (eq bg 'default) (setq bg (org-latex-color :background)) - (setq bg (org-latex-color-format - (if (string= bg "Transparent") "white" bg)))) - (let ((latex-header (org-create-formula--latex-header))) - (with-temp-file texfile - (insert latex-header) - (insert "\n\\begin{document}\n" - "\\definecolor{fg}{rgb}{" fg "}\n" - "\\definecolor{bg}{rgb}{" bg "}\n" - "\n\\pagecolor{bg}\n" - "\n{\\color{fg}\n" - string - "\n}\n" - "\n\\end{document}\n"))) - (org-latex-compile texfile t) - (if (not (file-exists-p pdffile)) - (progn (message "Failed to create pdf file from %s" texfile) nil) - (condition-case nil - (if (featurep 'xemacs) - (call-process "convert" nil nil nil - "-density" "96" - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile) - (call-process "convert" nil nil nil - "-density" dpi - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile)) - (error nil)) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) + + (let* ((err-msg (format "Please adjust '%s' part of \ +`org-preview-latex-process-alist'." + processing-type)) + (image-input-file + (org-compile-file + texfile latex-compiler image-input-type err-msg log-buf)) + (image-output-file + (org-compile-file + image-input-file image-converter image-output-type err-msg log-buf + `((?F . ,(shell-quote-argument fg)) + (?B . ,(shell-quote-argument bg)) + (?D . ,(shell-quote-argument (format "%s" dpi))) + (?S . ,(shell-quote-argument (format "%s" (/ dpi 140.0)))))))) + (copy-file image-output-file tofile 'replace) + (dolist (e post-clean) + (when (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + image-output-file))) (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) "Fill a LaTeX header template TPL. @@ -18830,22 +19507,22 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (setq rpl (if (or (match-end 1) (not def-pkg)) "" (org-latex-packages-to-string def-pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + (when def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not pkg)) "" (org-latex-packages-to-string pkg snippets-p t)) tpl (replace-match rpl t t tpl)) - (if pkg (setq end - (concat end "\n" - (org-latex-packages-to-string pkg snippets-p))))) + (when pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) (setq rpl (if (or (match-end 1) (not extra)) "" (concat extra "\n")) tpl (replace-match rpl t t tpl)) - (if (and extra (string-match "\\S-" extra)) - (setq end (concat end "\n" extra)))) + (when (and extra (string-match "\\S-" extra)) + (setq end (concat end "\n" extra)))) (if (string-match "\\S-" end) (concat tpl "\n" end) @@ -18869,35 +19546,21 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." (defun org-dvipng-color (attr) "Return a RGB color specification for dvipng." - (apply 'format "rgb %s %s %s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) + (org-dvipng-color-format (face-attribute 'default attr nil))) (defun org-dvipng-color-format (color-name) "Convert COLOR-NAME to a RGB color value for dvipng." - (apply 'format "rgb %s %s %s" + (apply #'format "rgb %s %s %s" (mapcar 'org-normalize-color - (color-values color-name)))) + (color-values color-name)))) (defun org-latex-color (attr) "Return a RGB color for the LaTeX color package." - (apply 'format "%s,%s,%s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) + (org-latex-color-format (face-attribute 'default attr nil))) (defun org-latex-color-format (color-name) "Convert COLOR-NAME to a RGB color value." - (apply 'format "%s,%s,%s" + (apply #'format "%s,%s,%s" (mapcar 'org-normalize-color (color-values color-name)))) @@ -18909,8 +19572,7 @@ SNIPPETS-P indicates if this is run to create snippet images for HTML." ;; Image display -(defvar org-inline-image-overlays nil) -(make-variable-buffer-local 'org-inline-image-overlays) +(defvar-local org-inline-image-overlays nil) (defun org-toggle-inline-images (&optional include-linked) "Toggle the display of inline images. @@ -18919,13 +19581,14 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (if org-inline-image-overlays (progn (org-remove-inline-images) - (message "Inline image display turned off")) + (when (called-interactively-p 'interactive) + (message "Inline image display turned off"))) (org-display-inline-images include-linked) - (if (and (org-called-interactively-p) - org-inline-image-overlays) - (message "%d images displayed inline" - (length org-inline-image-overlays)) - (message "No images to display inline")))) + (when (called-interactively-p 'interactive) + (message (if org-inline-image-overlays + (format "%d images displayed inline" + (length org-inline-image-overlays)) + "No images to display inline"))))) (defun org-redisplay-inline-images () "Refresh the display of inline images." @@ -18937,68 +19600,116 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. -Normally only links without a description part are inlined, because this -is how it will work for export. When INCLUDE-LINKED is set, also links -with a description part will be inlined. This can be nice for a quick -look at those images, but it does not reflect what exported files will look -like. -When REFRESH is set, refresh existing images between BEG and END. -This will create new image displays only if necessary. -BEG and END default to the buffer boundaries." + +An inline image is a link which follows either of these +conventions: + + 1. Its path is a file with an extension matching return value + from `image-file-name-regexp' and it has no contents. + + 2. Its description consists in a single link of the previous + type. + +When optional argument INCLUDE-LINKED is non-nil, also links with +a text description part will be inlined. This can be nice for +a quick look at those images, but it does not reflect what +exported files will look like. + +When optional argument REFRESH is non-nil, refresh existing +images between BEG and END. This will create new image displays +only if necessary. BEG and END default to the buffer +boundaries." (interactive "P") (when (display-graphic-p) (unless refresh (org-remove-inline-images) - (if (fboundp 'clear-image-cache) (clear-image-cache))) - (save-excursion - (save-restriction - (widen) - (setq beg (or beg (point-min)) end (or end (point-max))) - (goto-char beg) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) - "\\)\\]" (if include-linked "" "\\]"))) - (case-fold-search t) - old file ov img type attrwidth width) - (while (re-search-forward re end t) - (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay) - file (expand-file-name - (concat (or (match-string 3) "") (match-string 4)))) - (when (image-type-available-p 'imagemagick) - (setq attrwidth (if (or (listp org-image-actual-width) - (null org-image-actual-width)) - (save-excursion - (save-match-data - (when (re-search-backward - "#\\+attr.*:width[ \t]+\\([^ ]+\\)" - (save-excursion - (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) - (string-to-number (match-string 1)))))) - width (cond ((eq org-image-actual-width t) nil) - ((null org-image-actual-width) attrwidth) - ((numberp org-image-actual-width) - org-image-actual-width) - ((listp org-image-actual-width) - (or attrwidth (car org-image-actual-width)))) - type (if width 'imagemagick))) - (when (file-exists-p file) - (if (and (car-safe old) refresh) - (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file type nil :width width))) - (when img - (setq ov (make-overlay (match-beginning 0) (match-end 0))) - (overlay-put ov 'display img) - (overlay-put ov 'face 'default) - (overlay-put ov 'org-image-overlay t) - (overlay-put ov 'modification-hooks - (list 'org-display-inline-remove-overlay)) - (push ov org-inline-image-overlays)))))))))) - -(define-obsolete-function-alias - 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") - -(defun org-display-inline-remove-overlay (ov after beg end &optional len) + (when (fboundp 'clear-image-cache) (clear-image-cache))) + (org-with-wide-buffer + (goto-char (or beg (point-min))) + (let ((case-fold-search t) + (file-extension-re (image-file-name-regexp))) + (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t) + (let ((link (save-match-data (org-element-context)))) + ;; Check if we're at an inline image. + (when (and (equal (org-element-property :type link) "file") + (or include-linked + (not (org-element-property :contents-begin link))) + (let ((parent (org-element-property :parent link))) + (or (not (eq (org-element-type parent) 'link)) + (not (cdr (org-element-contents parent))))) + (string-match-p file-extension-re + (org-element-property :path link))) + (let ((file (expand-file-name + (org-link-unescape + (org-element-property :path link))))) + (when (file-exists-p file) + (let ((width + ;; Apply `org-image-actual-width' specifications. + (cond + ((not (image-type-available-p 'imagemagick)) nil) + ((eq org-image-actual-width t) nil) + ((listp org-image-actual-width) + (or + ;; First try to find a width among + ;; attributes associated to the paragraph + ;; containing link. + (let ((paragraph + (let ((e link)) + (while (and (setq e (org-element-property + :parent e)) + (not (eq (org-element-type e) + 'paragraph)))) + e))) + (when paragraph + (save-excursion + (goto-char (org-element-property :begin paragraph)) + (when + (re-search-forward + "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)" + (org-element-property + :post-affiliated paragraph) + t) + (string-to-number (match-string 1)))))) + ;; Otherwise, fall-back to provided number. + (car org-image-actual-width))) + ((numberp org-image-actual-width) + org-image-actual-width))) + (old (get-char-property-and-overlay + (org-element-property :begin link) + 'org-image-overlay))) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (let ((image (create-image file + (and width 'imagemagick) + nil + :width width))) + (when image + (let* ((link + ;; If inline image is the description + ;; of another link, be sure to + ;; consider the latter as the one to + ;; apply the overlay on. + (let ((parent + (org-element-property :parent link))) + (if (eq (org-element-type parent) 'link) + parent + link))) + (ov (make-overlay + (org-element-property :begin link) + (progn + (goto-char + (org-element-property :end link)) + (skip-chars-backward " \t") + (point))))) + (overlay-put ov 'display image) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put + ov 'modification-hooks + (list 'org-display-inline-remove-overlay)) + (push ov org-inline-image-overlays))))))))))))))) + +(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len) "Remove inline-display overlay if a corresponding region is modified." (let ((inhibit-modification-hooks t)) (when (and ov after) @@ -19008,7 +19719,7 @@ BEG and END default to the buffer boundaries." (defun org-remove-inline-images () "Remove inline display of images." (interactive) - (mapc 'delete-overlay org-inline-image-overlays) + (mapc #'delete-overlay org-inline-image-overlays) (setq org-inline-image-overlays nil)) ;;;; Key bindings @@ -19016,44 +19727,46 @@ BEG and END default to the buffer boundaries." ;; Outline functions from `outline-mode-prefix-map' ;; that can be remapped in Org: (define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) -(define-key org-mode-map [remap show-subtree] 'org-show-subtree) +(define-key org-mode-map [remap outline-show-subtree] 'org-show-subtree) (define-key org-mode-map [remap outline-forward-same-level] 'org-forward-heading-same-level) (define-key org-mode-map [remap outline-backward-same-level] 'org-backward-heading-same-level) -(define-key org-mode-map [remap show-branches] +(define-key org-mode-map [remap outline-show-branches] 'org-kill-note-or-show-branches) (define-key org-mode-map [remap outline-promote] 'org-promote-subtree) (define-key org-mode-map [remap outline-demote] 'org-demote-subtree) (define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) +(define-key org-mode-map [remap outline-next-visible-heading] + 'org-next-visible-heading) +(define-key org-mode-map [remap outline-previous-visible-heading] + 'org-previous-visible-heading) +(define-key org-mode-map [remap show-children] 'org-show-children) ;; Outline functions from `outline-mode-prefix-map' that can not ;; be remapped in Org: -;; + ;; - the column "key binding" shows whether the Outline function is still ;; available in Org mode on the same key that it has been bound to in ;; Outline mode: ;; - "overridden": key used for a different functionality in Org mode ;; - else: key still bound to the same Outline function in Org mode -;; -;; | Outline function | key binding | Org replacement | -;; |------------------------------------+-------------+-----------------------| -;; | `outline-next-visible-heading' | `C-c C-n' | still same function | -;; | `outline-previous-visible-heading' | `C-c C-p' | still same function | -;; | `outline-up-heading' | `C-c C-u' | still same function | -;; | `outline-move-subtree-up' | overridden | better: org-shiftup | -;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | -;; | `show-entry' | overridden | no replacement | -;; | `show-children' | `C-c C-i' | visibility cycling | -;; | `show-branches' | `C-c C-k' | still same function | -;; | `show-subtree' | overridden | visibility cycling | -;; | `show-all' | overridden | no replacement | -;; | `hide-subtree' | overridden | visibility cycling | -;; | `hide-body' | overridden | no replacement | -;; | `hide-entry' | overridden | visibility cycling | -;; | `hide-leaves' | overridden | no replacement | -;; | `hide-sublevels' | overridden | no replacement | -;; | `hide-other' | overridden | no replacement | + +;; | Outline function | key binding | Org replacement | +;; |------------------------------------+-------------+--------------------------| +;; | `outline-up-heading' | `C-c C-u' | still same function | +;; | `outline-move-subtree-up' | overridden | better: org-shiftup | +;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | +;; | `show-entry' | overridden | no replacement | +;; | `show-branches' | `C-c C-k' | still same function | +;; | `show-subtree' | overridden | visibility cycling | +;; | `show-all' | overridden | no replacement | +;; | `hide-subtree' | overridden | visibility cycling | +;; | `hide-body' | overridden | no replacement | +;; | `hide-entry' | overridden | visibility cycling | +;; | `hide-leaves' | overridden | no replacement | +;; | `hide-sublevels' | overridden | no replacement | +;; | `hide-other' | overridden | no replacement | ;; Make `C-c C-x' a prefix key (org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) @@ -19064,8 +19777,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) (org-defkey org-mode-map "\M-\t" #'pcomplete) ;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) +(org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab) (org-defkey org-mode-map [(shift tab)] 'org-shifttab) (define-key org-mode-map [backtab] 'org-shifttab) @@ -19079,6 +19791,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [(meta up)] 'org-metaup) (org-defkey org-mode-map [(meta down)] 'org-metadown) +(org-defkey org-mode-map [(control meta shift right)] 'org-increase-number-at-point) +(org-defkey org-mode-map [(control meta shift left)] 'org-decrease-number-at-point) (org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) (org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) @@ -19096,17 +19810,14 @@ BEG and END default to the buffer boundaries." ;; Babel keys (define-key org-mode-map org-babel-key-prefix org-babel-map) -(mapc (lambda (pair) - (define-key org-babel-map (car pair) (cdr pair))) - org-babel-key-bindings) +(dolist (pair org-babel-key-bindings) + (define-key org-babel-map (car pair) (cdr pair))) ;;; Extra keys for tty access. ;; We only set them when really needed because otherwise the ;; menus don't show the simple keys -(when (or org-use-extra-keys - (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (not window-system)) +(when (or org-use-extra-keys (not window-system)) (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) @@ -19138,7 +19849,7 @@ BEG and END default to the buffer boundaries." ;; All the other keys -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. +(org-defkey org-mode-map "\C-c\C-a" 'outline-show-all) ; in case allout messed up. (org-defkey org-mode-map "\C-c\C-r" 'org-reveal) (if (boundp 'narrow-map) (org-defkey narrow-map "s" 'org-narrow-to-subtree) @@ -19185,6 +19896,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) (org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) (org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) +(org-defkey org-mode-map "\C-c\M-l" 'org-insert-last-stored-link) (org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) (org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) (org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) @@ -19209,8 +19921,10 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) (org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) (org-defkey org-mode-map [remap open-line] 'org-open-line) +(org-defkey org-mode-map [remap comment-dwim] 'org-comment-dwim) (org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) (org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) +(org-defkey org-mode-map "\M-^" 'org-delete-indentation) (org-defkey org-mode-map "\C-m" 'org-return) (org-defkey org-mode-map "\C-j" 'org-return-indent) (org-defkey org-mode-map "\C-c?" 'org-table-field-info) @@ -19219,6 +19933,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) (org-defkey org-mode-map "\C-c'" 'org-edit-special) (org-defkey org-mode-map "\C-c`" 'org-table-edit-field) +(org-defkey org-mode-map "\C-c\"a" 'orgtbl-ascii-plot) +(org-defkey org-mode-map "\C-c\"g" 'org-plot/gnuplot) (org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) (org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) (org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) @@ -19226,7 +19942,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) (org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) (org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) -(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) +(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width) (org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) (org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) (org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) @@ -19250,7 +19966,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) (org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) (org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) -(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) +(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-toggle-latex-fragment) (org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) (org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) (org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) @@ -19260,9 +19976,8 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) (org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) -(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) +(org-defkey org-mode-map "\C-c\C-xi" 'org-columns-insert-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) -(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) @@ -19280,15 +19995,11 @@ BEG and END default to the buffer boundaries." (define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - - (defconst org-speed-commands-default '( ("Outline Navigation") - ("n" . (org-speed-move-safe 'outline-next-visible-heading)) - ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) + ("n" . (org-speed-move-safe 'org-next-visible-heading)) + ("p" . (org-speed-move-safe 'org-previous-visible-heading)) ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) ("F" . org-next-block) @@ -19303,8 +20014,8 @@ BEG and END default to the buffer boundaries." ("s" . org-narrow-to-subtree) ("=" . org-columns) ("Outline Structure Editing") - ("U" . org-shiftmetaup) - ("D" . org-shiftmetadown) + ("U" . org-metaup) + ("D" . org-metadown) ("r" . org-metaright) ("l" . org-metaleft) ("R" . org-shiftmetaright) @@ -19364,10 +20075,10 @@ BEG and END default to the buffer boundaries." (user-error "Speed commands are not activated, customize `org-use-speed-commands'") (with-output-to-temp-buffer "*Help*" (princ "User-defined Speed commands\n===========================\n") - (mapc 'org-print-speed-command org-speed-commands-user) + (mapc #'org-print-speed-command org-speed-commands-user) (princ "\n") (princ "Built-in Speed commands\n=======================\n") - (mapc 'org-print-speed-command org-speed-commands-default)) + (mapc #'org-print-speed-command org-speed-commands-default)) (with-current-buffer "*Help*" (setq truncate-lines t)))) @@ -19386,9 +20097,6 @@ If not, return to the original position and throw an error." (defvar org-table-auto-blank-field) ; defined in org-table.el (defvar org-speed-command nil) -(define-obsolete-function-alias - 'org-speed-command-default-hook 'org-speed-command-activate "24.3") - (defun org-speed-command-activate (keys) "Hook for activating single-letter speed commands. `org-speed-commands-default' specifies a minimal command set. @@ -19399,9 +20107,6 @@ Use `org-speed-commands-user' for further customization." (cdr (assoc keys (append org-speed-commands-user org-speed-commands-default))))) -(define-obsolete-function-alias - 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") - (defun org-babel-speed-command-activate (keys) "Hook for activating single-letter code block commands." (when (and (bolp) (looking-at org-babel-src-block-regexp)) @@ -19434,9 +20139,11 @@ overwritten, and the table is not marked as requiring realignment." (org-check-before-invisible-edit 'insert) (cond ((and org-use-speed-commands - (setq org-speed-command - (run-hook-with-args-until-success - 'org-speed-command-hook (this-command-keys)))) + (let ((kv (this-command-keys-vector))) + (setq org-speed-command + (run-hook-with-args-until-success + 'org-speed-command-hook + (make-string 1 (aref kv (1- (length kv)))))))) (cond ((commandp org-speed-command) (setq this-command org-speed-command) @@ -19448,94 +20155,98 @@ overwritten, and the table is not marked as requiring realignment." (t (let (org-use-speed-commands) (call-interactively 'org-self-insert-command))))) ((and - (org-table-p) + (org-at-table-p) (progn - ;; check if we blank the field, and if that triggers align + ;; Check if we blank the field, and if that triggers align. (and (featurep 'org-table) org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width + (memq last-command + '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c)) + (if (or (eq (char-after) ?\s) (looking-at "[^|\n]* |")) + ;; Got extra space, this field does not determine + ;; column width. (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width + ;; No extra space, this field may determine column + ;; width. (org-table-blank-field))) t) (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (backward-delete-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N))) + (looking-at "[^|\n]* \\( \\)|")) + ;; There is room for insertion without re-aligning the table. + (delete-region (match-beginning 1) (match-end 1)) + (self-insert-command N)) (t (setq org-table-may-need-update t) (self-insert-command N) (org-fix-tags-on-the-fly) - (if org-self-insert-cluster-for-undo - (if (not (eq last-command 'org-self-insert-command)) + (when org-self-insert-cluster-for-undo + (if (not (eq last-command 'org-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) (setq org-self-insert-command-undo-counter 1) - (if (>= org-self-insert-command-undo-counter 20) - (setq org-self-insert-command-undo-counter 1) - (and (> org-self-insert-command-undo-counter 0) - buffer-undo-list (listp buffer-undo-list) - (not (cadr buffer-undo-list)) ; remove nil entry - (setcdr buffer-undo-list (cddr buffer-undo-list))) - (setq org-self-insert-command-undo-counter - (1+ org-self-insert-command-undo-counter)))))))) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list (listp buffer-undo-list) + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter)))))))) (defun org-check-before-invisible-edit (kind) "Check is editing if kind KIND would be dangerous with invisible text around. The detailed reaction depends on the user option `org-catch-invisible-edits'." ;; First, try to get out of here as quickly as possible, to reduce overhead - (if (and org-catch-invisible-edits - (or (not (boundp 'visible-mode)) (not visible-mode)) - (or (get-char-property (point) 'invisible) - (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look - (let* ((invisible-at-point (get-char-property (point) 'invisible)) - (invisible-before-point (if (bobp) nil (get-char-property - (1- (point)) 'invisible))) - (border-and-ok-direction - (or - ;; Check if we are acting predictably before invisible text - (and invisible-at-point (not invisible-before-point) - (memq kind '(insert delete-backward))) - ;; Check if we are acting predictably after invisible text - ;; This works not well, and I have turned it off. It seems - ;; better to always show and stop after invisible text. - ;; (and (not invisible-at-point) invisible-before-point - ;; (memq kind '(insert delete))) - ))) - (when (or (memq invisible-at-point '(outline org-hide-block t)) - (memq invisible-before-point '(outline org-hide-block t))) - (if (eq org-catch-invisible-edits 'error) - (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays - (y-or-n-p "Display invisible properties in this buffer? ")) - (org-toggle-custom-properties-visibility) - ;; Make the area visible - (save-excursion - (if invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (show-subtree)) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) + (when (and org-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (or (get-char-property (point) 'invisible) + (get-char-property (max (point-min) (1- (point))) 'invisible))) + ;; OK, we need to take a closer look + (let* ((invisible-at-point (get-char-property (point) 'invisible)) + (invisible-before-point (unless (bobp) (get-char-property + (1- (point)) 'invisible))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible text + (and invisible-at-point (not invisible-before-point) + (memq kind '(insert delete-backward))) + ;; Check if we are acting predictably after invisible text + ;; This works not well, and I have turned it off. It seems + ;; better to always show and stop after invisible text. + ;; (and (not invisible-at-point) invisible-before-point + ;; (memq kind '(insert delete))) + ))) + (when (or (memq invisible-at-point '(outline org-hide-block t)) + (memq invisible-before-point '(outline org-hide-block t))) + (when (eq org-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (when invisible-before-point + (goto-char (previous-single-char-property-change + (point) 'invisible))) + (outline-show-subtree)) + (cond + ((eq org-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) (defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) + "Align tags in headline at point. +Unlike to `org-set-tags', it ignores region and sorting." + (when (and (eq (char-after (line-beginning-position)) ?*) ;short-circuit (org-at-heading-p)) - (org-align-tags-here org-tags-column))) + (let ((org-ignore-region t) + (org-tags-sort-function nil)) + (org-set-tags nil t)))) (defun org-delete-backward-char (N) "Like `delete-backward-char', insert whitespace at field end in tables. @@ -19546,7 +20257,7 @@ because, in this case the deletion might narrow the column." (interactive "p") (save-match-data (org-check-before-invisible-edit 'delete-backward) - (if (and (org-table-p) + (if (and (org-at-table-p) (eq N 1) (string-match "|" (buffer-substring (point-at-bol) (point))) (looking-at ".*?|")) @@ -19554,14 +20265,13 @@ because, in this case the deletion might narrow the column." (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) (backward-delete-char N) - (if (not overwrite-mode) - (progn - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)))) + (unless overwrite-mode + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos))) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) + (when noalign (setq org-table-may-need-update c))) (backward-delete-char N) (org-fix-tags-on-the-fly)))) @@ -19574,7 +20284,7 @@ because, in this case the deletion might narrow the column." (interactive "p") (save-match-data (org-check-before-invisible-edit 'delete) - (if (and (org-table-p) + (if (and (org-at-table-p) (not (bolp)) (not (= (char-after) ?|)) (eq N 1)) @@ -19587,12 +20297,12 @@ because, in this case the deletion might narrow the column." (goto-char pos) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) + (when noalign (setq org-table-may-need-update c))) (delete-char N)) (delete-char N) (org-fix-tags-on-the-fly)))) -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode +;; Make `delete-selection-mode' work with Org mode and Orgtbl mode (put 'org-self-insert-command 'delete-selection (lambda () (not (run-hook-with-args-until-success @@ -19611,7 +20321,7 @@ because, in this case the deletion might narrow the column." (put 'org-delete-char 'flyspell-delayed t) (put 'org-delete-backward-char 'flyspell-delayed t) -;; Make pabbrev-mode expand after org-mode commands +;; Make pabbrev-mode expand after Org mode commands (put 'org-self-insert-command 'pabbrev-expand-after-command t) (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) @@ -19621,9 +20331,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." (let (new old) (while commands (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) + (org-defkey map (vector 'remap old) new)))) (defun org-transpose-words () "Transpose words for Org. @@ -19765,7 +20473,7 @@ See `org-ctrl-c-ctrl-c-hook' for more information.") (defun org-shiftselect-error () "Throw an error because Shift-Cursor command was applied in wrong context." (if (and (boundp 'shift-select-mode) shift-select-mode) - (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (user-error "To use shift-selection with Org mode, customize `org-support-shift-select'") (user-error "This command works only in special context like headlines or timestamps"))) (defun org-call-for-shift-select (cmd) @@ -19820,32 +20528,30 @@ individual commands for more information." (call-interactively 'org-indent-item-tree)) (t (org-modifier-cursor-error)))) -(defun org-shiftmetaup (&optional arg) - "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' or `org-timestamp-up', depending on context. -See the individual commands for more information." +(defun org-shiftmetaup (&optional _arg) + "Drag the line at point up. +In a table, kill the current row. +On a clock timestamp, update the value of the timestamp like `S-' +but also adjust the previous clocked item in the clock history. +Everywhere else, drag the line at point up." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) ((org-at-table-p) (call-interactively 'org-table-kill-row)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-up))) (t (call-interactively 'org-drag-line-backward)))) -(defun org-shiftmetadown (&optional arg) - "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down' or `org-timestamp-up', depending on context. -See the individual commands for more information." +(defun org-shiftmetadown (&optional _arg) + "Drag the line at point down. +In a table, insert an empty row at the current line. +On a clock timestamp, update the value of the timestamp like `S-' +but also adjust the previous clocked item in the clock history. +Everywhere else, drag the line at point down." (interactive "P") (cond ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) ((org-at-table-p) (call-interactively 'org-table-insert-row)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) (call-interactively 'org-timestamp-down))) (t (call-interactively 'org-drag-line-forward)))) @@ -19854,11 +20560,16 @@ See the individual commands for more information." (user-error "Hidden subtree, open with TAB or use subtree command M-S-/")) -(defun org-metaleft (&optional arg) - "Promote heading or move table column to left. -Calls `org-do-promote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `backward-word'. -See the individual commands for more information." +(defun org-metaleft (&optional _arg) + "Promote heading, list item at point or move table column left. + +Calls `org-do-promote', `org-outdent-item' or `org-table-move-column', +depending on context. With no specific context, calls the Emacs +default `backward-word'. See the individual commands for more +information. + +This function runs the hook `org-metaleft-hook' as a first step, +and returns at first non-nil value." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaleft-hook)) @@ -19883,11 +20594,18 @@ See the individual commands for more information." (call-interactively 'org-outdent-item)) (t (call-interactively 'backward-word)))) -(defun org-metaright (&optional arg) - "Demote a subtree, a list item or move table column to right. +(defun org-metaright (&optional _arg) + "Demote heading, list item at point or move table column right. + In front of a drawer or a block keyword, indent it correctly. + +Calls `org-do-demote', `org-indent-item', `org-table-move-column', +`org-indent-drawer' or `org-indent-block' depending on context. With no specific context, calls the Emacs default `forward-word'. -See the individual commands for more information." +See the individual commands for more information. + +This function runs the hook `org-metaright-hook' as a first step, +and returns at first non-nil value." (interactive "P") (cond ((run-hook-with-args-until-success 'org-metaright-hook)) @@ -19937,11 +20655,11 @@ this function returns t, nil otherwise." (goto-char (point-at-eol)) (setq end (max end (point))) (while (re-search-forward re end t) - (if (get-char-property (match-beginning 0) 'invisible) - (throw 'exit t)))) + (when (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) nil)))) -(defun org-metaup (&optional arg) +(defun org-metaup (&optional _arg) "Move subtree up or move table row up. Calls `org-move-subtree-up' or `org-table-move-row' or `org-move-item-up', depending on context. See the individual commands @@ -19963,7 +20681,7 @@ for more information." ((org-at-item-p) (call-interactively 'org-move-item-up)) (t (org-drag-element-backward)))) -(defun org-metadown (&optional arg) +(defun org-metadown (&optional _arg) "Move subtree down or move table row down. Calls `org-move-subtree-down' or `org-table-move-row' or `org-move-item-down', depending on context. See the individual @@ -20149,6 +20867,32 @@ Optional argument N tells to change by that many units." (org-clock-timestamps-down n)) (user-error "Not at a clock log"))) +(defun org-increase-number-at-point (&optional inc) + "Increment the number at point. +With an optional prefix numeric argument INC, increment using +this numeric value." + (interactive "p") + (if (not (number-at-point)) + (user-error "Not on a number") + (unless inc (setq inc 1)) + (let ((pos (point)) + (beg (skip-chars-backward "-+^/*0-9eE.")) + (end (skip-chars-forward "-+^/*0-9eE^.")) nap) + (setq nap (buffer-substring-no-properties + (+ pos beg) (+ pos beg end))) + (delete-region (+ pos beg) (+ pos beg end)) + (insert (calc-eval (concat (number-to-string inc) "+" nap)))) + (when (org-at-table-p) + (org-table-align) + (org-table-end-of-field 1)))) + +(defun org-decrease-number-at-point (&optional inc) + "Decrement the number at point. +With an optional prefix numeric argument INC, decrement using +this numeric value." + (interactive "p") + (org-increase-number-at-point (- (or inc 1)))) + (defun org-ctrl-c-ret () "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." (interactive) @@ -20183,19 +20927,19 @@ Optional argument N tells to change by that many units." (defun org-copy-special () "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." +Calls `org-table-copy-region' or `org-copy-subtree', depending on +context. See the individual commands for more information." (interactive) (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) + (if (org-at-table-p) #'org-table-copy-region #'org-copy-subtree))) (defun org-cut-special () "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." +Calls `org-table-cut-region' or `org-cut-subtree', depending on +context. See the individual commands for more information." (interactive) (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) + (if (org-at-table-p) #'org-table-cut-region #'org-cut-subtree))) (defun org-paste-special (arg) "Paste rectangular region into table, or past subtree relative to level. @@ -20206,57 +20950,65 @@ See the individual commands for more information." (org-table-paste-rectangle) (org-paste-subtree arg))) -(defsubst org-in-fixed-width-region-p () - "Is point in a fixed-width region?" - (save-match-data - (eq 'fixed-width (org-element-type (org-element-at-point))))) - (defun org-edit-special (&optional arg) "Call a special editor for the element at point. When at a table, call the formula editor with `org-table-edit-formulas'. When in a source code block, call `org-edit-src-code'. When in a fixed-width region, call `org-edit-fixed-width-region'. +When in an export block, call `org-edit-export-block'. When at an #+INCLUDE keyword, visit the included file. +When at a footnote reference, call `org-edit-footnote-reference' On a link, call `ffap' to visit the link at point. Otherwise, return a user error." (interactive "P") (let ((element (org-element-at-point))) - (assert (not buffer-read-only) nil - "Buffer is read-only: %s" (buffer-name)) - (case (org-element-type element) - (src-block + (barf-if-buffer-read-only) + (pcase (org-element-type element) + (`src-block (if (not arg) (org-edit-src-code) - (let* ((info (org-babel-get-src-block-info)) - (lang (nth 0 info)) - (params (nth 2 info)) - (session (cdr (assq :session params)))) - (if (not session) (org-edit-src-code) - ;; At a src-block with a session and function called with - ;; an ARG: switch to the buffer related to the inferior - ;; process. - (switch-to-buffer + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assq :session params)))) + (if (not session) (org-edit-src-code) + ;; At a src-block with a session and function called with + ;; an ARG: switch to the buffer related to the inferior + ;; process. + (switch-to-buffer (funcall (intern (concat "org-babel-prep-session:" lang)) session params)))))) - (keyword + (`keyword (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) - (find-file - (org-remove-double-quotes - (car (org-split-string (org-element-property :value element))))) + (org-open-link-from-string + (format "[[%s]]" + (expand-file-name + (let ((value (org-element-property :value element))) + (cond ((not (org-string-nw-p value)) + (user-error "No file to edit")) + ((string-match "\\`\"\\(.*?\\)\"" value) + (match-string 1 value)) + ((string-match "\\`[^ \t\"]\\S-*" value) + (match-string 0 value)) + (t (user-error "No valid file specified"))))))) (user-error "No special environment to edit here"))) - (table + (`table (if (eq (org-element-property :type element) 'table.el) - (org-edit-src-code) + (org-edit-table.el) (call-interactively 'org-table-edit-formulas))) ;; Only Org tables contain `table-row' type elements. - (table-row (call-interactively 'org-table-edit-formulas)) - ((example-block export-block) (org-edit-src-code)) - (fixed-width (org-edit-fixed-width-region)) - (otherwise - ;; No notable element at point. Though, we may be at a link, - ;; which is an object. Thus, scan deeper. - (if (eq (org-element-type (org-element-context element)) 'link) - (call-interactively 'ffap) - (user-error "No special environment to edit here")))))) + (`table-row (call-interactively 'org-table-edit-formulas)) + (`example-block (org-edit-src-code)) + (`export-block (org-edit-export-block)) + (`fixed-width (org-edit-fixed-width-region)) + (_ + ;; No notable element at point. Though, we may be at a link or + ;; a footnote reference, which are objects. Thus, scan deeper. + (let ((context (org-element-context element))) + (pcase (org-element-type context) + (`footnote-reference (org-edit-footnote-reference)) + (`inline-src-block (org-edit-inline-src-code)) + (`link (call-interactively #'ffap)) + (_ (user-error "No special environment to edit here")))))))) (defvar org-table-coordinate-overlays) ; defined in org-table.el (defun org-ctrl-c-ctrl-c (&optional arg) @@ -20305,240 +21057,314 @@ This command does many different things, depending on context: inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." (interactive "P") (cond - ((or (and (boundp 'org-clock-overlays) org-clock-overlays) - org-occur-highlights - org-latex-fragment-image-overlays) - (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) + ((or (bound-and-true-p org-clock-overlays) org-occur-highlights) + (when (boundp 'org-clock-overlays) (org-clock-remove-overlays)) (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) + ((and (local-variable-p 'org-finish-function) (fboundp org-finish-function)) (funcall org-finish-function)) + ((org-babel-hash-at-point)) ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) (t - (let* ((context (org-element-context)) (type (org-element-type context))) - ;; Test if point is within a blank line. - (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error "C-c C-c can do nothing useful at this location")) - (case type - ;; When at a link, act according to the parent instead. - (link (setq context (org-element-property :parent context)) - (setq type (org-element-type context))) - ;; Unsupported object types: refer to the first supported - ;; element or object containing it. - ((bold code entity export-snippet inline-babel-call inline-src-block - italic latex-fragment line-break macro strike-through subscript - superscript underline verbatim) - (while (and (setq context (org-element-property :parent context)) - (not (memq (setq type (org-element-type context)) - '(radio-target paragraph verse-block - table-cell))))))) - ;; For convenience: at the first line of a paragraph on the - ;; same line as an item, apply function on that item instead. - (when (eq type 'paragraph) - (let ((parent (org-element-property :parent context))) - (when (and (eq (org-element-type parent) 'item) - (= (point-at-bol) (org-element-property :begin parent))) - (setq context parent type 'item)))) - ;; Act according to type of element or object at point. - (case type - (clock (org-clock-update-time-maybe)) - (dynamic-block - (save-excursion - (goto-char (org-element-property :post-affiliated context)) - (org-update-dblock))) - (footnote-definition + (let* ((context + (org-element-lineage + (org-element-context) + ;; Limit to supported contexts. + '(babel-call clock dynamic-block footnote-definition + footnote-reference inline-babel-call inline-src-block + inlinetask item keyword node-property paragraph + plain-list property-drawer radio-target src-block + statistics-cookie table table-cell table-row + timestamp) + t)) + (type (org-element-type context))) + ;; For convenience: at the first line of a paragraph on the same + ;; line as an item, apply function on that item instead. + (when (eq type 'paragraph) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'item) + (= (line-beginning-position) + (org-element-property :begin parent))) + (setq context parent) + (setq type 'item)))) + ;; Act according to type of element or object at point. + ;; + ;; Do nothing on a blank line, except if it is contained in + ;; a src block. Hence, we first check if point is in such + ;; a block and then if it is at a blank line. + (pcase type + ((or `inline-src-block `src-block) + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block + current-prefix-arg (org-babel-get-src-block-info nil context)))) + ((guard (org-match-line "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + (substitute-command-keys + "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) + ((or `babel-call `inline-babel-call) + (let ((info (org-babel-lob-get-info context))) + (when info (org-babel-execute-src-block nil info)))) + (`clock (org-clock-update-time-maybe)) + (`dynamic-block + (save-excursion (goto-char (org-element-property :post-affiliated context)) - (call-interactively 'org-footnote-action)) - (footnote-reference (call-interactively 'org-footnote-action)) - ((headline inlinetask) - (save-excursion (goto-char (org-element-property :begin context)) - (call-interactively 'org-set-tags))) - (item - ;; At an item: a double C-u set checkbox to "[-]" - ;; unconditionally, whereas a single one will toggle its - ;; presence. Without a universal argument, if the item - ;; has a checkbox, toggle it. Otherwise repair the list. - (let* ((box (org-element-property :checkbox context)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) - (org-list-set-checkbox - (org-element-property :begin context) struct - (cond ((equal arg '(16)) "[-]") - ((and (not box) (equal arg '(4))) "[ ]") - ((or (not box) (equal arg '(4))) nil) - ((eq box 'on) "[ ]") - (t "[X]"))) - ;; Mimic `org-list-write-struct' but with grabbing - ;; a return value from `org-list-struct-fix-box'. - (org-list-struct-fix-ind struct parents 2) - (org-list-struct-fix-item-end struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (let ((block-item - (org-list-struct-fix-box struct parents prevs orderedp))) - (if (and box (equal struct old-struct)) - (if (equal arg '(16)) - (message "Checkboxes already reset") - (user-error "Cannot toggle this checkbox: %s" - (if (eq box 'on) - "all subitems checked" - "unchecked subitems"))) - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe)) - (when block-item - (message "Checkboxes were removed due to empty box at line %d" - (org-current-line block-item)))))) - (keyword - (let ((org-inhibit-startup-visibility-stuff t) - (org-startup-align-all-tables nil)) - (when (boundp 'org-table-coordinate-overlays) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil)) - (org-save-outline-visibility 'use-markers (org-mode-restart))) - (message "Local setup has been refreshed")) - (plain-list - ;; At a plain list, with a double C-u argument, set - ;; checkboxes of each item to "[-]", whereas a single one - ;; will toggle their presence according to the state of the - ;; first item in the list. Without an argument, repair the - ;; list. - (let* ((begin (org-element-property :contents-begin context)) - (beginm (move-marker (make-marker) begin)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (first-box (save-excursion - (goto-char begin) - (looking-at org-list-full-item-re) - (match-string-no-properties 3))) - (new-box (cond ((equal arg '(16)) "[-]") - ((equal arg '(4)) (unless first-box "[ ]")) - ((equal first-box "[X]") "[ ]") - (t "[X]")))) - (cond - (arg - (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) - (org-list-get-all-items - begin struct (org-list-prevs-alist struct)))) - ((and first-box (eq (point) begin)) - ;; For convenience, when point is at bol on the first - ;; item of the list and no argument is provided, simply - ;; toggle checkbox of that item, if any. - (org-list-set-checkbox begin struct new-box))) - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - (org-update-checkbox-count-maybe) - (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) - ((property-drawer node-property) - (call-interactively 'org-property-action)) - ((radio-target target) - (call-interactively 'org-update-radio-target-regexp)) - (statistics-cookie - (call-interactively 'org-update-statistics-cookies)) - ((table table-cell table-row) - ;; At a table, recalculate every field and align it. Also - ;; send the table if necessary. If the table has - ;; a `table.el' type, just give up. At a table row or - ;; cell, maybe recalculate line but always align table. - (if (eq (org-element-property :type context) 'table.el) - (message "%s" "Use C-c ' to edit table.el tables") - (let ((org-enable-table-editor t)) - (if (or (eq type 'table) - ;; Check if point is at a TBLFM line. - (and (eq type 'table-row) - (= (point) (org-element-property :end context)))) - (save-excursion - (if (org-at-TBLFM-p) - (progn (require 'org-table) - (org-table-calc-current-TBLFM)) - (goto-char (org-element-property :contents-begin context)) - (org-call-with-arg 'org-table-recalculate (or arg t)) - (orgtbl-send-table 'maybe))) - (org-table-maybe-eval-formula) - (cond (arg (call-interactively 'org-table-recalculate)) - ((org-table-maybe-recalculate-line)) - (t (org-table-align))))))) - (timestamp (org-timestamp-change 0 'day)) - (otherwise - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error - "C-c C-c can do nothing useful at this location"))))))))) + (org-update-dblock))) + (`footnote-definition + (goto-char (org-element-property :post-affiliated context)) + (call-interactively 'org-footnote-action)) + (`footnote-reference (call-interactively #'org-footnote-action)) + ((or `headline `inlinetask) + (save-excursion (goto-char (org-element-property :begin context)) + (call-interactively #'org-set-tags))) + (`item + ;; At an item: `C-u C-u' sets checkbox to "[-]" + ;; unconditionally, whereas `C-u' will toggle its presence. + ;; Without a universal argument, if the item has a checkbox, + ;; toggle it. Otherwise repair the list. + (let* ((box (org-element-property :checkbox context)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) + (org-list-set-checkbox + (org-element-property :begin context) struct + (cond ((equal arg '(16)) "[-]") + ((and (not box) (equal arg '(4))) "[ ]") + ((or (not box) (equal arg '(4))) nil) + ((eq box 'on) "[ ]") + (t "[X]"))) + ;; Mimic `org-list-write-struct' but with grabbing a return + ;; value from `org-list-struct-fix-box'. + (org-list-struct-fix-ind struct parents 2) + (org-list-struct-fix-item-end struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (let ((block-item + (org-list-struct-fix-box struct parents prevs orderedp))) + (if (and box (equal struct old-struct)) + (if (equal arg '(16)) + (message "Checkboxes already reset") + (user-error "Cannot toggle this checkbox: %s" + (if (eq box 'on) + "all subitems checked" + "unchecked subitems"))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) + (when block-item + (message "Checkboxes were removed due to empty box at line %d" + (org-current-line block-item)))))) + (`keyword + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (when (boundp 'org-table-coordinate-overlays) + (mapc #'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) + (message "Local setup has been refreshed")) + (`plain-list + ;; At a plain list, with a double C-u argument, set + ;; checkboxes of each item to "[-]", whereas a single one + ;; will toggle their presence according to the state of the + ;; first item in the list. Without an argument, repair the + ;; list. + (let* ((begin (org-element-property :contents-begin context)) + (beginm (move-marker (make-marker) begin)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (first-box (save-excursion + (goto-char begin) + (looking-at org-list-full-item-re) + (match-string-no-properties 3))) + (new-box (cond ((equal arg '(16)) "[-]") + ((equal arg '(4)) (unless first-box "[ ]")) + ((equal first-box "[X]") "[ ]") + (t "[X]")))) + (cond + (arg + (dolist (pos + (org-list-get-all-items + begin struct (org-list-prevs-alist struct))) + (org-list-set-checkbox pos struct new-box))) + ((and first-box (eq (point) begin)) + ;; For convenience, when point is at bol on the first + ;; item of the list and no argument is provided, simply + ;; toggle checkbox of that item, if any. + (org-list-set-checkbox begin struct new-box))) + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + (org-update-checkbox-count-maybe) + (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) + ((or `property-drawer `node-property) + (call-interactively #'org-property-action)) + (`radio-target + (call-interactively #'org-update-radio-target-regexp)) + (`statistics-cookie + (call-interactively #'org-update-statistics-cookies)) + ((or `table `table-cell `table-row) + ;; At a table, recalculate every field and align it. Also + ;; send the table if necessary. If the table has + ;; a `table.el' type, just give up. At a table row or cell, + ;; maybe recalculate line but always align table. + (if (eq (org-element-property :type context) 'table.el) + (message "%s" (substitute-command-keys "\\\ +Use `\\[org-edit-special]' to edit table.el tables")) + (let ((org-enable-table-editor t)) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) + (progn (require 'org-table) + (org-table-calc-current-TBLFM)) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively #'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align))))))) + (`timestamp (org-timestamp-change 0 'day)) + ((and `nil (guard (org-at-heading-p))) + ;; When point is on an unsupported object type, we can miss + ;; the fact that it also is at a heading. Handle it here. + (call-interactively #'org-set-tags)) + ((guard + (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook))) + (_ + (user-error + (substitute-command-keys + "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))))))) (defun org-mode-restart () (interactive) - (let ((indent-status (org-bound-and-true-p org-indent-mode))) + (let ((indent-status (bound-and-true-p org-indent-mode))) (funcall major-mode) (hack-local-variables) - (when (and indent-status (not (org-bound-and-true-p org-indent-mode))) + (when (and indent-status (not (bound-and-true-p org-indent-mode))) (org-indent-mode -1))) (message "%s restarted" major-mode)) (defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." + "Abort storing current note, or call `outline-show-branches'." (interactive) (if (not org-finish-function) (progn - (hide-subtree) - (call-interactively 'show-branches)) + (outline-hide-subtree) + (call-interactively 'outline-show-branches)) (let ((org-note-abort t)) (funcall org-finish-function)))) +(defun org-delete-indentation (&optional arg) + "Join current line to previous and fix whitespace at join. + +If previous line is a headline add to headline title. Otherwise +the function calls `delete-indentation'. + +With a non-nil optional argument, join it to the following one." + (interactive "*P") + (if (save-excursion + (beginning-of-line (if arg 1 0)) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp))) + ;; At headline. + (let ((tags-column (when (match-beginning 5) + (save-excursion (goto-char (match-beginning 5)) + (current-column)))) + (string (concat " " (progn (when arg (forward-line 1)) + (org-trim (delete-and-extract-region + (line-beginning-position) + (line-end-position))))))) + (unless (bobp) (delete-region (point) (1- (point)))) + (goto-char (or (match-end 4) + (match-beginning 5) + (match-end 0))) + (skip-chars-backward " \t") + (save-excursion (insert string)) + ;; Adjust alignment of tags. + (cond + ((not tags-column)) ;no tags + (org-auto-align-tags (org-set-tags nil t)) + (t (org--align-tags-here tags-column)))) ;preserve tags column + (delete-indentation arg))) + (defun org-open-line (n) "Insert a new row in tables, call `open-line' elsewhere. -If `org-special-ctrl-o' is nil, just call `open-line' everywhere." +If `org-special-ctrl-o' is nil, just call `open-line' everywhere. +As a special case, when a document starts with a table, allow to +call `open-line' on the very first character." (interactive "*p") - (cond - ((not org-special-ctrl-o) - (open-line n)) - ((org-at-table-p) - (org-table-insert-row)) - (t - (open-line n)))) + (if (and org-special-ctrl-o (/= (point) 1) (org-at-table-p)) + (org-table-insert-row) + (open-line n))) (defun org-return (&optional indent) "Goto next table row or insert a newline. + Calls `org-table-next-row' or `newline', depending on context. -See the individual commands for more information." + +When optional INDENT argument is non-nil, call +`newline-and-indent' instead of `newline'. + +When `org-return-follows-link' is non-nil and point is on +a timestamp or a link, call `org-open-at-point'. However, it +will not happen if point is in a table or on a \"dead\" +object (e.g., within a comment). In these case, you need to use +`org-open-at-point' directly." (interactive) - (let (org-ts-what) + (let ((context (if org-return-follows-link (org-element-context) + (org-element-at-point)))) (cond - ((or (bobp) (org-in-src-block-p)) - (if indent (newline-and-indent) (newline))) - ((org-at-table-p) + ;; In a table, call `org-table-next-row'. + ((or (and (eq (org-element-type context) 'table) + (>= (point) (org-element-property :contents-begin context)) + (< (point) (org-element-property :contents-end context))) + (org-element-lineage context '(table-row table-cell) t)) (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - ;; when `newline-and-indent' is called within a list, make sure - ;; text moved stays inside the item. - ((and (org-in-item-p) indent) - (if (and (org-at-item-p) (>= (point) (match-end 0))) - (progn - (save-match-data (newline)) - (org-indent-line-to (length (match-string 0)))) - (let ((ind (org-get-indentation))) - (newline) - (if (org-looking-back org-list-end-re) - (org-indent-line) - (org-indent-line-to ind))))) - ((and org-return-follows-link - (org-at-timestamp-p t) - (not (eq org-ts-what 'after))) - (org-follow-timestamp-link)) + (call-interactively #'org-table-next-row)) + ;; On a link or a timestamp, call `org-open-at-point' if + ;; `org-return-follows-link' allows it. Tolerate fuzzy + ;; locations, e.g., in a comment, as `org-open-at-point'. ((and org-return-follows-link - (let ((tprop (get-text-property (point) 'face))) - (or (eq tprop 'org-link) - (and (listp tprop) (memq 'org-link tprop))))) - (call-interactively 'org-open-at-point)) - ((and (org-at-heading-p) - (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) - (org-show-entry) - (end-of-line 1) - (newline)) + (or (org-in-regexp org-ts-regexp-both nil t) + (org-in-regexp org-tsr-regexp-both nil t) + (org-in-regexp org-any-link-re nil t))) + (call-interactively #'org-open-at-point)) + ;; Insert newline in heading, but preserve tags. + ((and (not (bolp)) + (save-excursion (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) + ;; At headline. Split line. However, if point is on keyword, + ;; priority cookie or tags, do not break any of them: add + ;; a newline after the headline instead. + (let ((tags-column (and (match-beginning 5) + (save-excursion (goto-char (match-beginning 5)) + (current-column)))) + (string + (when (and (match-end 4) (org-point-in-group (point) 4)) + (delete-and-extract-region (point) (match-end 4))))) + ;; Adjust tag alignment. + (cond + ((not (and tags-column string))) + (org-auto-align-tags (org-set-tags nil t)) + (t (org--align-tags-here tags-column))) ;preserve tags column + (end-of-line) + (org-show-entry) + (if indent (newline-and-indent) (newline)) + (when string (save-excursion (insert (org-trim string)))))) + ;; In a list, make sure indenting keeps trailing text within. + ((and indent + (not (eolp)) + (org-element-lineage context '(item))) + (let ((trailing-data + (delete-and-extract-region (point) (line-end-position)))) + (newline-and-indent) + (save-excursion (insert trailing-data)))) (t (if indent (newline-and-indent) (newline)))))) (defun org-return-indent () @@ -20571,146 +21397,16 @@ Calls `org-table-insert-hline', `org-toggle-item', or (call-interactively 'org-table-insert-hline)) ((org-region-active-p) (call-interactively 'org-toggle-item)) - ((org-in-item-p) - (call-interactively 'org-cycle-list-bullet)) - (t - (call-interactively 'org-toggle-item)))) - -(defun org-toggle-item (arg) - "Convert headings or normal lines to items, items to normal lines. -If there is no active region, only the current line is considered. - -If the first non blank line in the region is a headline, convert -all headlines to items, shifting text accordingly. - -If it is an item, convert all items to normal lines. - -If it is normal text, change region into a list of items. -With a prefix argument ARG, change the region in a single item." - (interactive "P") - (let ((shift-text - (function - ;; Shift text in current section to IND, from point to END. - ;; The function leaves point to END line. - (lambda (ind end) - (let ((min-i 1000) (end (copy-marker end))) - ;; First determine the minimum indentation (MIN-I) of - ;; the text. - (save-excursion - (catch 'exit - (while (< (point) end) - (let ((i (org-get-indentation))) - (cond - ;; Skip blank lines and inline tasks. - ((looking-at "^[ \t]*$")) - ((looking-at org-outline-regexp-bol)) - ;; We can't find less than 0 indentation. - ((zerop i) (throw 'exit (setq min-i 0))) - ((< i min-i) (setq min-i i)))) - (forward-line)))) - ;; Then indent each line so that a line indented to - ;; MIN-I becomes indented to IND. Ignore blank lines - ;; and inline tasks in the process. - (let ((delta (- ind min-i))) - (while (< (point) end) - (unless (or (looking-at "^[ \t]*$") - (looking-at org-outline-regexp-bol)) - (org-indent-line-to (+ (org-get-indentation) delta))) - (forward-line))))))) - (skip-blanks - (function - ;; Return beginning of first non-blank line, starting from - ;; line at POS. - (lambda (pos) - (save-excursion - (goto-char pos) - (skip-chars-forward " \r\t\n") - (point-at-bol))))) - beg end) - ;; Determine boundaries of changes. - (if (org-region-active-p) - (setq beg (funcall skip-blanks (region-beginning)) - end (copy-marker (region-end))) - (setq beg (funcall skip-blanks (point-at-bol)) - end (copy-marker (point-at-eol)))) - ;; Depending on the starting line, choose an action on the text - ;; between BEG and END. - (org-with-limited-levels - (save-excursion - (goto-char beg) - (cond - ;; Case 1. Start at an item: de-itemize. Note that it only - ;; happens when a region is active: `org-ctrl-c-minus' - ;; would call `org-cycle-list-bullet' otherwise. - ((org-at-item-p) - (while (< (point) end) - (when (org-at-item-p) - (skip-chars-forward " \t") - (delete-region (point) (match-end 0))) - (forward-line))) - ;; Case 2. Start at an heading: convert to items. - ((org-at-heading-p) - (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - ;; Indentation of the first heading. It should be - ;; relative to the indentation of its parent, if any. - (start-ind (save-excursion - (cond - ((not org-adapt-indentation) 0) - ((not (outline-previous-heading)) 0) - (t (length (match-string 0)))))) - ;; Level of first heading. Further headings will be - ;; compared to it to determine hierarchy in the list. - (ref-level (org-reduced-level (org-outline-level)))) - (while (< (point) end) - (let* ((level (org-reduced-level (org-outline-level))) - (delta (max 0 (- level ref-level)))) - ;; If current headline is less indented than the first - ;; one, set it as reference, in order to preserve - ;; subtrees. - (when (< level ref-level) (setq ref-level level)) - (replace-match bul t t) - (org-indent-line-to (+ start-ind (* delta bul-len))) - ;; Ensure all text down to END (or SECTION-END) belongs - ;; to the newly created item. - (let ((section-end (save-excursion - (or (outline-next-heading) (point))))) - (forward-line) - (funcall shift-text - (+ start-ind (* (1+ delta) bul-len)) - (min end section-end))))))) - ;; Case 3. Normal line with ARG: make the first line of region - ;; an item, and shift indentation of others lines to - ;; set them as item's body. - (arg (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - (ref-ind (org-get-indentation))) - (skip-chars-forward " \t") - (insert bul) - (forward-line) - (while (< (point) end) - ;; Ensure that lines less indented than first one - ;; still get included in item body. - (funcall shift-text - (+ ref-ind bul-len) - (min end (save-excursion (or (outline-next-heading) - (point))))) - (forward-line)))) - ;; Case 4. Normal line without ARG: turn each non-item line - ;; into an item. - (t - (while (< (point) end) - (unless (or (org-at-heading-p) (org-at-item-p)) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (forward-line)))))))) + ((org-in-item-p) + (call-interactively 'org-cycle-list-bullet)) + (t + (call-interactively 'org-toggle-item)))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. If there is no active region, only convert the current line. -With a \\[universal-argument] prefix, convert the whole list at +With a `\\[universal-argument]' prefix, convert the whole list at point into heading. In a region: @@ -20746,7 +21442,7 @@ number of stars to add." ;; do not consider the last line to be in the region. (when (and current-prefix-arg (org-at-item-p)) - (if (listp current-prefix-arg) (setq current-prefix-arg 1)) + (when (listp current-prefix-arg) (setq current-prefix-arg 1)) (org-mark-element)) (if (org-region-active-p) @@ -20771,31 +21467,17 @@ number of stars to add." ;; Case 2. Started at an item: change items into headlines. ;; One star will be added by `org-list-to-subtree'. ((org-at-item-p) - (let* ((stars (make-string - ;; subtract the star that will be added again by - ;; `org-list-to-subtree' - (if (numberp nstars) (1- nstars) - (or (org-current-level) 0)) - ?*)) - (add-stars - (cond (nstars "") ; stars from prefix only - ((equal stars "") "") ; before first heading - (org-odd-levels-only "*") ; inside heading, odd - (t "")))) ; inside heading, oddeven - (while (< (point) end) - (when (org-at-item-p) - ;; Pay attention to cases when region ends before list. - (let* ((struct (org-list-struct)) - (list-end (min (org-list-get-bottom-point struct) (1+ end)))) - (save-restriction - (narrow-to-region (point) list-end) - (insert - (org-list-to-subtree - (org-list-parse-list t) - `(:istart (concat ',stars ',add-stars (funcall get-stars depth)) - :icount (concat ',stars ',add-stars (funcall get-stars depth))))))) - (setq toggled t)) - (forward-line)))) + (while (< (point) end) + (when (org-at-item-p) + ;; Pay attention to cases when region ends before list. + (let* ((struct (org-list-struct)) + (list-end + (min (org-list-get-bottom-point struct) (1+ end)))) + (save-restriction + (narrow-to-region (point) list-end) + (insert (org-list-to-subtree (org-list-to-lisp t)) "\n"))) + (setq toggled t)) + (forward-line))) ;; Case 3. Started at normal text: make every line an heading, ;; skipping headlines and items. (t (let* ((stars @@ -20807,7 +21489,7 @@ number of stars to add." (org-odd-levels-only "**") ; inside heading, odd (t "*"))) ; inside heading, oddeven (rpl (concat stars add-stars " ")) - (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) + (lend (when (listp nstars) (save-excursion (end-of-line) (point))))) (while (< (point) (if (equal nstars '(4)) lend end)) (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) (looking-at "\\([ \t]*\\)\\(\\S-\\)")) @@ -20822,17 +21504,8 @@ on context. See the individual commands for more information." (interactive) (org-check-before-invisible-edit 'insert) (or (run-hook-with-args-until-success 'org-metareturn-hook) - (let* ((element (org-element-at-point)) - (type (org-element-type element))) - (when (eq type 'table-row) - (setq element (org-element-property :parent element)) - (setq type 'table)) - (if (and (eq type 'table) - (eq (org-element-property :type element) 'org) - (>= (point) (org-element-property :contents-begin element)) - (< (point) (org-element-property :contents-end element))) - (call-interactively 'org-table-wrap-region) - (call-interactively 'org-insert-heading))))) + (call-interactively (if (org-at-table-p) #'org-table-wrap-region + #'org-insert-heading)))) ;;; Menu entries @@ -20841,7 +21514,7 @@ on context. See the individual commands for more information." (and (not (org-before-first-heading-p)) (not (org-at-table-p)))) -;; Define the Org-mode menus +;; Define the Org mode menus (easy-menu-define org-tbl-menu org-mode-map "Tbl menu" '("Tbl" ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] @@ -20888,11 +21561,11 @@ on context. See the individual commands for more information." ["Which Column?" org-table-current-column (org-at-table-p)]) ["Debug Formulas" org-table-toggle-formula-debugger - :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] + :style toggle :selected (bound-and-true-p org-table-formula-debug)] ["Show Col/Row Numbers" org-table-toggle-coordinate-overlays :style toggle - :selected (org-bound-and-true-p org-table-overlay-coordinates)] + :selected (bound-and-true-p org-table-overlay-coordinates)] "--" ["Create" org-table-create (and (not (org-at-table-p)) org-enable-table-editor)] @@ -20900,7 +21573,11 @@ on context. See the individual commands for more information." ["Import from File" org-table-import (not (org-at-table-p))] ["Export to File" org-table-export (org-at-table-p)] "--" - ["Create/Convert from/to table.el" org-table-create-with-table.el t])) + ["Create/Convert from/to table.el" org-table-create-with-table.el t] + "--" + ("Plot" + ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"] + ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"]))) (easy-menu-define org-org-menu org-mode-map "Org menu" '("Org" @@ -20909,7 +21586,7 @@ on context. See the individual commands for more information." ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] ["Sparse Tree..." org-sparse-tree t] ["Reveal Context" org-reveal t] - ["Show All" show-all t] + ["Show All" outline-show-all t] "--" ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) "--" @@ -20925,8 +21602,8 @@ on context. See the individual commands for more information." ("Edit Structure" ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] "--" - ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)] - ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)] + ["Move Subtree Up" org-metaup (org-at-heading-p)] + ["Move Subtree Down" org-metadown (org-at-heading-p)] "--" ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] @@ -21012,7 +21689,7 @@ on context. See the individual commands for more information." "--" ["Set property" org-set-property (not (org-before-first-heading-p))] ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) + ["Insert Column View DBlock" org-columns-insert-dblock t]) ("Dates and Scheduling" ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] @@ -21073,9 +21750,7 @@ on context. See the individual commands for more information." ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] ["Modify math symbol" org-cdlatex-math-modify (org-inside-LaTeX-fragment-p)] - ["Insert citation" org-reftex-citation t] - "--" - ["Template for BEAMER" (org-beamer-insert-options-template) t]) + ["Insert citation" org-reftex-citation t]) "--" ("MobileOrg" ["Push Files and Views" org-mobile-push t] @@ -21101,20 +21776,20 @@ on context. See the individual commands for more information." )) (defun org-info (&optional node) - "Read documentation for Org-mode in the info system. + "Read documentation for Org in the info system. With optional NODE, go directly to that node." (interactive) (info (format "(org)%s" (or node "")))) ;;;###autoload (defun org-submit-bug-report () - "Submit a bug report on Org-mode via mail. + "Submit a bug report on Org via mail. Don't hesitate to report any problems or inaccurate documentation. If you don't have setup sending mail from (X)Emacs, please copy the output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration." +information about your Org version and configuration." (interactive) (require 'reporter) (defvar reporter-prompt-for-summary-p) @@ -21126,12 +21801,12 @@ information about your Org-mode version and configuration." (org-version nil 'full) (let (list) (save-window-excursion - (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) + (pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) (delete-other-windows) (erase-buffer) - (insert "You are about to submit a bug report to the Org-mode mailing list. + (insert "You are about to submit a bug report to the Org mailing list. -We would like to add your full Org-mode and Outline configuration to the +We would like to add your full Org and Outline configuration to the bug report. This greatly simplifies the work of the maintainer and other experts on the mailing list. @@ -21141,7 +21816,7 @@ appear in the form of file names, tags, todo states, or search strings. If you answer yes to the prompt, you might want to check and remove such private information before sending the email.") (add-text-properties (point-min) (point-max) '(face org-warning)) - (when (yes-or-no-p "Include your Org-mode configuration ") + (when (yes-or-no-p "Include your Org configuration ") (mapatoms (lambda (v) (and (boundp v) @@ -21160,11 +21835,11 @@ what in fact did happen. You don't know how to make a good report? See http://orgmode.org/manual/Feedback.html#Feedback -Your bug report will be posted to the Org-mode mailing list. +Your bug report will be posted to the Org mailing list. ------------------------------------------------------------------------") (save-excursion - (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) - (replace-match "\\1Bug: \\3 [\\2]"))))) + (when (re-search-backward "^\\(Subject: \\)Org mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) + (replace-match "\\1Bug: \\3 [\\2]"))))) (defun org-install-agenda-files-menu () @@ -21172,7 +21847,7 @@ Your bug report will be posted to the Org-mode mailing list. (save-excursion (while bl (set-buffer (pop bl)) - (if (derived-mode-p 'org-mode) (setq bl nil))) + (when (derived-mode-p 'org-mode) (setq bl nil))) (when (derived-mode-p 'org-mode) (easy-menu-change '("Org") "File List for Agenda" @@ -21190,7 +21865,7 @@ Your bug report will be posted to the Org-mode mailing list. (defun org-require-autoloaded-modules () (interactive) - (mapc 'require + (mapc #'require '(org-agenda org-archive org-attach org-clock org-colview org-id org-table org-timer))) @@ -21203,13 +21878,8 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (let* ((org-dir (org-find-library-dir "org")) (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") - (remove-re (mapconcat 'identity - (mapcar (lambda (f) (concat "^" f "$")) - (list (if (featurep 'xemacs) - "org-colview" - "org-colview-xemacs") - "org" "org-loaddefs" "org-version")) - "\\|")) + (remove-re (format "\\`%s\\'" + (regexp-opt '("org" "org-loaddefs" "org-version")))) (feats (delete-dups (mapcar 'file-name-sans-extension (mapcar 'file-name-nondirectory @@ -21241,9 +21911,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." 't) f)) lfeat))) - (if load-uncore - (message "The following feature%s found in load-path, please check if that's correct:\n%s" - (if (> (length load-uncore) 1) "s were" " was") load-uncore)) + (when load-uncore + (message "The following feature%s found in load-path, please check if that's correct:\n%s" + (if (> (length load-uncore) 1) "s were" " was") load-uncore)) (if load-misses (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) @@ -21258,7 +21928,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (customize-browse 'org)) (defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." + "Create a full customization menu for Org mode, insert it into the menu." (interactive) (org-load-modules-maybe) (org-require-autoloaded-modules) @@ -21281,9 +21951,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." ;;; Generally useful functions -(defun org-get-at-bol (property) - "Get text property PROPERTY at beginning of line." - (get-text-property (point-at-bol) property)) +(defun org-get-at-eol (property n) + "Get text property PROPERTY at the end of line less N characters." + (get-text-property (- (point-at-eol) n) property)) (defun org-find-text-property-in-string (prop s) "Return the first non-nil value of property PROP in string S." @@ -21291,19 +21961,9 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (get-text-property (or (next-single-property-change 0 prop s) 0) prop s))) -(defun org-display-warning (message) ;; Copied from Emacs-Muse +(defun org-display-warning (message) "Display the given MESSAGE as a warning." - (if (fboundp 'display-warning) - (display-warning 'org message - (if (featurep 'xemacs) 'warning :warning)) - (let ((buf (get-buffer-create "*Org warnings*"))) - (with-current-buffer buf - (goto-char (point-max)) - (insert "Warning (Org): " message) - (unless (bolp) - (newline))) - (display-buffer buf) - (sit-for 0)))) + (display-warning 'org message :warning)) (defun org-eval (form) "Eval FORM and return result." @@ -21322,17 +21982,6 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (>= (match-end 0) pos) start)))) -(defun org-in-commented-line () - "Is point in a line starting with `#'?" - (equal (char-after (point-at-bol)) ?#)) - -(defun org-in-indented-comment-line () - "Is point in a line starting with `#' after some white space?" - (save-excursion - (save-match-data - (goto-char (point-at-bol)) - (looking-at "[ \t]*#")))) - (defun org-in-verbatim-emphasis () (save-match-data (and (org-in-regexp org-emph-re 2) @@ -21340,14 +21989,35 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (<= (point) (match-end 4)) (member (match-string 3) '("=" "~"))))) +(defun org-overlay-display (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (overlay-put ovl 'display text) + (if face (overlay-put ovl 'face face)) + (if evap (overlay-put ovl 'evaporate t))) + +(defun org-overlay-before-string (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (if face (org-add-props text nil 'face face)) + (overlay-put ovl 'before-string text) + (if evap (overlay-put ovl 'evaporate t))) + +(defun org-find-overlays (prop &optional pos delete) + "Find all overlays specifying PROP at POS or point. +If DELETE is non-nil, delete all those overlays." + (let (found) + (dolist (ov (overlays-at (or pos (point))) found) + (cond ((not (overlay-get ov prop))) + (delete (delete-overlay ov)) + (t (push ov found)))))) + (defun org-goto-marker-or-bmk (marker &optional bookmark) "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." (if (and marker (marker-buffer marker) (buffer-live-p (marker-buffer marker))) (progn - (org-pop-to-buffer-same-window (marker-buffer marker)) - (if (or (> marker (point-max)) (< marker (point-min))) - (widen)) + (pop-to-buffer-same-window (marker-buffer marker)) + (when (or (> marker (point-max)) (< marker (point-min))) + (widen)) (goto-char marker) (org-show-context 'org-goto)) (if bookmark @@ -21390,7 +22060,7 @@ upon the next fontification round." l)) (defun org-shorten-string (s maxlength) - "Shorten string S so tht it is no longer than MAXLENGTH characters. + "Shorten string S so that it is no longer than MAXLENGTH characters. If the string is shorter or has length MAXLENGTH, just return the original string. If it is longer, the functions finds a space in the string, breaks this string off at that locations and adds three dots @@ -21410,8 +22080,8 @@ if necessary." "Get the indentation of the current line, interpreting tabs. When LINE is given, assume it represents a line and compute its indentation." (if line - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) + (when (string-match "^ *" (org-remove-tabs line)) + (match-end 0)) (save-excursion (beginning-of-line 1) (skip-chars-forward " \t") @@ -21448,35 +22118,45 @@ leave it alone. If it is larger than ind, set it to the target." (let* ((l (org-remove-tabs line)) (i (org-get-indentation l)) (i1 (car ind)) (i2 (cdr ind))) - (if (>= i i2) (setq l (substring line i2))) + (when (>= i i2) (setq l (substring line i2))) (if (> i1 0) (concat (make-string i1 ?\ ) l) l))) (defun org-remove-indentation (code &optional n) - "Remove the maximum common indentation from the lines in CODE. -N may optionally be the number of spaces to remove." + "Remove maximum common indentation in string CODE and return it. +N may optionally be the number of columns to remove. Return CODE +as-is if removal failed." (with-temp-buffer (insert code) - (org-do-remove-indentation n) - (buffer-string))) + (if (org-do-remove-indentation n) (buffer-string) code))) (defun org-do-remove-indentation (&optional n) - "Remove the maximum common indentation from the buffer." - (untabify (point-min) (point-max)) - (let ((min 10000) re) - (if n - (setq min n) - (goto-char (point-min)) - (while (re-search-forward "^ *[^ \n]" nil t) - (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) - (unless (or (= min 0) (= min 10000)) - (setq re (format "^ \\{%d\\}" min)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match "") - (end-of-line 1)) - min))) + "Remove the maximum common indentation from the buffer. +When optional argument N is a positive integer, remove exactly +that much characters from indentation, if possible. Return nil +if it fails." + (catch :exit + (goto-char (point-min)) + ;; Find maximum common indentation, if not specified. + (let ((n (or n + (let ((min-ind (point-max))) + (save-excursion + (while (re-search-forward "^[ \t]*\\S-" nil t) + (let ((ind (1- (current-column)))) + (if (zerop ind) (throw :exit nil) + (setq min-ind (min min-ind ind)))))) + min-ind)))) + (if (zerop n) (throw :exit nil) + ;; Remove exactly N indentation, but give up if not possible. + (while (not (eobp)) + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((eolp) (delete-region (line-beginning-position) (point))) + ((< ind n) (throw :exit nil)) + (t (indent-line-to (- ind n)))) + (forward-line))) + ;; Signal success. + t)))) (defun org-fill-template (template alist) "Find each %key of ALIST in TEMPLATE and replace it." @@ -21496,12 +22176,6 @@ N may optionally be the number of spaces to remove." (or (buffer-base-buffer buffer) buffer))) -(defun org-trim (s) - "Remove whitespace at beginning and end of string." - (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) - s) - (defun org-wrap (string &optional width lines) "Wrap string to either a number of lines, or a width in characters. If WIDTH is non-nil, the string is wrapped to that width, however many lines @@ -21539,13 +22213,12 @@ The return value is a list of lines, without newlines at the end." (defun org-split-string (string &optional separators) "Splits STRING into substrings at SEPARATORS. +SEPARATORS is a regular expression. No empty strings are returned if there are matches at the beginning and end of string." - (let ((rexp (or separators "[ \f\t\n\r\v]+")) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string + ;; FIXME: why not use (split-string STRING SEPARATORS t)? + (let ((start 0) notfirst list) + (while (and (string-match (or separators "[ \f\t\n\r\v]+") string (if (and notfirst (= start (match-beginning 0)) (< start (length string))) @@ -21555,14 +22228,10 @@ and end of string." (or (eq (match-beginning 0) 0) (and (eq (match-beginning 0) (match-end 0)) (eq (match-beginning 0) start)) - (setq list - (cons (substring string start (match-beginning 0)) - list))) + (push (substring string start (match-beginning 0)) list)) (setq start (match-end 0))) (or (eq start (length string)) - (setq list - (cons (substring string start) - list))) + (push (substring string start) list)) (nreverse list))) (defun org-quote-vert (s) @@ -21579,10 +22248,8 @@ and end of string." "Whether point is in a code source block. When INSIDE is non-nil, don't consider we are within a src block when point is at #+BEGIN_SRC or #+END_SRC." - (let ((case-fold-search t) ov) - (or (and (setq ov (overlays-at (point))) - (memq 'org-block-background - (overlay-properties (car ov)))) + (let ((case-fold-search t)) + (or (and (eq (get-char-property (point) 'src-block) t)) (and (not inside) (save-match-data (save-excursion @@ -21604,13 +22271,13 @@ contexts are: :item on the first line of a plain list item :item-bullet on the bullet/number of a plain list item :checkbox on the checkbox in a plain list item -:table in an org-mode table +:table in an Org table :table-special on a special filed in a table :table-table in a table.el table :clocktable in a clocktable :src-block in a source block :link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE. +:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT. :target on a <> :radio-target on a <<>> :latex-fragment on a LaTeX fragment @@ -21635,8 +22302,8 @@ and :keyword." (push (org-point-in-group p 4 :tags) clist)) (goto-char p) (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) - (if (looking-at "\\[#[A-Z0-9]\\]") - (push (org-point-in-group p 0 :priority) clist))) + (when (looking-at "\\[#[A-Z0-9]\\]") + (push (org-point-in-group p 0 :priority) clist))) ((org-at-item-p) (push (org-point-in-group p 2 :item-bullet) clist) @@ -21648,10 +22315,10 @@ and :keyword." ((org-at-table-p) (push (list :table (org-table-begin) (org-table-end)) clist) - (if (memq 'org-formula faces) - (push (list :table-special - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist))) + (when (memq 'org-formula faces) + (push (list :table-special + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist))) ((org-at-table-p 'any) (push (list :table-table) clist))) (goto-char p) @@ -21660,16 +22327,16 @@ and :keyword." ;; New the "medium" contexts: clocktables, source blocks (cond ((org-in-clocktable-p) (push (list :clocktable - (and (or (looking-at "#\\+BEGIN: clocktable") - (search-backward "#+BEGIN: clocktable" nil t)) - (match-beginning 0)) - (and (re-search-forward "#\\+END:?" nil t) + (and (or (looking-at "[ \t]*\\(#\\+BEGIN: clocktable\\)") + (re-search-backward "[ \t]*\\(#+BEGIN: clocktable\\)" nil t)) + (match-beginning 1)) + (and (re-search-forward "[ \t]*#\\+END:?" nil t) (match-end 0))) clist)) ((org-in-src-block-p) (push (list :src-block - (and (or (looking-at "#\\+BEGIN_SRC") - (search-backward "#+BEGIN_SRC" nil t)) - (match-beginning 0)) + (and (or (looking-at "[ \t]*\\(#\\+BEGIN_SRC\\)") + (re-search-backward "[ \t]*\\(#+BEGIN_SRC\\)" nil t)) + (match-beginning 1)) (and (search-forward "#+END_SRC" nil t) (match-beginning 0))) clist)))) (goto-char p) @@ -21689,14 +22356,14 @@ and :keyword." ((org-at-target-p) (push (org-point-in-group p 0 :target) clist) (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) + (when (looking-at org-radio-target-regexp) + (push (org-point-in-group p 0 :radio-target) clist)) (goto-char p)) - ((setq o (car (delq nil - (mapcar - (lambda (x) - (if (memq x org-latex-fragment-image-overlays) x)) - (overlays-at (point)))))) + ((setq o (cl-some + (lambda (o) + (and (eq (overlay-get o 'org-overlay-type) 'org-latex-overlay) + o)) + (overlays-at (point)))) (push (list :latex-fragment (overlay-start o) (overlay-end o)) clist) (push (list :latex-preview @@ -21708,35 +22375,27 @@ and :keyword." (setq clist (nreverse (delq nil clist))) clist)) -;; FIXME: Compare with at-regexp-p Do we need both? -(defun org-in-regexp (re &optional nlines visually) - "Check if point is inside a match of regexp. -Normally only the current line is checked, but you can include NLINES extra -lines both before and after point into the search. -If VISUALLY is set, require that the cursor is not after the match but -really on, so that the block visually is on the match." - (catch 'exit +(defun org-in-regexp (regexp &optional nlines visually) + "Check if point is inside a match of REGEXP. + +Normally only the current line is checked, but you can include +NLINES extra lines around point into the search. If VISUALLY is +set, require that the cursor is not after the match but really +on, so that the block visually is on the match. + +Return nil or a cons cell (BEG . END) where BEG and END are, +respectively, the positions at the beginning and the end of the +match." + (catch :exit (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) + (eol (line-end-position (if nlines (1+ nlines) 1)))) (save-excursion (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) - -(defun org-at-regexp-p (regexp) - "Is point inside a match of REGEXP in the current line?" - (catch 'exit - (save-excursion - (let ((pos (point)) (end (point-at-eol))) - (beginning-of-line 1) - (while (re-search-forward regexp end t) - (if (and (<= (match-beginning 0) pos) - (>= (match-end 0) pos)) - (throw 'exit t))) - nil)))) + (while (and (re-search-forward regexp eol t) + (<= (match-beginning 0) pos)) + (let ((end (match-end 0))) + (when (or (> end pos) (and (= end pos) (not visually))) + (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) (defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) "Non-nil when point is between matches of START-RE and END-RE. @@ -21757,7 +22416,7 @@ position before START-RE (resp. after END-RE)." (save-excursion ;; Point is on a block when on START-RE or if START-RE can be ;; found before it... - (and (or (org-at-regexp-p start-re) + (and (or (org-in-regexp start-re) (re-search-backward start-re limit-up t)) (setq beg (match-beginning 0)) ;; ... and END-RE after it... @@ -21783,27 +22442,15 @@ block from point." (let ((case-fold-search t) (lim-up (save-excursion (outline-previous-heading))) (lim-down (save-excursion (outline-next-heading)))) - (mapc (lambda (name) - (let ((n (regexp-quote name))) - (when (org-between-regexps-p - (concat "^[ \t]*#\\+begin_" n) - (concat "^[ \t]*#\\+end_" n) - lim-up lim-down) - (throw 'exit n)))) - names)) + (dolist (name names) + (let ((n (regexp-quote name))) + (when (org-between-regexps-p + (concat "^[ \t]*#\\+begin_" n) + (concat "^[ \t]*#\\+end_" n) + lim-up lim-down) + (throw 'exit n))))) nil))) -(defun org-in-drawer-p () - "Is point within a drawer?" - (save-match-data - (let ((case-fold-search t) - (lim-up (save-excursion (outline-previous-heading))) - (lim-down (save-excursion (outline-next-heading)))) - (org-between-regexps-p - (concat "^[ \t]*:" (regexp-opt org-drawers) ":") - "^[ \t]*:end:.*$" - lim-up lim-down)))) - (defun org-occur-in-agenda-files (regexp &optional _nlines) "Call `multi-occur' with buffers for all agenda files." (interactive "sOrg-files matching: ") @@ -21815,40 +22462,21 @@ block from point." (setq files (org-add-archive-files files))) (dolist (f extra) (unless (member (file-truename f) tnames) - (unless (member f files) (setq files (append files (list f)))) - (setq tnames (append tnames (list (file-truename f)))))) + (unless (member f files) (setq files (append files (list f)))) + (setq tnames (append tnames (list (file-truename f)))))) (multi-occur (mapcar (lambda (x) (with-current-buffer - ;; FIXME: Why not just (find-file-noselect x)? - ;; Is it to avoid the "revert buffer" prompt? + ;; FIXME: Why not just (find-file-noselect x)? + ;; Is it to avoid the "revert buffer" prompt? (or (get-file-buffer x) (find-file-noselect x)) (widen) (current-buffer))) files) regexp))) -(if (boundp 'occur-mode-find-occurrence-hook) - ;; Emacs 23 - (add-hook 'occur-mode-find-occurrence-hook - (lambda () - (when (derived-mode-p 'org-mode) - (org-reveal)))) - ;; Emacs 22 - (defadvice occur-mode-goto-occurrence - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-goto-occurrence-other-window - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-display-occurrence - (after org-occur-reveal activate) - (when (derived-mode-p 'org-mode) - (let ((pos (occur-mode-find-occurrence))) - (with-current-buffer (marker-buffer pos) - (save-excursion - (goto-char pos) - (org-reveal))))))) +(add-hook 'occur-mode-find-occurrence-hook + (lambda () (when (derived-mode-p 'org-mode) (org-reveal)))) (defun org-occur-link-in-agenda-files () "Create a link and search for it in the agendas. @@ -21878,81 +22506,27 @@ merge (a 1) and (a 3) into (a 1 3). The function returns the new ALIST." (let (rtn) - (mapc - (lambda (e) - (let (n) - (if (not (assoc (car e) rtn)) - (push e rtn) - (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) - (setq rtn (assq-delete-all (car e) rtn)) - (push n rtn)))) - alist) - rtn)) + (dolist (e alist rtn) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))))) (defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." + "Remove all elements in ELTS from LIST. +Comparison is done with `equal'. It is a destructive operation +that may remove elements by altering the list structure." (while elts (setq list (delete (pop elts) list))) list) -(defun org-count (cl-item cl-seq) - "Count the number of occurrences of ITEM in SEQ. -Taken from `count' in cl-seq.el with all keyword arguments removed." - (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) - (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) - (while (< cl-start cl-end) - (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) - (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) - (setq cl-start (1+ cl-start))) - cl-count)) - -(defun org-remove-if (predicate seq) - "Remove everything from SEQ that fulfills PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (not (funcall predicate e)) (push e res))) - (nreverse res))) - -(defun org-remove-if-not (predicate seq) - "Remove everything from SEQ that does not fulfill PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (funcall predicate e) (push e res))) - (nreverse res))) - -(defun org-reduce (cl-func cl-seq &rest cl-keys) - "Reduce two-argument FUNCTION across SEQ. -Taken from `reduce' in cl-seq.el with all keyword arguments but -\":initial-value\" removed." - (let ((cl-accum (cond ((memq :initial-value cl-keys) - (cadr (memq :initial-value cl-keys))) - (cl-seq (pop cl-seq)) - (t (funcall cl-func))))) - (while cl-seq - (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) - cl-accum)) - -(defun org-every (pred seq) - "Return true if PREDICATE is true of every element of SEQ. -Adapted from `every' in cl.el." - (catch 'org-every - (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) - t)) - -(defun org-some (pred seq) - "Return true if PREDICATE is true of any element of SEQ. -Adapted from `some' in cl.el." - (catch 'org-some - (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) - nil)) - (defun org-back-over-empty-lines () "Move backwards over whitespace, to the beginning of the first empty line. Returns the number of empty lines passed." (let ((pos (point))) - (if (cdr (assoc 'heading org-blank-before-new-entry)) + (if (cdr (assq 'heading org-blank-before-new-entry)) (skip-chars-backward " \t\n\r") (unless (eobp) (forward-line -1))) @@ -22005,7 +22579,7 @@ so values can contain further %-escapes if they are define later in TABLE." (let ((tbl (copy-alist table)) (case-fold-search nil) (pchg 0) - e re rpl) + re rpl) (dolist (e tbl) (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) (when (and (cdr e) (string-match re (cdr e))) @@ -22023,16 +22597,6 @@ so values can contain further %-escapes if they are define later in TABLE." (setq string (replace-match sref t t string))))) string)) -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - (defun org-find-base-buffer-visiting (file) "Like `find-buffer-visiting' but always return the base buffer and not an indirect buffer." @@ -22042,26 +22606,12 @@ not an indirect buffer." (or (buffer-base-buffer buf) buf) nil))) -(defun org-image-file-name-regexp (&optional extensions) - "Return regexp matching the file names of images. -If EXTENSIONS is given, only match these." - (if (and (not extensions) (fboundp 'image-file-name-regexp)) - (image-file-name-regexp) - (let ((image-file-name-extensions - (or extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm")))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file &optional extensions) +;;; TODO: Only called once, from ox-odt which should probably use +;;; org-export-inline-image-p or something. +(defun org-file-image-p (file) "Return non-nil if FILE is an image." (save-match-data - (string-match (org-image-file-name-regexp extensions) file))) + (string-match (image-file-name-regexp) file))) (defun org-get-cursor-date (&optional with-time) "Return the date at cursor in as a time. @@ -22085,10 +22635,10 @@ the agenda) or the current time of the day." (nth 1 date) (nth 0 date) (nth 2 date)))) ((eq major-mode 'org-agenda-mode) (setq day (get-text-property (point) 'day)) - (if day - (setq date (calendar-gregorian-from-absolute day) - defd (encode-time 0 (or mod 0) (or hod 0) - (nth 1 date) (nth 0 date) (nth 2 date)))))) + (when day + (setq date (calendar-gregorian-from-absolute day) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))))) (or defd (current-time)))) (defun org-mark-subtree (&optional up) @@ -22101,177 +22651,440 @@ hierarchy of headlines by UP levels before marking the subtree." (cond ((org-at-heading-p) (beginning-of-line)) ((org-before-first-heading-p) (user-error "Not in a subtree")) (t (outline-previous-visible-heading 1)))) - (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) - (if (org-called-interactively-p 'any) + (when up (while (and (> up 0) (org-up-heading-safe)) (cl-decf up))) + (if (called-interactively-p 'any) (call-interactively 'org-mark-element) (org-mark-element))) +(defun org-file-newer-than-p (file time) + "Non-nil if FILE is newer than TIME. +FILE is a filename, as a string, TIME is a list of integers, as +returned by, e.g., `current-time'." + (and (file-exists-p file) + ;; Only compare times up to whole seconds as some file-systems + ;; (e.g. HFS+) do not retain any finer granularity. As + ;; a consequence, make sure we return non-nil when the two + ;; times are equal. + (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2) + (cl-subseq time 0 2))))) + +(defun org-compile-file (source process ext &optional err-msg log-buf spec) + "Compile a SOURCE file using PROCESS. + +PROCESS is either a function or a list of shell commands, as +strings. EXT is a file extension, without the leading dot, as +a string. It is used to check if the process actually succeeded. + +PROCESS must create a file with the same base name and directory +as SOURCE, but ending with EXT. The function then returns its +filename. Otherwise, it raises an error. The error message can +then be refined by providing string ERR-MSG, which is appended to +the standard message. + +If PROCESS is a function, it is called with a single argument: +the SOURCE file. + +If it is a list of commands, each of them is called using +`shell-command'. By default, in each command, %b, %f, %F, %o and +%O are replaced with, respectively, SOURCE base name, name, full +name, directory and absolute output file name. It is possible, +however, to use more place-holders by specifying them in optional +argument SPEC, as an alist following the pattern + + (CHARACTER . REPLACEMENT-STRING). + +When PROCESS is a list of commands, optional argument LOG-BUF can +be set to a buffer or a buffer name. `shell-command' then uses +it for output." + (let* ((base-name (file-name-base source)) + (full-name (file-truename source)) + (out-dir (or (file-name-directory source) "./")) + (output (expand-file-name (concat base-name "." ext) out-dir)) + (time (current-time)) + (err-msg (if (stringp err-msg) (concat ". " err-msg) ""))) + (save-window-excursion + (pcase process + ((pred functionp) (funcall process (shell-quote-argument source))) + ((pred consp) + (let ((log-buf (and log-buf (get-buffer-create log-buf))) + (spec (append spec + `((?b . ,(shell-quote-argument base-name)) + (?f . ,(shell-quote-argument source)) + (?F . ,(shell-quote-argument full-name)) + (?o . ,(shell-quote-argument out-dir)) + (?O . ,(shell-quote-argument output)))))) + (dolist (command process) + (shell-command (format-spec command spec) log-buf)))) + (_ (error "No valid command to process %S%s" source err-msg)))) + ;; Check for process failure. Output file is expected to be + ;; located in the same directory as SOURCE. + (unless (org-file-newer-than-p output time) + (error (format "File %S wasn't produced%s" output err-msg))) + output)) ;;; Indentation +(defvar org-element-greater-elements) +(defun org--get-expected-indentation (element contentsp) + "Expected indentation column for current line, according to ELEMENT. +ELEMENT is an element containing point. CONTENTSP is non-nil +when indentation is to be computed according to contents of +ELEMENT." + (let ((type (org-element-type element)) + (start (org-element-property :begin element)) + (post-affiliated (org-element-property :post-affiliated element))) + (org-with-wide-buffer + (cond + (contentsp + (cl-case type + ((diary-sexp footnote-definition) 0) + ((headline inlinetask nil) + (if (not org-adapt-indentation) 0 + (let ((level (org-current-level))) + (if level (1+ level) 0)))) + ((item plain-list) (org-list-item-body-column post-affiliated)) + (t + (goto-char start) + (org-get-indentation)))) + ((memq type '(headline inlinetask nil)) + (if (org-match-line "[ \t]*$") + (org--get-expected-indentation element t) + 0)) + ((memq type '(diary-sexp footnote-definition)) 0) + ;; First paragraph of a footnote definition or an item. + ;; Indent like parent. + ((< (line-beginning-position) start) + (org--get-expected-indentation + (org-element-property :parent element) t)) + ;; At first line: indent according to previous sibling, if any, + ;; ignoring footnote definitions and inline tasks, or parent's + ;; contents. + ((= (line-beginning-position) start) + (catch 'exit + (while t + (if (= (point-min) start) (throw 'exit 0) + (goto-char (1- start)) + (let* ((previous (org-element-at-point)) + (parent previous)) + (while (and parent (<= (org-element-property :end parent) start)) + (setq previous parent + parent (org-element-property :parent parent))) + (cond + ((not previous) (throw 'exit 0)) + ((> (org-element-property :end previous) start) + (throw 'exit (org--get-expected-indentation previous t))) + ((memq (org-element-type previous) + '(footnote-definition inlinetask)) + (setq start (org-element-property :begin previous))) + (t (goto-char (org-element-property :begin previous)) + (throw 'exit + (if (bolp) (org-get-indentation) + ;; At first paragraph in an item or + ;; a footnote definition. + (org--get-expected-indentation + (org-element-property :parent previous) t)))))))))) + ;; Otherwise, move to the first non-blank line above. + (t + (beginning-of-line) + (let ((pos (point))) + (skip-chars-backward " \r\t\n") + (cond + ;; Two blank lines end a footnote definition or a plain + ;; list. When we indent an empty line after them, the + ;; containing list or footnote definition is over, so it + ;; qualifies as a previous sibling. Therefore, we indent + ;; like its first line. + ((and (memq type '(footnote-definition plain-list)) + (> (count-lines (point) pos) 2)) + (goto-char start) + (org-get-indentation)) + ;; Line above is the first one of a paragraph at the + ;; beginning of an item or a footnote definition. Indent + ;; like parent. + ((< (line-beginning-position) start) + (org--get-expected-indentation + (org-element-property :parent element) t)) + ;; Line above is the beginning of an element, i.e., point + ;; was originally on the blank lines between element's start + ;; and contents. + ((= (line-beginning-position) post-affiliated) + (org--get-expected-indentation element t)) + ;; POS is after contents in a greater element. Indent like + ;; the beginning of the element. + ((and (memq type org-element-greater-elements) + (let ((cend (org-element-property :contents-end element))) + (and cend (<= cend pos)))) + ;; As a special case, if point is at the end of a footnote + ;; definition or an item, indent like the very last element + ;; within. If that last element is an item, indent like + ;; its contents. + (if (memq type '(footnote-definition item plain-list)) + (let ((last (org-element-at-point))) + (goto-char pos) + (org--get-expected-indentation + last (eq (org-element-type last) 'item))) + (goto-char start) + (org-get-indentation))) + ;; In any other case, indent like the current line. + (t (org-get-indentation))))))))) + +(defun org--align-node-property () + "Align node property at point. +Alignment is done according to `org-property-format', which see." + (when (save-excursion + (beginning-of-line) + (looking-at org-property-re)) + (replace-match + (concat (match-string 4) + (org-trim + (format org-property-format (match-string 1) (match-string 3)))) + t t))) + (defun org-indent-line () - "Indent line depending on context." + "Indent line depending on context. + +Indentation is done according to the following rules: + + - Footnote definitions, diary sexps, headlines and inline tasks + have to start at column 0. + + - On the very first line of an element, consider, in order, the + next rules until one matches: + + 1. If there's a sibling element before, ignoring footnote + definitions and inline tasks, indent like its first line. + + 2. If element has a parent, indent like its contents. More + precisely, if parent is an item, indent after the + description part, if any, or the bullet (see + `org-list-description-max-indent'). Else, indent like + parent's first line. + + 3. Otherwise, indent relatively to current level, if + `org-adapt-indentation' is non-nil, or to left margin. + + - On a blank line at the end of an element, indent according to + the type of the element. More precisely + + 1. If element is a plain list, an item, or a footnote + definition, indent like the very last element within. + + 2. If element is a paragraph, indent like its last non blank + line. + + 3. Otherwise, indent like its very first line. + + - In the code part of a source block, use language major mode + to indent current line if `org-src-tab-acts-natively' is + non-nil. If it is nil, do nothing. + + - Otherwise, indent like the first non-blank line above. + +The function doesn't indent an item as it could break the whole +list structure. Instead, use \\`\\[org-shiftmetaleft]' or \ +`\\[org-shiftmetaright]'. + +Also align node properties according to `org-property-format'." (interactive) - (let* ((pos (point)) - (itemp (org-at-item-p)) - (case-fold-search t) - (org-drawer-regexp (or org-drawer-regexp "\000")) - (inline-task-p (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (inline-re (and inline-task-p - (org-inlinetask-outline-regexp))) - column) - (if (and orgstruct-is-++ (eq pos (point))) - (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars)))) - (indent-according-to-mode)) - (beginning-of-line 1) - (cond - ;; Headings - ((looking-at org-outline-regexp) (setq column 0)) - ;; Footnote definition - ((looking-at org-footnote-definition-re) (setq column 0)) - ;; Literal examples - ((looking-at "[ \t]*:\\( \\|$\\)") - (setq column (org-get-indentation))) ; do nothing - ;; Lists - ((ignore-errors (goto-char (org-in-item-p))) - (setq column (if itemp - (org-get-indentation) - (org-list-item-body-column (point)))) - (goto-char pos)) - ;; Drawers - ((and (looking-at "[ \t]*:END:") - (save-excursion (re-search-backward org-drawer-regexp nil t))) - (save-excursion - (goto-char (1- (match-beginning 1))) - (setq column (current-column)))) - ;; Special blocks - ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") - (save-excursion - (re-search-backward - (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) - (setq column (org-get-indentation (match-string 0)))) - ((and (not (looking-at "[ \t]*#\\+begin_")) - (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) - (save-excursion - (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) - (setq column - (cond ((equal (downcase (match-string 1)) "src") - ;; src blocks: let `org-edit-src-exit' handle them - (org-get-indentation)) - ((equal (downcase (match-string 1)) "example") - (max (org-get-indentation) - (org-get-indentation (match-string 0)))) - (t - (org-get-indentation (match-string 0)))))) - ;; This line has nothing special, look at the previous relevant - ;; line to compute indentation - (t - (beginning-of-line 0) - (while (and (not (bobp)) - (not (looking-at org-table-line-regexp)) - (not (looking-at org-drawer-regexp)) - ;; When point started in an inline task, do not move - ;; above task starting line. - (not (and inline-task-p (looking-at inline-re))) - ;; Skip drawers, blocks, empty lines, verbatim, - ;; comments, tables, footnotes definitions, lists, - ;; inline tasks. - (or (and (looking-at "[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t)) - (and (looking-at "[ \t]*#\\+end_") - (re-search-backward "[ \t]*#\\+begin_"nil t)) - (looking-at "[ \t]*[\n:#|]") - (looking-at org-footnote-definition-re) - (and (not inline-task-p) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (or (org-inlinetask-goto-beginning) t)))) - (beginning-of-line 0)) - (cond - ;; There was a list item above. - ((ignore-errors (goto-char (org-in-item-p))) - (goto-char (org-list-get-top-point (org-list-struct))) - (setq column (org-get-indentation))) - ;; There was an heading above. - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) - (setq column (current-column)))) - ;; A drawer had started and is unfinished - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ;; Else, nothing noticeable found: get indentation and go on. - (t (setq column (org-get-indentation)))))) - ;; Now apply indentation and move cursor accordingly - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column))) - ;; Special polishing for properties, see `org-property-format' - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at org-property-re) - (replace-match (concat (match-string 4) - (format org-property-format - (match-string 1) (match-string 3))) - t t)) - (org-move-to-column column)))) + (cond + (orgstruct-is-++ + (let ((indent-line-function + (cl-cadadr (assq 'indent-line-function org-fb-vars)))) + (indent-according-to-mode))) + ((org-at-heading-p) 'noindent) + (t + (let* ((element (save-excursion (beginning-of-line) (org-element-at-point))) + (type (org-element-type element))) + (cond ((and (memq type '(plain-list item)) + (= (line-beginning-position) + (org-element-property :post-affiliated element))) + 'noindent) + ((and (eq type 'latex-environment) + (>= (point) (org-element-property :post-affiliated element)) + (< (point) (org-with-wide-buffer + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + 'noindent) + ((and (eq type 'src-block) + org-src-tab-acts-natively + (> (line-beginning-position) + (org-element-property :post-affiliated element)) + (< (line-beginning-position) + (org-with-wide-buffer + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))) + (t + (let ((column (org--get-expected-indentation element nil))) + ;; Preserve current column. + (if (<= (current-column) (current-indentation)) + (indent-line-to column) + (save-excursion (indent-line-to column)))) + ;; Align node property. Also preserve current column. + (when (eq type 'node-property) + (let ((column (current-column))) + (org--align-node-property) + (org-move-to-column column))))))))) + +(defun org-indent-region (start end) + "Indent each non-blank line in the region. +Called from a program, START and END specify the region to +indent. The function will not indent contents of example blocks, +verse blocks and export blocks as leading white spaces are +assumed to be significant there." + (interactive "r") + (save-excursion + (goto-char start) + (skip-chars-forward " \r\t\n") + (unless (eobp) (beginning-of-line)) + (let ((indent-to + (lambda (ind pos) + ;; Set IND as indentation for all lines between point and + ;; POS. Blank lines are ignored. Leave point after POS + ;; once done. + (let ((limit (copy-marker pos))) + (while (< (point) limit) + (unless (looking-at-p "[ \t]*$") (indent-line-to ind)) + (forward-line)) + (set-marker limit nil)))) + (end (copy-marker end))) + (while (< (point) end) + (if (or (looking-at-p " \r\t\n") (org-at-heading-p)) (forward-line) + (let* ((element (org-element-at-point)) + (type (org-element-type element)) + (element-end (copy-marker (org-element-property :end element))) + (ind (org--get-expected-indentation element nil))) + (cond + ;; Element indented as a single block. Example blocks + ;; preserving indentation are a special case since the + ;; "contents" must not be indented whereas the block + ;; boundaries can. + ((or (memq type '(export-block latex-environment)) + (and (eq type 'example-block) + (not + (or org-src-preserve-indentation + (org-element-property :preserve-indent element))))) + (let ((offset (- ind (org-get-indentation)))) + (unless (zerop offset) + (indent-rigidly (org-element-property :begin element) + (org-element-property :end element) + offset))) + (goto-char element-end)) + ;; Elements indented line wise. Be sure to exclude + ;; example blocks (preserving indentation) and source + ;; blocks from this category as they are treated + ;; specially later. + ((or (memq type '(paragraph table table-row)) + (not (or (org-element-property :contents-begin element) + (memq type '(example-block src-block))))) + (when (eq type 'node-property) + (org--align-node-property) + (beginning-of-line)) + (funcall indent-to ind (min element-end end))) + ;; Elements consisting of three parts: before the + ;; contents, the contents, and after the contents. The + ;; contents are treated specially, according to the + ;; element type, or not indented at all. Other parts are + ;; indented as a single block. + (t + (let* ((post (copy-marker + (org-element-property :post-affiliated element))) + (cbeg + (copy-marker + (cond + ((not (org-element-property :contents-begin element)) + ;; Fake contents for source blocks. + (org-with-wide-buffer + (goto-char post) + (line-beginning-position 2))) + ((memq type '(footnote-definition item plain-list)) + ;; Contents in these elements could start on + ;; the same line as the beginning of the + ;; element. Make sure we start indenting + ;; from the second line. + (org-with-wide-buffer + (goto-char post) + (end-of-line) + (skip-chars-forward " \r\t\n") + (if (eobp) (point) (line-beginning-position)))) + (t (org-element-property :contents-begin element))))) + (cend (copy-marker + (or (org-element-property :contents-end element) + ;; Fake contents for source blocks. + (org-with-wide-buffer + (goto-char element-end) + (skip-chars-backward " \r\t\n") + (line-beginning-position))) + t))) + ;; Do not change items indentation individually as it + ;; might break the list as a whole. On the other + ;; hand, when at a plain list, indent it as a whole. + (cond ((eq type 'plain-list) + (let ((offset (- ind (org-get-indentation)))) + (unless (zerop offset) + (indent-rigidly (org-element-property :begin element) + (org-element-property :end element) + offset)) + (goto-char cbeg))) + ((eq type 'item) (goto-char cbeg)) + (t (funcall indent-to ind (min cbeg end)))) + (when (< (point) end) + (cl-case type + ((example-block verse-block)) + (src-block + ;; In a source block, indent source code + ;; according to language major mode, but only if + ;; `org-src-tab-acts-natively' is non-nil. + (when (and (< (point) end) org-src-tab-acts-natively) + (ignore-errors + (org-babel-do-in-edit-buffer + (indent-region (point-min) (point-max)))))) + (t (org-indent-region (point) (min cend end)))) + (goto-char (min cend end)) + (when (< (point) end) + (funcall indent-to ind (min element-end end)))) + (set-marker post nil) + (set-marker cbeg nil) + (set-marker cend nil)))) + (set-marker element-end nil)))) + (set-marker end nil)))) (defun org-indent-drawer () "Indent the drawer at point." (interactive) - (let ((p (point)) - (e (and (save-excursion (re-search-forward ":END:" nil t)) - (match-end 0))) - (folded - (save-excursion - (end-of-line) - (when (overlays-at (point)) - (member 'invisible (overlay-properties - (car (overlays-at (point))))))))) - (when folded (org-cycle)) - (indent-for-tab-command) - (while (and (move-beginning-of-line 2) (< (point) e)) - (indent-for-tab-command)) - (goto-char p) - (when folded (org-cycle))) + (unless (save-excursion + (beginning-of-line) + (looking-at-p org-drawer-regexp)) + (user-error "Not at a drawer")) + (let ((element (org-element-at-point))) + (unless (memq (org-element-type element) '(drawer property-drawer)) + (user-error "Not at a drawer")) + (org-with-wide-buffer + (org-indent-region (org-element-property :begin element) + (org-element-property :end element)))) (message "Drawer at point indented")) (defun org-indent-block () "Indent the block at point." (interactive) - (let ((p (point)) - (case-fold-search t) - (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t)) - (match-end 0))) - (folded - (save-excursion - (end-of-line) - (when (overlays-at (point)) - (member 'invisible (overlay-properties - (car (overlays-at (point))))))))) - (when folded (org-cycle)) - (indent-for-tab-command) - (while (and (move-beginning-of-line 2) (< (point) e)) - (indent-for-tab-command)) - (goto-char p) - (when folded (org-cycle))) + (unless (save-excursion + (beginning-of-line) + (let ((case-fold-search t)) + (looking-at-p "[ \t]*#\\+\\(begin\\|end\\)_"))) + (user-error "Not at a block")) + (let ((element (org-element-at-point))) + (unless (memq (org-element-type element) + '(comment-block center-block dynamic-block example-block + export-block quote-block special-block + src-block verse-block)) + (user-error "Not at a block")) + (org-with-wide-buffer + (org-indent-region (org-element-property :begin element) + (org-element-property :end element)))) (message "Block at point indented")) -(defun org-indent-region (start end) - "Indent region." - (interactive "r") - (save-excursion - (let ((line-end (org-current-line end))) - (goto-char start) - (while (< (org-current-line) line-end) - (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe)) - (t (call-interactively 'org-indent-line))) - (move-beginning-of-line 2))))) - ;;; Filling @@ -22294,20 +23107,20 @@ hierarchy of headlines by UP levels before marking the subtree." (require 'org-element) ;; Prevent auto-fill from inserting unwanted new items. (when (boundp 'fill-nobreak-predicate) - (org-set-local - 'fill-nobreak-predicate + (setq-local + fill-nobreak-predicate (org-uniquify (append fill-nobreak-predicate '(org-fill-line-break-nobreak-p org-fill-paragraph-with-timestamp-nobreak-p))))) (let ((paragraph-ending (substring org-element-paragraph-separate 1))) - (org-set-local 'paragraph-start paragraph-ending) - (org-set-local 'paragraph-separate paragraph-ending)) - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - (org-set-local 'auto-fill-inhibit-regexp nil) - (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) - (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) - (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) + (setq-local paragraph-start paragraph-ending) + (setq-local paragraph-separate paragraph-ending)) + (setq-local fill-paragraph-function 'org-fill-paragraph) + (setq-local auto-fill-inhibit-regexp nil) + (setq-local adaptive-fill-function 'org-adaptive-fill-function) + (setq-local normal-auto-fill-function 'org-auto-fill-function) + (setq-local comment-line-break-function 'org-comment-line-break-function)) (defun org-fill-line-break-nobreak-p () "Non-nil when a new line at point would create an Org line break." @@ -22332,69 +23145,64 @@ matches in paragraphs or comments, use it." (when (derived-mode-p 'message-mode) (save-excursion (beginning-of-line) - (cond ((or (not (message-in-body-p)) - (looking-at orgtbl-line-start-regexp)) - (throw 'exit nil)) + (cond ((not (message-in-body-p)) (throw 'exit nil)) + ((looking-at-p org-table-line-regexp) (throw 'exit nil)) ((looking-at message-cite-prefix-regexp) (throw 'exit (match-string-no-properties 0))) ((looking-at org-outline-regexp) - (throw 'exit (make-string (length (match-string 0)) ? )))))) + (throw 'exit (make-string (length (match-string 0)) ?\s)))))) (org-with-wide-buffer - (let* ((p (line-beginning-position)) - (element (save-excursion - (beginning-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point)))))) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element))) - (unless (and post-affiliated (< p post-affiliated)) - (case type - (comment - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*") - (concat (match-string 0) "# "))) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column - (or post-affiliated - (org-element-property :begin element))) - ? )) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; unless the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) + (unless (org-at-heading-p) + (let* ((p (line-beginning-position)) + (element (save-excursion + (beginning-of-line) + (org-element-at-point))) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (< p post-affiliated) + (cl-case type + (comment (save-excursion (beginning-of-line) - (cond ((eq (org-element-type parent) 'item) - (make-string (org-list-item-body-column - (org-element-property :begin parent)) - ? )) - ((and adaptive-fill-regexp - ;; Locally disable - ;; `adaptive-fill-function' to let - ;; `fill-context-prefix' handle - ;; `adaptive-fill-regexp' variable. - (let (adaptive-fill-function) - (fill-context-prefix - post-affiliated - (org-element-property :end element))))) - ((looking-at "[ \t]+") (match-string 0)) - (t ""))))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - "")))))))))) + (looking-at "[ \t]*") + (concat (match-string 0) "# "))) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column post-affiliated) ?\s)) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; unless the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (save-excursion + (beginning-of-line) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ?\s)) + ((and adaptive-fill-regexp + ;; Locally disable + ;; `adaptive-fill-function' to let + ;; `fill-context-prefix' handle + ;; `adaptive-fill-regexp' variable. + (let (adaptive-fill-function) + (fill-context-prefix + post-affiliated + (org-element-property :end element))))) + ((looking-at "[ \t]+") (match-string 0)) + (t ""))))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + ""))))))))))) (declare-function message-goto-body "message" ()) (defvar message-cite-prefix-regexp) ; From message.el @@ -22420,11 +23228,11 @@ a footnote definition, try to fill the first paragraph within." (looking-at message-cite-prefix-regexp)))) ;; First ensure filling is correct in message-mode. (let ((fill-paragraph-function - (cadadr (assoc 'fill-paragraph-function org-fb-vars))) - (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) - (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (cl-cadadr (assq 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cl-cadadr (assq 'fill-prefix org-fb-vars))) + (paragraph-start (cl-cadadr (assq 'paragraph-start org-fb-vars))) (paragraph-separate - (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (cl-cadadr (assq 'paragraph-separate org-fb-vars)))) (fill-paragraph nil)) (with-syntax-table org-mode-transpose-word-syntax-table ;; Move to end of line in order to get the first paragraph @@ -22436,7 +23244,7 @@ a footnote definition, try to fill the first paragraph within." (line-number-at-pos (point))))))) ;; First check if point is in a blank line at the beginning of ;; the buffer. In that case, ignore filling. - (case (org-element-type element) + (cl-case (org-element-type element) ;; Use major mode filling function is src blocks. (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) ;; Align Org tables, leave table.el tables as-is. @@ -22465,25 +23273,18 @@ a footnote definition, try to fill the first paragraph within." (concat "^" message-cite-prefix-regexp) end t)) (setq end (match-beginning 0)))) ;; Fill paragraph, taking line breaks into account. - ;; For that, slice the paragraph using line breaks as - ;; separators, and fill the parts in reverse order to - ;; avoid messing with markers. (save-excursion - (goto-char end) - (mapc - (lambda (pos) - (fill-region-as-paragraph pos (point) justify) - (goto-char pos)) - ;; Find the list of ending positions for line breaks - ;; in the current paragraph. Add paragraph - ;; beginning to include first slice. - (nreverse - (cons beg - (org-element-map - (org-element--parse-objects - beg end nil (org-element-restriction 'paragraph)) - 'line-break - (lambda (lb) (org-element-property :end lb))))))) + (goto-char beg) + (let ((cuts (list beg))) + (while (re-search-forward "\\\\\\\\[ \t]*\n" end t) + (when (eq 'line-break + (org-element-type + (save-excursion (backward-char) + (org-element-context)))) + (push (point) cuts))) + (dolist (c (delq end cuts)) + (fill-region-as-paragraph c end justify) + (setq end c)))) t))) ;; Contents of `comment-block' type elements should be ;; filled as plain text, but only if point is within block @@ -22564,6 +23365,130 @@ non-nil." (insert-before-markers-and-inherit fill-prefix)) +;;; Fixed Width Areas + +(defun org-toggle-fixed-width () + "Toggle fixed-width markup. + +Add or remove fixed-width markup on current line, whenever it +makes sense. Return an error otherwise. + +If a region is active and if it contains only fixed-width areas +or blank lines, remove all fixed-width markup in it. If the +region contains anything else, convert all non-fixed-width lines +to fixed-width ones. + +Blank lines at the end of the region are ignored unless the +region only contains such lines." + (interactive) + (if (not (org-region-active-p)) + ;; No region: + ;; + ;; Remove fixed width marker only in a fixed-with element. + ;; + ;; Add fixed width maker in paragraphs, in blank lines after + ;; elements or at the beginning of a headline or an inlinetask, + ;; and before any one-line elements (e.g., a clock). + (progn + (beginning-of-line) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (cond + ((and (eq type 'fixed-width) + (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)")) + (replace-match + "" nil nil nil (if (= (line-end-position) (match-end 0)) 0 1))) + ((and (memq type '(babel-call clock comment diary-sexp headline + horizontal-rule keyword paragraph + planning)) + (<= (org-element-property :post-affiliated element) (point))) + (skip-chars-forward " \t") + (insert ": ")) + ((and (looking-at-p "[ \t]*$") + (or (eq type 'inlinetask) + (save-excursion + (skip-chars-forward " \r\t\n") + (<= (org-element-property :end element) (point))))) + (delete-region (point) (line-end-position)) + (org-indent-line) + (insert ": ")) + (t (user-error "Cannot insert a fixed-width line here"))))) + ;; Region active. + (let* ((begin (save-excursion + (goto-char (region-beginning)) + (line-beginning-position))) + (end (copy-marker + (save-excursion + (goto-char (region-end)) + (unless (eolp) (beginning-of-line)) + (if (save-excursion (re-search-backward "\\S-" begin t)) + (progn (skip-chars-backward " \r\t\n") (point)) + (point))))) + (all-fixed-width-p + (catch 'not-all-p + (save-excursion + (goto-char begin) + (skip-chars-forward " \r\t\n") + (when (eobp) (throw 'not-all-p nil)) + (while (< (point) end) + (let ((element (org-element-at-point))) + (if (eq (org-element-type element) 'fixed-width) + (goto-char (org-element-property :end element)) + (throw 'not-all-p nil)))) + t)))) + (if all-fixed-width-p + (save-excursion + (goto-char begin) + (while (< (point) end) + (when (looking-at "[ \t]*\\(:\\(?: \\|$\\)\\)") + (replace-match + "" nil nil nil + (if (= (line-end-position) (match-end 0)) 0 1))) + (forward-line))) + (let ((min-ind (point-max))) + ;; Find minimum indentation across all lines. + (save-excursion + (goto-char begin) + (if (not (save-excursion (re-search-forward "\\S-" end t))) + (setq min-ind 0) + (catch 'zerop + (while (< (point) end) + (unless (looking-at-p "[ \t]*$") + (let ((ind (org-get-indentation))) + (setq min-ind (min min-ind ind)) + (when (zerop ind) (throw 'zerop t)))) + (forward-line))))) + ;; Loop over all lines and add fixed-width markup everywhere + ;; but in fixed-width lines. + (save-excursion + (goto-char begin) + (while (< (point) end) + (cond + ((org-at-heading-p) + (insert ": ") + (forward-line) + (while (and (< (point) end) (looking-at-p "[ \t]*$")) + (insert ":") + (forward-line))) + ((looking-at-p "[ \t]*:\\( \\|$\\)") + (let* ((element (org-element-at-point)) + (element-end (org-element-property :end element))) + (if (eq (org-element-type element) 'fixed-width) + (progn (goto-char element-end) + (skip-chars-backward " \r\t\n") + (forward-line)) + (let ((limit (min end element-end))) + (while (< (point) limit) + (org-move-to-column min-ind t) + (insert ": ") + (forward-line)))))) + (t + (org-move-to-column min-ind t) + (insert ": ") + (forward-line))))))) + (set-marker end nil)))) + + ;;; Comments ;; Org comments syntax is quite complex. It requires the entire line @@ -22584,87 +23509,139 @@ non-nil." (defun org-setup-comments-handling () (interactive) - (org-set-local 'comment-use-syntax nil) - (org-set-local 'comment-start "# ") - (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") - (org-set-local 'comment-insert-comment-function 'org-insert-comment) - (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) - (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) + (setq-local comment-use-syntax nil) + (setq-local comment-start "# ") + (setq-local comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (setq-local comment-insert-comment-function 'org-insert-comment) + (setq-local comment-region-function 'org-comment-or-uncomment-region) + (setq-local uncomment-region-function 'org-comment-or-uncomment-region)) (defun org-insert-comment () "Insert an empty comment above current line. -If the line is empty, insert comment at its beginning." - (beginning-of-line) - (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) - (org-indent-line) - (insert "# ")) +If the line is empty, insert comment at its beginning. When +point is within a source block, comment according to the related +major mode." + (if (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'src-block) + (< (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (line-end-position)) + (point)) + (> (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)) + (point)))) + (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) + (beginning-of-line) + (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) + (open-line 1)) + (org-indent-line) + (insert "# "))) (defvar comment-empty-lines) ; From newcomment.el. (defun org-comment-or-uncomment-region (beg end &rest _) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only -contains commented lines. Otherwise, comment them." - (save-restriction - ;; Restrict region - (narrow-to-region (save-excursion (goto-char beg) - (skip-chars-forward " \r\t\n" end) - (line-beginning-position)) - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n" beg) - (line-end-position))) - (let ((uncommentp - ;; UNCOMMENTP is non-nil when every non blank line between - ;; BEG and END is a comment. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) - (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'comment) - (goto-char (min (point-max) - (org-element-property - :end element))))))) - (eobp)))) - (if uncommentp - ;; Only blank lines and comments in region: uncomment it. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") - (replace-match "" nil nil nil 1)) - (forward-line))) - ;; Comment each line in region. - (let ((min-indent (point-max))) - ;; First find the minimum indentation across all lines. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (not (zerop min-indent))) - (unless (looking-at "[ \t]*$") - (setq min-indent (min min-indent (current-indentation)))) - (forward-line))) - ;; Then loop over all lines. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - ;; Don't get fooled by invisible text (e.g. link path) - ;; when moving to column MIN-INDENT. - (let ((buffer-invisibility-spec nil)) - (org-move-to-column min-indent t)) - (insert comment-start)) - (forward-line)))))))) +contains commented lines. Otherwise, comment them. If region is +strictly within a source block, use appropriate comment syntax." + (if (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'src-block) + (< (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (line-end-position)) + beg) + (>= (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)) + end))) + ;; Translate region boundaries for the Org buffer to the source + ;; buffer. + (let ((offset (- end beg))) + (save-excursion + (goto-char beg) + (org-babel-do-in-edit-buffer + (comment-or-uncomment-region (point) (+ offset (point)))))) + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) + (insert comment-start)) + (forward-line))))))))) + +(defun org-comment-dwim (_arg) + "Call `comment-dwim' within a source edit buffer if needed." + (interactive "*P") + (if (org-in-src-block-p) + (org-babel-do-in-edit-buffer (call-interactively 'comment-dwim)) + (call-interactively 'comment-dwim))) -;;; Planning +;;; Timestamps API ;; This section contains tools to operate on timestamp objects, as ;; returned by, e.g. `org-element-context'. +(defun org-timestamp--to-internal-time (timestamp &optional end) + "Encode TIMESTAMP object into Emacs internal time. +Use end of date range or time range when END is non-nil." + (apply #'encode-time + (cons 0 + (mapcar + (lambda (prop) (or (org-element-property prop timestamp) 0)) + (if end '(:minute-end :hour-end :day-end :month-end :year-end) + '(:minute-start :hour-start :day-start :month-start + :year-start)))))) + (defun org-timestamp-has-time-p (timestamp) "Non-nil when TIMESTAMP has a time specified." (org-element-property :hour-start timestamp)) -(defun org-timestamp-format (timestamp format &optional end zone) - "Format a TIMESTAMP element into a string. +(defun org-timestamp-format (timestamp format &optional end utc) + "Format a TIMESTAMP object into a string. FORMAT is a format specifier to be passed to `format-time-string'. @@ -22672,33 +23649,22 @@ FORMAT is a format specifier to be passed to When optional argument END is non-nil, use end of date-range or time-range, if possible. -The optional ZONE is omitted or nil for Emacs local time, t for -Universal Time, `wall' for system wall clock time, or a string as -in the TZ environment variable. It can also be a list (as from -`current-time-zone') or an integer (as from `decode-time') -applied without consideration for daylight saving time." +When optional argument UTC is non-nil, time will be expressed as +Universal Time." (format-time-string - format - (apply 'encode-time - (cons 0 - (mapcar - (lambda (prop) (or (org-element-property prop timestamp) 0)) - (if end '(:minute-end :hour-end :day-end :month-end :year-end) - '(:minute-start :hour-start :day-start :month-start - :year-start))))) - zone)) + format (org-timestamp--to-internal-time timestamp end) + (and utc t))) (defun org-timestamp-split-range (timestamp &optional end) - "Extract a timestamp object from a date or time range. + "Extract a TIMESTAMP object from a date or time range. -TIMESTAMP is a timestamp object. END, when non-nil, means extract -the end of the range. Otherwise, extract its start. +END, when non-nil, means extract the end of the range. +Otherwise, extract its start. -Return a new timestamp object sharing the same parent as -TIMESTAMP." +Return a new timestamp object." (let ((type (org-element-property :type timestamp))) (if (memq type '(active inactive diary)) timestamp - (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp))))) + (let ((split-ts (org-element-copy timestamp))) ;; Set new type. (org-element-put-property split-ts :type (if (eq type 'active-range) 'active 'inactive)) @@ -22712,91 +23678,43 @@ TIMESTAMP." (dolist (p-cell p-alist) (org-element-put-property split-ts - (funcall (if end 'car 'cdr) p-cell) + (funcall (if end #'car #'cdr) p-cell) (org-element-property - (funcall (if end 'cdr 'car) p-cell) split-ts))) + (funcall (if end #'cdr #'car) p-cell) split-ts))) ;; Eventually refresh `:raw-value'. (org-element-put-property split-ts :raw-value nil) (org-element-put-property split-ts :raw-value (org-element-interpret-data split-ts))))))) (defun org-timestamp-translate (timestamp &optional boundary) - "Apply `org-translate-time' on a TIMESTAMP object. + "Translate TIMESTAMP object to custom format. + +Format string is defined in `org-time-stamp-custom-formats', +which see. + When optional argument BOUNDARY is non-nil, it is either the symbol `start' or `end'. In this case, only translate the starting or ending part of TIMESTAMP if it is a date or time -range. Otherwise, translate both parts." - (if (and (not boundary) - (memq (org-element-property :type timestamp) - '(active-range inactive-range))) - (concat - (org-translate-time - (org-element-property :raw-value - (org-timestamp-split-range timestamp))) - "--" - (org-translate-time - (org-element-property :raw-value - (org-timestamp-split-range timestamp t)))) - (org-translate-time - (org-element-property - :raw-value - (if (not boundary) timestamp - (org-timestamp-split-range timestamp (eq boundary 'end))))))) +range. Otherwise, translate both parts. +Return timestamp as-is if `org-display-custom-times' is nil or if +it has a `diary' type." + (let ((type (org-element-property :type timestamp))) + (if (or (not org-display-custom-times) (eq type 'diary)) + (org-element-interpret-data timestamp) + (let ((fmt (funcall (if (org-timestamp-has-time-p timestamp) #'cdr #'car) + org-time-stamp-custom-formats))) + (if (and (not boundary) (memq type '(active-range inactive-range))) + (concat (org-timestamp-format timestamp fmt) + "--" + (org-timestamp-format timestamp fmt t)) + (org-timestamp-format timestamp fmt (eq boundary 'end))))))) -;;; Other stuff. -(defun org-toggle-fixed-width-section (arg) - "Toggle the fixed-width export. -If there is no active region, the QUOTE keyword at the current headline is -inserted or removed. When present, it causes the text between this headline -and the next to be exported as fixed-width text, and unmodified. -If there is an active region, this command adds or removes a colon as the -first character of this line. If the first character of a line is a colon, -this line is also exported in fixed-width font." - (interactive "P") - (let* ((cc 0) - (regionp (org-region-active-p)) - (beg (if regionp (region-beginning) (point))) - (end (if regionp (region-end))) - (nlines (or arg (if (and beg end) (count-lines beg end) 1))) - (case-fold-search nil) - (re "[ \t]*\\(:\\(?: \\|$\\)\\)") - off) - (if regionp - (save-excursion - (goto-char beg) - (setq cc (current-column)) - (beginning-of-line 1) - (setq off (looking-at re)) - (while (> nlines 0) - (setq nlines (1- nlines)) - (beginning-of-line 1) - (cond - (arg - (org-move-to-column cc t) - (insert ": \n") - (forward-line -1)) - ((and off (looking-at re)) - (replace-match "" t t nil 1)) - ((not off) (org-move-to-column cc t) (insert ": "))) - (forward-line 1))) - (save-excursion - (org-back-to-heading) - (cond - ((looking-at (format org-heading-keyword-regexp-format - org-quote-string)) - (goto-char (match-end 1)) - (looking-at (concat " +" org-quote-string)) - (replace-match "" t t) - (when (eolp) (insert " "))) - ((looking-at org-outline-regexp) - (goto-char (match-end 0)) - (insert org-quote-string " "))))))) +;;; Other stuff. (defvar reftex-docstruct-symbol) -(defvar reftex-cite-format) (defvar org--rds) (defun org-reftex-citation () @@ -22814,131 +23732,137 @@ Export of such citations to both LaTeX and HTML is handled by the contributed package ox-bibtex by Taru Karttunen." (interactive) (let ((reftex-docstruct-symbol 'org--rds) - (reftex-cite-format "\\cite{%l}") org--rds bib) - (save-excursion - (save-restriction - (widen) - (let ((case-fold-search t) - (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)")) - (if (not (save-excursion - (or (re-search-forward re nil t) - (re-search-backward re nil t)))) - (error "No bibliography defined in file") - (setq bib (concat (match-string 1) ".bib") - org--rds (list (list 'bib bib))))))) + (org-with-wide-buffer + (let ((case-fold-search t) + (re "^[ \t]*#\\+BIBLIOGRAPHY:[ \t]+\\([^ \t\n]+\\)")) + (if (not (save-excursion + (or (re-search-forward re nil t) + (re-search-backward re nil t)))) + (user-error "No bibliography defined in file") + (setq bib (concat (match-string 1) ".bib") + org--rds (list (list 'bib bib)))))) (call-interactively 'reftex-citation))) ;;;; Functions extending outline functionality -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the -first attempt, and only move to after the tags when the cursor is already -beyond the end of the headline." - (interactive "P") - (let ((pos (point)) - (special (if (consp org-special-ctrl-a/e) - (car org-special-ctrl-a/e) - org-special-ctrl-a/e)) - deactivate-mark refpos) - (if (org-bound-and-true-p visual-line-mode) - (beginning-of-visual-line 1) - (beginning-of-line 1)) - (if (and arg (fboundp 'move-beginning-of-line)) - (call-interactively 'move-beginning-of-line) - (if (bobp) - nil - (backward-char 1) - (if (org-truely-invisible-p) - (while (and (not (bobp)) (org-truely-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1)))) - (when special - (cond - ((and (looking-at org-complex-heading-regexp) - (= (char-after (match-end 1)) ?\ )) - (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) - (point-at-eol))) - (goto-char - (if (eq special t) - (cond ((> pos refpos) refpos) - ((= pos (point)) refpos) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t refpos))))) - ((org-at-item-p) - ;; Being at an item and not looking at an the item means point - ;; was previously moved to beginning of a visual line, which - ;; doesn't contain the item. Therefore, do nothing special, - ;; just stay here. - (when (looking-at org-list-full-item-re) - ;; Set special position at first white space character after - ;; bullet, and check-box, if any. - (let ((after-bullet - (let ((box (match-end 3))) - (if (not box) (match-end 1) - (let ((after (char-after box))) - (if (and after (= after ? )) (1+ box) box)))))) - ;; Special case: Move point to special position when - ;; currently after it or at beginning of line. - (if (eq special t) - (when (or (> pos after-bullet) (= (point) pos)) - (goto-char after-bullet)) - ;; Reversed case: Move point to special position when - ;; point was already at beginning of line and command is - ;; repeated. - (when (and (= (point) pos) (eq last-command this-command)) - (goto-char after-bullet)))))))) - (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the line. +(defun org-beginning-of-line (&optional n) + "Go to the beginning of the current visible line. + If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the first attempt, and only move to after the tags when -the cursor is already beyond the end of the headline." - (interactive "P") - (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e) - org-special-ctrl-a/e)) - (move-fun (cond ((org-bound-and-true-p visual-line-mode) - 'end-of-visual-line) - ((fboundp 'move-end-of-line) 'move-end-of-line) - (t 'end-of-line))) +the cursor is already beyond the end of the headline. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase org-special-ctrl-a/e + (`(,C-a . ,_) C-a) (_ org-special-ctrl-a/e))) deactivate-mark) - (if (or (not special) arg) (call-interactively move-fun) - (let* ((element (save-excursion (beginning-of-line) - (org-element-at-point))) - (type (org-element-type element))) - (cond - ((memq type '(headline inlinetask)) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) - (if (eq special t) - (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) - (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (call-interactively move-fun)))) - ((org-element-property :hiddenp element) - ;; If element is hidden, `move-end-of-line' would put point - ;; after it. Use `end-of-line' to stay on current line. - (call-interactively 'end-of-line)) - (t (call-interactively move-fun))))) - (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) + ;; First move to a visible line. + (if (bound-and-true-p visual-line-mode) + (beginning-of-visual-line n) + (move-beginning-of-line n) + ;; `move-beginning-of-line' may leave point after invisible + ;; characters if line starts with such of these (e.g., with + ;; a link at column 0). Really move to the beginning of the + ;; current visible line. + (beginning-of-line)) + (cond + ;; No special behavior. Point is already at the beginning of + ;; a line, logical or visual. + ((not special)) + ;; `beginning-of-visual-line' left point before logical beginning + ;; of line: point is at the beginning of a visual line. Bail + ;; out. + ((and (bound-and-true-p visual-line-mode) (not (bolp)))) + ((let ((case-fold-search nil)) (looking-at org-complex-heading-regexp)) + ;; At a headline, special position is before the title, but + ;; after any TODO keyword or priority cookie. + (let ((refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) + (line-end-position))) + (bol (point))) + (if (eq special 'reversed) + (when (and (= origin bol) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (= origin bol)) + (goto-char refpos))))) + ((and (looking-at org-list-full-item-re) + (memq (org-element-type (save-match-data (org-element-at-point))) + '(item plain-list))) + ;; Set special position at first white space character after + ;; bullet, and check-box, if any. + (let ((after-bullet + (let ((box (match-end 3))) + (cond ((not box) (match-end 1)) + ((eq (char-after box) ?\s) (1+ box)) + (t box))))) + (if (eq special 'reversed) + (when (and (= (point) origin) (eq last-command this-command)) + (goto-char after-bullet)) + (when (or (> origin after-bullet) (= (point) origin)) + (goto-char after-bullet))))) + ;; No special context. Point is already at beginning of line. + (t nil)))) + +(defun org-end-of-line (&optional n) + "Go to the end of the line, but before ellipsis, if any. + +If this is a headline, and `org-special-ctrl-a/e' is set, ignore +tags on the first attempt, and only move to after the tags when +the cursor is already beyond the end of the headline. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase org-special-ctrl-a/e + (`(,_ . ,C-e) C-e) (_ org-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if (bound-and-true-p visual-line-mode) + (beginning-of-visual-line n) + (move-beginning-of-line n)) + (cond + ;; At a headline, with tags. + ((and special + (save-excursion + (beginning-of-line) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp))) + (match-end 5)) + (let ((tags (save-excursion + (goto-char (match-beginning 5)) + (skip-chars-backward " \t") + (point))) + (visual-end (and (bound-and-true-p visual-line-mode) + (save-excursion + (end-of-visual-line) + (point))))) + ;; If `end-of-visual-line' brings us before end of line or + ;; even tags, i.e., the headline spans over multiple visual + ;; lines, move there. + (cond ((and visual-end + (< visual-end tags) + (<= origin visual-end)) + (goto-char visual-end)) + ((eq special 'reversed) + (if (and (= origin (line-end-position)) + (eq this-command last-command)) + (goto-char tags) + (end-of-line))) + (t + (if (or (< origin tags) (= origin (line-end-position))) + (goto-char tags) + (end-of-line)))))) + ((bound-and-true-p visual-line-mode) + (let ((bol (line-beginning-position))) + (end-of-visual-line) + ;; If `end-of-visual-line' gets us past the ellipsis at the + ;; end of a line, backtrack and use `end-of-line' instead. + (when (/= bol (line-beginning-position)) + (goto-char bol) + (end-of-line)))) + (t (end-of-line))))) (define-key org-mode-map "\C-a" 'org-beginning-of-line) (define-key org-mode-map "\C-e" 'org-end-of-line) @@ -22948,18 +23872,43 @@ the cursor is already beyond the end of the headline." This will call `backward-sentence' or `org-table-beginning-of-field', depending on context." (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) - (t (call-interactively 'backward-sentence)))) + (let* ((element (org-element-at-point)) + (contents-begin (org-element-property :contents-begin element)) + (table (org-element-lineage element '(table) t))) + (if (and table + (> (point) contents-begin) + (<= (point) (org-element-property :contents-end table))) + (call-interactively #'org-table-beginning-of-field) + (save-restriction + (when (and contents-begin + (< (point-min) contents-begin) + (> (point) contents-begin)) + (narrow-to-region contents-begin + (org-element-property :contents-end element))) + (call-interactively #'backward-sentence))))) (defun org-forward-sentence (&optional _arg) "Go to end of sentence, or end of table field. This will call `forward-sentence' or `org-table-end-of-field', depending on context." (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-end-of-field)) - (t (call-interactively 'forward-sentence)))) + (let* ((element (org-element-at-point)) + (contents-end (org-element-property :contents-end element)) + (table (org-element-lineage element '(table) t))) + (if (and table + (>= (point) (org-element-property :contents-begin table)) + (< (point) contents-end)) + (call-interactively #'org-table-end-of-field) + (save-restriction + (when (and contents-end + (> (point-max) contents-end) + ;; Skip blank lines between elements. + (< (org-element-property :end element) + (save-excursion (goto-char contents-end) + (skip-chars-forward " \r\t\n")))) + (narrow-to-region (org-element-property :contents-begin element) + contents-end)) + (call-interactively #'forward-sentence))))) (define-key org-mode-map "\M-a" 'org-backward-sentence) (define-key org-mode-map "\M-e" 'org-forward-sentence) @@ -22971,14 +23920,14 @@ depending on context." ((or (not org-special-ctrl-k) (bolp) (not (org-at-heading-p))) - (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) - org-ctrl-k-protect-subtree) - (if (or (eq org-ctrl-k-protect-subtree 'error) - (not (y-or-n-p "Kill hidden subtree along with headline? "))) - (user-error "C-k aborted as it would kill a hidden subtree"))) + (when (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree + (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? ")))) + (user-error "C-k aborted as it would kill a hidden subtree")) (call-interactively - (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) + (if (bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) + ((looking-at ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$") (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) (t (kill-region (point) (point-at-eol))))) @@ -22991,24 +23940,25 @@ This command will look at the current kill and check if is a single subtree, or a series of subtrees[1]. If it passes the test, and if the cursor is at the beginning of a line or after the stars of a currently empty headline, then the yank is handled specially. How exactly depends -on the value of the following variables, both set by default. +on the value of the following variables. -org-yank-folded-subtrees - When set, the subtree(s) will be folded after insertion, but only - if doing so would now swallow text after the yanked text. +`org-yank-folded-subtrees' + By default, this variable is non-nil, which results in + subtree(s) being folded after insertion, except if doing so + would swallow text after the yanked text. -org-yank-adjusted-subtrees - When set, the subtree will be promoted or demoted in order to - fit into the local outline tree structure, which means that the level - will be adjusted so that it becomes the smaller one of the two - *visible* surrounding headings. +`org-yank-adjusted-subtrees' + When non-nil (the default value is nil), the subtree will be + promoted or demoted in order to fit into the local outline tree + structure, which means that the level will be adjusted so that it + becomes the smaller one of the two *visible* surrounding headings. Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple \\[universal-argument] prefix \ +no special treatment. In particular, a simple `\\[universal-argument]' prefix \ will just plainly yank the text as it is. -[1] The test checks if the first non-white line is a heading +\[1] The test checks if the first non-white line is a heading and if there are no other headings with fewer stars." (interactive "P") (org-yank-generic 'yank arg)) @@ -23051,7 +24001,7 @@ interactive command with similar behavior." (or (looking-at org-outline-regexp) (re-search-forward org-outline-regexp-bol end t)) (while (and (< (point) end) (looking-at org-outline-regexp)) - (hide-subtree) + (outline-hide-subtree) (org-cycle-show-empty-lines 'folded) (condition-case nil (outline-forward-same-level 1) @@ -23082,11 +24032,9 @@ interactive command with similar behavior." (setq level (org-outline-level))) (goto-char end) (skip-chars-forward " \t\r\n\v\f") - (if (or (eobp) - (and (bolp) (looking-at org-outline-regexp) - (<= (org-outline-level) level))) - nil ; Nothing would be swallowed - t))))) ; something would swallow + (not (or (eobp) + (and (bolp) (looking-at-p org-outline-regexp) + (<= (org-outline-level) level)))))))) (define-key org-mode-map "\C-y" 'org-yank) @@ -23094,17 +24042,18 @@ interactive command with similar behavior." "Check if point is at a character currently not visible. This version does not only check the character property, but also `visible-mode'." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (org-bound-and-true-p visible-mode) - nil - (outline-invisible-p))) + (unless (bound-and-true-p visible-mode) + (org-invisible-p))) (defun org-invisible-p2 () - "Check if point is at a character currently not visible." + "Check if point is at a character currently not visible. + +If the point is at EOL (and not at the beginning of a buffer too), +move it back by one char before doing this check." (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (outline-invisible-p))) + (when (and (eolp) (not (bobp))) + (backward-char 1)) + (org-invisible-p))) (defun org-back-to-heading (&optional invisible-ok) "Call `outline-back-to-heading', but provide a better error message." @@ -23121,14 +24070,28 @@ This version does not only check the character property, but also (defun org-at-heading-p (&optional ignored) (outline-on-heading-p t)) -;; Compatibility alias with Org versions < 7.8.03 -(defalias 'org-on-heading-p 'org-at-heading-p) + +(defun org-in-commented-heading-p (&optional no-inheritance) + "Non-nil if point is under a commented heading. +This function also checks ancestors of the current headline, +unless optional argument NO-INHERITANCE is non-nil." + (cond + ((org-before-first-heading-p) nil) + ((let ((headline (nth 4 (org-heading-components)))) + (and headline + (let ((case-fold-search nil)) + (string-match-p (concat "^" org-comment-string "\\(?: \\|$\\)") + headline))))) + (no-inheritance nil) + (t + (save-excursion (and (org-up-heading-safe) (org-in-commented-heading-p)))))) (defun org-at-comment-p nil - "Is cursor in a line starting with a # character?" + "Is cursor in a commented line?" (save-excursion - (beginning-of-line) - (looking-at "^#"))) + (save-match-data + (beginning-of-line) + (looking-at "^[ \t]*# ")))) (defun org-at-drawer-p nil "Is cursor at a drawer keyword?" @@ -23146,13 +24109,13 @@ This version does not only check the character property, but also "If point is at the end of an empty headline, return t, else nil. If the heading only contains a TODO keyword, it is still still considered empty." - (and (looking-at "[ \t]*$") - (when org-todo-line-regexp + (let ((case-fold-search nil)) + (and (looking-at "[ \t]*$") + org-todo-line-regexp (save-excursion - (beginning-of-line 1) - (let ((case-fold-search nil)) - (looking-at org-todo-line-regexp) - (string= (match-string 3) "")))))) + (beginning-of-line) + (looking-at org-todo-line-regexp) + (string= (match-string 3) ""))))) (defun org-at-heading-or-item-p () (or (org-at-heading-p) (org-at-item-p))) @@ -23167,9 +24130,7 @@ empty." "Move to the heading line of which the present line is a subheading. This function considers both visible and invisible heading lines. With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el + (outline-up-heading arg t)) (defun org-up-heading-safe () "Move to the heading line of which the present line is a subheading. @@ -23179,14 +24140,11 @@ headline found, or nil if no higher level is found. Also, this function will be a lot faster than `outline-up-heading', because it relies on stars being the outline starters. This can really make a significant difference in outlines with very many siblings." - (let (start-level re) - (org-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) - nil - (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} ")) - (if (re-search-backward re nil t) - (funcall outline-level))))) + (when (ignore-errors (org-back-to-heading t)) + (let ((level-up (1- (funcall outline-level)))) + (and (> level-up 0) + (re-search-backward (format "^\\*\\{1,%d\\} " level-up) nil t) + (funcall outline-level))))) (defun org-first-sibling-p () "Is this heading the first child of its parents?" @@ -23211,7 +24169,7 @@ move point." (pos (point)) (re org-outline-regexp-bol) level l) - (when (condition-case nil (org-back-to-heading t) (error nil)) + (when (ignore-errors (org-back-to-heading t)) (setq level (funcall outline-level)) (catch 'exit (or previous (forward-char 1)) @@ -23235,7 +24193,7 @@ move point." Return t when a child was found. Otherwise don't move point and return nil." (let (level (pos (point)) (re org-outline-regexp-bol)) - (when (condition-case nil (org-back-to-heading t) (error nil)) + (when (ignore-errors (org-back-to-heading t)) (setq level (outline-level)) (forward-char 1) (if (and (re-search-forward re nil t) (> (outline-level) level)) @@ -23271,8 +24229,7 @@ This is like outline-next-sibling, but invisible headings are ok." (outline-next-heading) (while (and (not (eobp)) (> (funcall outline-level) level)) (outline-next-heading)) - (if (or (eobp) (< (funcall outline-level) level)) - nil + (unless (or (eobp) (< (funcall outline-level) level)) (point)))) (defun org-get-last-sibling () @@ -23285,8 +24242,7 @@ If there is no such heading, return nil." (while (and (> (funcall outline-level) level) (not (bobp))) (outline-previous-heading)) - (if (< (funcall outline-level) level) - nil + (unless (< (funcall outline-level) level) (point))))) (defun org-end-of-subtree (&optional invisible-ok to-heading) @@ -23302,7 +24258,7 @@ If there is no such heading, return nil." (let ((first t) (level (funcall outline-level))) (if (and (derived-mode-p 'org-mode) (< level 1000)) - ;; A true heading (not a plain list item), in Org-mode + ;; A true heading (not a plain list item), in Org ;; This means we can easily find the end by looking ;; only for the right number of stars. Using a regexp to do ;; this is so much faster than using a Lisp loop. @@ -23315,33 +24271,36 @@ If there is no such heading, return nil." (setq first nil) (outline-next-heading))) (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) + (when (memq (preceding-char) '(?\n ?\^M)) + ;; Go to end of line before heading + (forward-char -1) + (when (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1))))) (point)) -(defun org-end-of-meta-data-and-drawers () - "Jump to the first text after meta data and drawers in the current entry. -This will move over empty lines, lines with planning time stamps, -clocking lines, and drawers." +(defun org-end-of-meta-data (&optional full) + "Skip planning line and properties drawer in current entry. +When optional argument FULL is non-nil, also skip empty lines, +clocking lines and regular drawers at the beginning of the +entry." (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) - (re (concat "\\(" org-drawer-regexp "\\)" - "\\|" "[ \t]*" org-keyword-time-regexp))) - (forward-line 1) - (while (re-search-forward re end t) - (if (not (match-end 1)) - ;; empty or planning line - (forward-line 1) - ;; a drawer, find the end - (re-search-forward "^[ \t]*:END:" end 'move) - (forward-line 1))) - (and (re-search-forward "[^\n]" nil t) (backward-char 1)) - (point))) + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at org-property-drawer-re) + (goto-char (match-end 0)) + (forward-line)) + (when (and full (not (org-at-heading-p))) + (catch 'exit + (let ((end (save-excursion (outline-next-heading) (point))) + (re (concat "[ \t]*$" "\\|" org-clock-line-re))) + (while (not (eobp)) + (cond ((looking-at-p org-drawer-regexp) + (if (re-search-forward "^[ \t]*:END:[ \t]*$" end t) + (forward-line) + (throw 'exit t))) + ((looking-at-p re) (forward-line)) + (t (throw 'exit t)))))))) (defun org-forward-heading-same-level (arg &optional invisible-ok) "Move forward to the ARG'th subheading at same level as this one. @@ -23349,32 +24308,27 @@ Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") - (if (not (ignore-errors (org-back-to-heading invisible-ok))) - (if (and arg (< arg 0)) - (goto-char (point-min)) - (outline-next-heading)) - (org-at-heading-p) - (let ((level (- (match-end 0) (match-beginning 0) 1)) - (f (if (and arg (< arg 0)) - 're-search-backward - 're-search-forward)) - (count (if arg (abs arg) 1)) - (result (point))) - (while (and (prog1 (> count 0) - (forward-char (if (and arg (< arg 0)) -1 1))) - (funcall f org-outline-regexp-bol nil 'move)) - (let ((l (- (match-end 0) (match-beginning 0) 1))) - (cond ((< l level) (setq count 0)) - ((and (= l level) - (or invisible-ok - (progn - (goto-char (line-beginning-position)) - (not (outline-invisible-p))))) - (setq count (1- count)) - (when (eq l level) - (setq result (point))))))) - (goto-char result)) - (beginning-of-line 1))) + (let ((backward? (and arg (< arg 0)))) + (if (org-before-first-heading-p) + (if backward? (goto-char (point-min)) (outline-next-heading)) + (org-back-to-heading invisible-ok) + (unless backward? (end-of-line)) ;do not match current headline + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if backward? #'re-search-backward #'re-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (while (and (> count 0) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (not (org-invisible-p + (line-beginning-position))))) + (cl-decf count) + (when (= l level) (setq result (point))))))) + (goto-char result)) + (beginning-of-line)))) (defun org-backward-heading-same-level (arg &optional invisible-ok) "Move backward to the ARG'th subheading at same level as this one. @@ -23382,20 +24336,64 @@ Stop at the first and last subheadings of a superior heading." (interactive "p") (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) +(defun org-next-visible-heading (arg) + "Move to the next visible heading. + +This function wraps `outline-next-visible-heading' with +`org-with-limited-levels' in order to skip over inline tasks and +respect customization of `org-odd-levels-only'." + (interactive "p") + (org-with-limited-levels + (outline-next-visible-heading arg))) + +(defun org-previous-visible-heading (arg) + "Move to the previous visible heading. + +This function wraps `outline-previous-visible-heading' with +`org-with-limited-levels' in order to skip over inline tasks and +respect customization of `org-odd-levels-only'." + (interactive "p") + (org-with-limited-levels + (outline-previous-visible-heading arg))) + (defun org-next-block (arg &optional backward block-regexp) "Jump to the next block. -With a prefix argument ARG, jump forward ARG many source blocks. + +With a prefix argument ARG, jump forward ARG many blocks. + When BACKWARD is non-nil, jump to the previous block. -When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + +When BLOCK-REGEXP is non-nil, use this regexp to find blocks. +Match data is set according to this regexp when the function +returns. + +Return point at beginning of the opening line of found block. +Throw an error if no block is found." (interactive "p") - (let ((re (or block-regexp org-block-regexp)) - (re-search-fn (or (and backward 're-search-backward) - 're-search-forward))) - (if (looking-at re) (forward-char 1)) - (condition-case nil - (funcall re-search-fn re nil nil arg) - (error (error "No %s code blocks" (if backward "previous" "further" )))) - (goto-char (match-beginning 0)) (org-show-context))) + (let ((re (or block-regexp "^[ \t]*#\\+BEGIN")) + (case-fold-search t) + (search-fn (if backward #'re-search-backward #'re-search-forward)) + (count (or arg 1)) + (origin (point)) + last-element) + (if backward (beginning-of-line) (end-of-line)) + (while (and (> count 0) (funcall search-fn re nil t)) + (let ((element (save-excursion + (goto-char (match-beginning 0)) + (save-match-data (org-element-at-point))))) + (when (and (memq (org-element-type element) + '(center-block comment-block dynamic-block + example-block export-block quote-block + special-block src-block verse-block)) + (<= (match-beginning 0) + (org-element-property :post-affiliated element))) + (setq last-element element) + (cl-decf count)))) + (if (= count 0) + (prog1 (goto-char (org-element-property :post-affiliated last-element)) + (save-match-data (org-show-context))) + (goto-char origin) + (user-error "No %s code blocks" (if backward "previous" "further"))))) (defun org-previous-block (arg &optional block-regexp) "Jump to the previous block. @@ -23434,7 +24432,7 @@ item, etc. It also provides some special moves for convenience: (skip-chars-forward " \r\t\n") (or (eobp) (beginning-of-line))) ;; On affiliated keywords, move to element's beginning. - ((and post-affiliated (< (point) post-affiliated)) + ((< (point) post-affiliated) (goto-char post-affiliated)) ;; At a table row, move to the end of the table. Similarly, ;; at a node property, move to the end of the property @@ -23461,8 +24459,8 @@ item, etc. It also provides some special moves for convenience: ;; With no contents, just skip element. ((not contents-begin) (goto-char end)) ;; If contents are invisible, skip the element altogether. - ((outline-invisible-p (line-end-position)) - (case type + ((org-invisible-p (line-end-position)) + (cl-case type (headline (org-with-limited-levels (outline-next-visible-heading 1))) ;; At a plain list, make sure we move to the next item @@ -23473,7 +24471,7 @@ item, etc. It also provides some special moves for convenience: ((>= (point) contents-end) (goto-char end)) ((>= (point) contents-begin) ;; This can only happen on paragraphs and plain lists. - (case type + (cl-case type (paragraph (goto-char end)) ;; At a plain list, try to move to second element in ;; first item, if possible. @@ -23513,7 +24511,7 @@ convenience: ((= (point) begin) (backward-char) (org-backward-paragraph)) - ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin)) + ((<= (point) post-affiliated) (goto-char begin)) ((memq type '(node-property table-row)) (goto-char (org-element-property :post-affiliated (org-element-property :parent element)))) @@ -23548,7 +24546,7 @@ convenience: (org-backward-paragraph)) (t (goto-char (or post-affiliated begin)))) ;; Ensure we never leave point invisible. - (when (outline-invisible-p (point)) (beginning-of-visual-line)))) + (when (org-invisible-p (point)) (beginning-of-visual-line)))) (defun org-forward-element () "Move forward by one element. @@ -23587,18 +24585,21 @@ Move to the previous element at the same level, when possible." (progn (goto-char origin) (user-error "Cannot move further up")))))) (t - (let* ((trail (org-element-at-point 'keep-trail)) - (elem (car trail)) - (prev-elem (nth 1 trail)) + (let* ((elem (org-element-at-point)) (beg (org-element-property :begin elem))) (cond ;; Move to beginning of current element if point isn't ;; there already. ((null beg) (message "No element at point")) ((/= (point) beg) (goto-char beg)) - (prev-elem (goto-char (org-element-property :begin prev-elem))) - ((org-before-first-heading-p) (goto-char (point-min))) - (t (org-back-to-heading))))))) + (t (goto-char beg) + (skip-chars-backward " \r\t\n") + (unless (bobp) + (let ((prev (org-element-at-point))) + (goto-char (org-element-property :begin prev)) + (while (and (setq prev (org-element-property :parent prev)) + (<= (org-element-property :end prev) beg)) + (goto-char (org-element-property :begin prev))))))))))) (defun org-up-element () "Move to upper element." @@ -23612,7 +24613,6 @@ Move to the previous element at the same level, when possible." (user-error "No surrounding element") (org-with-limited-levels (org-back-to-heading))))))) -(defvar org-element-greater-elements) (defun org-down-element () "Move to inner element." (interactive) @@ -23623,7 +24623,7 @@ Move to the previous element at the same level, when possible." (forward-char)) ((memq (org-element-type element) org-element-greater-elements) ;; If contents are hidden, first disclose them. - (when (org-element-property :hiddenp element) (org-cycle)) + (when (org-invisible-p (line-end-position)) (org-cycle)) (goto-char (or (org-element-property :contents-begin element) (user-error "No content for this element")))) (t (user-error "No inner element"))))) @@ -23631,24 +24631,41 @@ Move to the previous element at the same level, when possible." (defun org-drag-element-backward () "Move backward element at point." (interactive) - (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) - (let* ((trail (org-element-at-point 'keep-trail)) - (elem (car trail)) - (prev-elem (nth 1 trail))) - ;; Error out if no previous element or previous element is - ;; a parent of the current one. - (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) - (user-error "Cannot drag element backward") - (let ((pos (point))) - (org-element-swap-A-B prev-elem elem) - (goto-char (+ (org-element-property :begin prev-elem) - (- pos (org-element-property :begin elem))))))))) + (let ((elem (or (org-element-at-point) + (user-error "No element at point")))) + (if (eq (org-element-type elem) 'headline) + ;; Preserve point when moving a whole tree, even if point was + ;; on blank lines below the headline. + (let ((offset (skip-chars-backward " \t\n"))) + (unwind-protect (org-move-subtree-up) + (forward-char (- offset)))) + (let ((prev-elem + (save-excursion + (goto-char (org-element-property :begin elem)) + (skip-chars-backward " \r\t\n") + (unless (bobp) + (let* ((beg (org-element-property :begin elem)) + (prev (org-element-at-point)) + (up prev)) + (while (and (setq up (org-element-property :parent up)) + (<= (org-element-property :end up) beg)) + (setq prev up)) + prev))))) + ;; Error out if no previous element or previous element is + ;; a parent of the current one. + (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) + (user-error "Cannot drag element backward") + (let ((pos (point))) + (org-element-swap-A-B prev-elem elem) + (goto-char (+ (org-element-property :begin prev-elem) + (- pos (org-element-property :begin elem)))))))))) (defun org-drag-element-forward () "Move forward element at point." (interactive) (let* ((pos (point)) - (elem (org-element-at-point))) + (elem (or (org-element-at-point) + (user-error "No element at point")))) (when (= (point-max) (org-element-property :end elem)) (user-error "Cannot drag element forward")) (goto-char (org-element-property :end elem)) @@ -23681,7 +24698,7 @@ Move to the previous element at the same level, when possible." (defun org-drag-line-forward (arg) "Drag the line at point ARG lines forward." (interactive "p") - (dotimes (n (abs arg)) + (dotimes (_ (abs arg)) (let ((c (current-column))) (if (< 0 arg) (progn @@ -23705,7 +24722,7 @@ mode) if the mark is active, it marks the next element after the ones already marked." (interactive) (let (deactivate-mark) - (if (and (org-called-interactively-p 'any) + (if (and (called-interactively-p 'any) (or (and (eq last-command this-command) (mark t)) (and transient-mark-mode mark-active))) (set-mark @@ -23751,13 +24768,10 @@ modified." (interactive) (unless (eq major-mode 'org-mode) (user-error "Cannot un-indent a buffer not in Org mode")) - (let* ((parse-tree (org-element-parse-buffer 'greater-element)) - unindent-tree ; For byte-compiler. - (unindent-tree - (function - (lambda (contents) - (mapc - (lambda (element) + (letrec ((parse-tree (org-element-parse-buffer 'greater-element)) + (unindent-tree + (lambda (contents) + (dolist (element (reverse contents)) (if (memq (org-element-type element) '(headline section)) (funcall unindent-tree (org-element-contents element)) (save-excursion @@ -23765,10 +24779,49 @@ modified." (narrow-to-region (org-element-property :begin element) (org-element-property :end element)) - (org-do-remove-indentation))))) - (reverse contents)))))) + (org-do-remove-indentation)))))))) (funcall unindent-tree (org-element-contents parse-tree)))) +(defun org-show-children (&optional level) + "Show all direct subheadings of this heading. +Prefix arg LEVEL is how many levels below the current level +should be shown. Default is enough to cause the following +heading to appear." + (interactive "p") + ;; If `orgstruct-mode' is active, use the slower version. + (if orgstruct-mode (call-interactively #'outline-show-children) + (save-excursion + (org-back-to-heading t) + (let* ((current-level (funcall outline-level)) + (max-level (org-get-valid-level + current-level + (if level (prefix-numeric-value level) 1))) + (end (save-excursion (org-end-of-subtree t t))) + (regexp-fmt "^\\*\\{%d,%s\\}\\(?: \\|$\\)") + (past-first-child nil) + ;; Make sure to skip inlinetasks. + (re (format regexp-fmt + current-level + (cond + ((not (featurep 'org-inlinetask)) "") + (org-odd-levels-only (- (* 2 org-inlinetask-min-level) + 3)) + (t (1- org-inlinetask-min-level)))))) + ;; Display parent heading. + (outline-flag-region (line-end-position 0) (line-end-position) nil) + (forward-line) + ;; Display children. First child may be deeper than expected + ;; MAX-LEVEL. Since we want to display it anyway, adjust + ;; MAX-LEVEL accordingly. + (while (re-search-forward re end t) + (unless past-first-child + (setq re (format regexp-fmt + current-level + (max (funcall outline-level) max-level))) + (setq past-first-child t)) + (outline-flag-region + (line-end-position 0) (line-end-position) nil)))))) + (defun org-show-subtree () "Show everything after this heading at deeper levels." (interactive) @@ -23783,58 +24836,33 @@ modified." Show the heading too, if it is currently invisible." (interactive) (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (outline-flag-region - (max (point-min) (1- (point))) - (save-excursion - (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) - (match-beginning 1) - (point-max))) - nil) - (org-cycle-hide-drawers 'children)) - (error nil)))) + (ignore-errors + (org-back-to-heading t) + (outline-flag-region + (max (point-min) (1- (point))) + (save-excursion + (if (re-search-forward + (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) + (match-beginning 1) + (point-max))) + nil) + (org-cycle-hide-drawers 'children)))) (defun org-make-options-regexp (kwds &optional extra) - "Make a regular expression for keyword lines." - (concat - "^#\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - (if extra (concat "\\|" extra)) - "\\):[ \t]*\\(.*\\)")) - -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - + "Make a regular expression for keyword lines. +KWDS is a list of keywords, as strings. Optional argument EXTRA, +when non-nil, is a regexp matching keywords names." + (concat "^[ \t]*#\\+\\(" + (regexp-opt kwds) + (and extra (concat (and kwds "\\|") extra)) + "\\):[ \t]*\\(.*\\)")) ;;;; Integration with and fixes for other packages ;;; Imenu support -(defvar org-imenu-markers nil +(defvar-local org-imenu-markers nil "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) (defun org-imenu-new-marker (&optional pos) "Return a new marker for use by Imenu, and remember the marker." @@ -23845,50 +24873,48 @@ Show the heading too, if it is currently invisible." (defun org-imenu-get-tree () "Produce the index for Imenu." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) + (dolist (x org-imenu-markers) (move-marker x nil)) (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) + (let* ((case-fold-search nil) + (n org-imenu-depth) (re (concat "^" (org-get-limited-outline-regexp))) (subs (make-vector (1+ n) nil)) (last-level 0) m level head0 head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (and (<= level n) - (looking-at org-complex-heading-regexp) - (setq head0 (org-match-string-no-properties 4))) - (setq head (org-link-display-format head0) - m (org-imenu-new-marker)) - (org-add-props head nil 'org-imenu-marker m 'org-imenu t) - (if (>= level last-level) - (push (cons head m) (aref subs level)) - (push (cons head (aref subs (1+ level))) (aref subs level)) - (loop for i from (1+ level) to n do (aset subs i nil))) - (setq last-level level))))) + (org-with-wide-buffer + (goto-char (point-max)) + (while (re-search-backward re nil t) + (setq level (org-reduced-level (funcall outline-level))) + (when (and (<= level n) + (looking-at org-complex-heading-regexp) + (setq head0 (match-string-no-properties 4))) + (setq head (org-link-display-format head0) + m (org-imenu-new-marker)) + (org-add-props head nil 'org-imenu-marker m 'org-imenu t) + (if (>= level last-level) + (push (cons head m) (aref subs level)) + (push (cons head (aref subs (1+ level))) (aref subs level)) + (cl-loop for i from (1+ level) to n do (aset subs i nil))) + (setq last-level level)))) (aref subs 1))) (eval-after-load "imenu" '(progn (add-hook 'imenu-after-jump-hook (lambda () - (if (derived-mode-p 'org-mode) - (org-show-context 'org-goto)))))) + (when (derived-mode-p 'org-mode) + (org-show-context 'org-goto)))))) -(defun org-link-display-format (link) - "Replace a link with its the description. +(defun org-link-display-format (s) + "Replace links in string S with their description. If there is no description, use the link target." (save-match-data - (if (string-match org-bracket-link-analytic-regexp link) - (replace-match (if (match-end 5) - (match-string 5 link) - (concat (match-string 1 link) - (match-string 3 link))) - nil t link) - link))) + (replace-regexp-in-string + org-bracket-link-analytic-regexp + (lambda (m) + (if (match-end 5) (match-string 5 m) + (concat (match-string 1 m) (match-string 3 m)))) + s nil t))) (defun org-toggle-link-display () "Toggle the literal or descriptive display of links." @@ -23909,11 +24935,11 @@ If there is no description, use the link target." 'face 'org-agenda-restriction-lock) (overlay-put org-speedbar-restriction-lock-overlay 'help-echo "Agendas are currently limited to this item.") -(org-detach-overlay org-speedbar-restriction-lock-overlay) +(delete-overlay org-speedbar-restriction-lock-overlay) (defun org-speedbar-set-agenda-restriction () "Restrict future agenda commands to the location at point in speedbar. -To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." +To get rid of the restriction, use `\\[org-agenda-remove-restriction-lock]'." (interactive) (require 'org-agenda) (let (p m tp np dir txt) @@ -23937,9 +24963,9 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (let ((default-directory dir)) (expand-file-name txt))) (unless (derived-mode-p 'org-mode) - (user-error "Cannot restrict to non-Org-mode file")) + (user-error "Cannot restrict to non-Org mode file")) (org-agenda-set-restriction-lock 'file))) - (t (user-error "Don't know how to restrict Org-mode's agenda"))) + (t (user-error "Don't know how to restrict Org mode agenda"))) (move-overlay org-speedbar-restriction-lock-overlay (point-at-bol) (point-at-eol)) (setq current-prefix-arg nil) @@ -23959,34 +24985,98 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;;; Fixes and Hacks for problems with other packages -;; Make flyspell not check words in links, to not mess up our keymap -(defvar org-element-affiliated-keywords) ; From org-element.el -(defvar org-element-block-name-alist) ; From org-element.el +(defun org--flyspell-object-check-p (element) + "Non-nil when Flyspell can check object at point. +ELEMENT is the element at point." + (let ((object (save-excursion + (when (looking-at-p "\\>") (backward-char)) + (org-element-context element)))) + (cl-case (org-element-type object) + ;; Prevent checks in links due to keybinding conflict with + ;; Flyspell. + ((code entity export-snippet inline-babel-call + inline-src-block line-break latex-fragment link macro + statistics-cookie target timestamp verbatim) + nil) + (footnote-reference + ;; Only in inline footnotes, within the definition. + (and (eq (org-element-property :type object) 'inline) + (< (save-excursion + (goto-char (org-element-property :begin object)) + (search-forward ":" nil t 2)) + (point)))) + (otherwise t)))) + (defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons, or on - {todo,all-time,additional-option-like}-keywords." - (require 'org-element) ; For `org-element-affiliated-keywords' - (let ((pos (max (1- (point)) (point-min))) - (word (thing-at-point 'word))) - (and (not (get-text-property pos 'keymap)) - (not (get-text-property pos 'org-no-flyspell)) - (not (member word org-todo-keywords-1)) - (not (member word org-all-time-keywords)) - (not (member word org-options-keywords)) - (not (member word (mapcar 'car org-startup-options))) - (not (member-ignore-case word org-element-affiliated-keywords)) - (not (member-ignore-case word (org-get-export-keywords))) - (not (member-ignore-case - word (mapcar 'car org-element-block-name-alist))) - (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) - (not (org-in-src-block-p))))) + "Function used for `flyspell-generic-check-word-predicate'." + (if (org-at-heading-p) + ;; At a headline or an inlinetask, check title only. This is + ;; faster than relying on `org-element-at-point'. + (and (save-excursion (beginning-of-line) + (and (let ((case-fold-search t)) + (not (looking-at-p "\\*+ END[ \t]*$"))) + (let ((case-fold-search nil)) + (looking-at org-complex-heading-regexp)))) + (match-beginning 4) + (>= (point) (match-beginning 4)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5)))) + (let* ((element (org-element-at-point)) + (post-affiliated (org-element-property :post-affiliated element))) + (cond + ;; Ignore checks in all affiliated keywords but captions. + ((< (point) post-affiliated) + (and (save-excursion + (beginning-of-line) + (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:"))) + (> (point) (match-end 0)) + (org--flyspell-object-check-p element))) + ;; Ignore checks in LOGBOOK (or equivalent) drawer. + ((let ((log (org-log-into-drawer))) + (and log + (let ((drawer (org-element-lineage element '(drawer)))) + (and drawer + (eq (compare-strings + log nil nil + (org-element-property :drawer-name drawer) nil nil t) + t))))) + nil) + (t + (cl-case (org-element-type element) + ((comment quote-section) t) + (comment-block + ;; Allow checks between block markers, not on them. + (and (> (line-beginning-position) post-affiliated) + (save-excursion + (end-of-line) + (skip-chars-forward " \r\t\n") + (< (point) (org-element-property :end element))))) + ;; Arbitrary list of keywords where checks are meaningful. + ;; Make sure point is on the value part of the element. + (keyword + (and (member (org-element-property :key element) + '("DESCRIPTION" "TITLE")) + (save-excursion + (search-backward ":" (line-beginning-position) t)))) + ;; Check is globally allowed in paragraphs verse blocks and + ;; table rows (after affiliated keywords) but some objects + ;; must not be affected. + ((paragraph table-row verse-block) + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (and cbeg (>= (point) cbeg) (< (point) cend) + (org--flyspell-object-check-p element)))))))))) +(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." - (and (org-bound-and-true-p flyspell-mode) + (and (bound-and-true-p flyspell-mode) (fboundp 'flyspell-delete-region-overlays) - (flyspell-delete-region-overlays beg end)) - (add-text-properties beg end '(org-no-flyspell t))) + (flyspell-delete-region-overlays beg end))) + +(defvar flyspell-delayed-commands) +(eval-after-load "flyspell" + '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command)) ;; Make `bookmark-jump' shows the jump location if it was hidden. (eval-after-load "bookmark" @@ -24008,17 +25098,38 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." (eval-after-load "ecb" '(defadvice ecb-method-clicked (after esf/org-show-context activate) "Make hierarchy visible when jumping into location from ECB tree buffer." - (if (derived-mode-p 'org-mode) - (org-show-context)))) + (when (derived-mode-p 'org-mode) + (org-show-context)))) (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." (and (derived-mode-p 'org-mode) - (or (outline-invisible-p) + (or (org-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) - (outline-invisible-p))) + (org-invisible-p))) (org-show-context 'bookmark-jump))) +(defun org-mark-jump-unhide () + "Make the point visible with `org-show-context' after jumping to the mark." + (when (and (derived-mode-p 'org-mode) + (org-invisible-p)) + (org-show-context 'mark-goto))) + +(eval-after-load "simple" + '(defadvice pop-to-mark-command (after org-make-visible activate) + "Make the point visible with `org-show-context'." + (org-mark-jump-unhide))) + +(eval-after-load "simple" + '(defadvice exchange-point-and-mark (after org-make-visible activate) + "Make the point visible with `org-show-context'." + (org-mark-jump-unhide))) + +(eval-after-load "simple" + '(defadvice pop-global-mark (after org-make-visible activate) + "Make the point visible with `org-show-context'." + (org-mark-jump-unhide))) + ;; Make session.el ignore our circular variable (defvar session-globals-exclude) (eval-after-load "session" diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el index 6ba70d700b..2a129e9de7 100644 --- a/lisp/org/ox-ascii.el +++ b/lisp/org/ox-ascii.el @@ -1,4 +1,4 @@ -;;; ox-ascii.el --- ASCII Back-End for Org Export Engine +;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -27,9 +27,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'ox) (require 'ox-publish) +(require 'cl-lib) (declare-function aa2u "ext:ascii-art-to-unicode" ()) @@ -49,8 +49,6 @@ (center-block . org-ascii-center-block) (clock . org-ascii-clock) (code . org-ascii-code) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) (drawer . org-ascii-drawer) (dynamic-block . org-ascii-dynamic-block) (entity . org-ascii-entity) @@ -71,12 +69,13 @@ (latex-fragment . org-ascii-latex-fragment) (line-break . org-ascii-line-break) (link . org-ascii-link) + (node-property . org-ascii-node-property) (paragraph . org-ascii-paragraph) (plain-list . org-ascii-plain-list) (plain-text . org-ascii-plain-text) (planning . org-ascii-planning) + (property-drawer . org-ascii-property-drawer) (quote-block . org-ascii-quote-block) - (quote-section . org-ascii-quote-section) (radio-target . org-ascii-radio-target) (section . org-ascii-section) (special-block . org-ascii-special-block) @@ -94,7 +93,6 @@ (underline . org-ascii-underline) (verbatim . org-ascii-verbatim) (verse-block . org-ascii-verse-block)) - :export-block "ASCII" :menu-entry '(?t "Export to Plain Text" ((?A "As ASCII buffer" @@ -119,7 +117,30 @@ (:filter-parse-tree org-ascii-filter-paragraph-spacing org-ascii-filter-comment-spacing) (:filter-section . org-ascii-filter-headline-blank-lines)) - :options-alist '((:ascii-charset nil nil org-ascii-charset))) + :options-alist + '((:subtitle "SUBTITLE" nil nil parse) + (:ascii-bullets nil nil org-ascii-bullets) + (:ascii-caption-above nil nil org-ascii-caption-above) + (:ascii-charset nil nil org-ascii-charset) + (:ascii-global-margin nil nil org-ascii-global-margin) + (:ascii-format-drawer-function nil nil org-ascii-format-drawer-function) + (:ascii-format-inlinetask-function + nil nil org-ascii-format-inlinetask-function) + (:ascii-headline-spacing nil nil org-ascii-headline-spacing) + (:ascii-indented-line-width nil nil org-ascii-indented-line-width) + (:ascii-inlinetask-width nil nil org-ascii-inlinetask-width) + (:ascii-inner-margin nil nil org-ascii-inner-margin) + (:ascii-links-to-notes nil nil org-ascii-links-to-notes) + (:ascii-list-margin nil nil org-ascii-list-margin) + (:ascii-paragraph-spacing nil nil org-ascii-paragraph-spacing) + (:ascii-quote-margin nil nil org-ascii-quote-margin) + (:ascii-table-keep-all-vertical-lines + nil nil org-ascii-table-keep-all-vertical-lines) + (:ascii-table-use-ascii-art nil nil org-ascii-table-use-ascii-art) + (:ascii-table-widen-columns nil nil org-ascii-table-widen-columns) + (:ascii-text-width nil nil org-ascii-text-width) + (:ascii-underline nil nil org-ascii-underline) + (:ascii-verbatim-format nil nil org-ascii-verbatim-format))) @@ -162,6 +183,15 @@ This margin is applied on both sides of the text." :package-version '(Org . "8.0") :type 'integer) +(defcustom org-ascii-list-margin 0 + "Width of margin used for plain lists, in characters. +This margin applies to top level list only, not to its +sub-lists." + :group 'org-export-ascii + :version "26.1" + :package-version '(Org . "8.3") + :type 'integer) + (defcustom org-ascii-inlinetask-width 30 "Width of inline tasks, in number of characters. This number ignores any margin." @@ -339,7 +369,7 @@ Otherwise, place it right after it." :type 'string) (defcustom org-ascii-format-drawer-function - (lambda (name contents width) contents) + (lambda (_name contents _width) contents) "Function called to format a drawer in ASCII. The function must accept three parameters: @@ -384,14 +414,18 @@ nil to ignore the inline task." ;; Internal functions fall into three categories. -;; The first one is about text formatting. The core function is -;; `org-ascii--current-text-width', which determines the current -;; text width allowed to a given element. In other words, it helps -;; keeping each line width within maximum text width defined in -;; `org-ascii-text-width'. Once this information is known, -;; `org-ascii--fill-string', `org-ascii--justify-string', -;; `org-ascii--box-string' and `org-ascii--indent-string' can -;; operate on a given output string. +;; The first one is about text formatting. The core functions are +;; `org-ascii--current-text-width' and +;; `org-ascii--current-justification', which determine, respectively, +;; the current text width allowed to a given element and its expected +;; justification. Once this information is known, +;; `org-ascii--fill-string', `org-ascii--justify-lines', +;; `org-ascii--justify-element' `org-ascii--box-string' and +;; `org-ascii--indent-string' can operate on a given output string. +;; In particular, justification happens at the regular (i.e., +;; non-greater) element level, which means that when the exporting +;; process reaches a container (e.g., a center block) content are +;; already justified. ;; The second category contains functions handling elements listings, ;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc' @@ -420,7 +454,8 @@ a communication channel. Optional argument JUSTIFY can specify any type of justification among `left', `center', `right' or `full'. A nil value is equivalent to `left'. For a justification that doesn't also fill -string, see `org-ascii--justify-string'. +string, see `org-ascii--justify-lines' and +`org-ascii--justify-block'. Return nil if S isn't a string." (when (stringp s) @@ -435,8 +470,8 @@ Return nil if S isn't a string." (fill-region (point-min) (point-max) justify)) (buffer-string))))) -(defun org-ascii--justify-string (s text-width how) - "Justify string S. +(defun org-ascii--justify-lines (s text-width how) + "Justify all lines in string S. TEXT-WIDTH is an integer specifying maximum length of a line. HOW determines the type of justification: it can be `left', `right', `full' or `center'." @@ -452,6 +487,48 @@ HOW determines the type of justification: it can be `left', (forward-line))) (buffer-string))) +(defun org-ascii--justify-element (contents element info) + "Justify CONTENTS of ELEMENT. +INFO is a plist used as a communication channel. Justification +is done according to the type of element. More accurately, +paragraphs are filled and other elements are justified as blocks, +that is according to the widest non blank line in CONTENTS." + (if (not (org-string-nw-p contents)) contents + (let ((text-width (org-ascii--current-text-width element info)) + (how (org-ascii--current-justification element))) + (cond + ((eq (org-element-type element) 'paragraph) + ;; Paragraphs are treated specially as they need to be filled. + (org-ascii--fill-string contents text-width info how)) + ((eq how 'left) contents) + (t (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (catch 'exit + (let ((max-width 0)) + ;; Compute maximum width. Bail out if it is greater + ;; than page width, since no justification is + ;; possible. + (save-excursion + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (end-of-line) + (let ((column (current-column))) + (cond + ((>= column text-width) (throw 'exit contents)) + ((> column max-width) (setq max-width column))))) + (forward-line))) + ;; Justify every line according to TEXT-WIDTH and + ;; MAX-WIDTH. + (let ((offset (/ (- text-width max-width) + (if (eq how 'right) 1 2)))) + (if (zerop offset) (throw 'exit contents) + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (indent-to-column offset)) + (forward-line))))) + (buffer-string)))))))) + (defun org-ascii--indent-string (s width) "Indent string S by WIDTH white spaces. Empty lines are not indented." @@ -472,26 +549,28 @@ INFO is a plist used as a communication channel." (defun org-ascii--current-text-width (element info) "Return maximum text width for ELEMENT's contents. INFO is a plist used as a communication channel." - (case (org-element-type element) + (pcase (org-element-type element) ;; Elements with an absolute width: `headline' and `inlinetask'. - (inlinetask org-ascii-inlinetask-width) - (headline - (- org-ascii-text-width + (`inlinetask (plist-get info :ascii-inlinetask-width)) + (`headline + (- (plist-get info :ascii-text-width) (let ((low-level-rank (org-export-low-level-p element info))) - (if low-level-rank (* low-level-rank 2) org-ascii-global-margin)))) + (if low-level-rank (* low-level-rank 2) + (plist-get info :ascii-global-margin))))) ;; Elements with a relative width: store maximum text width in ;; TOTAL-WIDTH. - (otherwise - (let* ((genealogy (cons element (org-export-get-genealogy element))) + (_ + (let* ((genealogy (org-element-lineage element nil t)) ;; Total width is determined by the presence, or not, of an ;; inline task among ELEMENT parents. (total-width - (if (loop for parent in genealogy - thereis (eq (org-element-type parent) 'inlinetask)) - org-ascii-inlinetask-width + (if (cl-some (lambda (parent) + (eq (org-element-type parent) 'inlinetask)) + genealogy) + (plist-get info :ascii-inlinetask-width) ;; No inlinetask: Remove global margin from text width. - (- org-ascii-text-width - org-ascii-global-margin + (- (plist-get info :ascii-text-width) + (plist-get info :ascii-global-margin) (let ((parent (org-export-get-parent-headline element))) ;; Inner margin doesn't apply to text before first ;; headline. @@ -502,41 +581,67 @@ INFO is a plist used as a communication channel." ;; low level headlines, since they've got their ;; own indentation mechanism. (if low-level-rank (* low-level-rank 2) - org-ascii-inner-margin)))))))) + (plist-get info :ascii-inner-margin))))))))) (- total-width - ;; Each `quote-block', `quote-section' and `verse-block' above - ;; narrows text width by twice the standard margin size. - (+ (* (loop for parent in genealogy - when (memq (org-element-type parent) - '(quote-block quote-section verse-block)) - count parent) - 2 org-ascii-quote-margin) + ;; Each `quote-block' and `verse-block' above narrows text + ;; width by twice the standard margin size. + (+ (* (cl-count-if (lambda (parent) + (memq (org-element-type parent) + '(quote-block verse-block))) + genealogy) + 2 + (plist-get info :ascii-quote-margin)) + ;; Apply list margin once per "top-level" plain-list + ;; containing current line + (* (cl-count-if + (lambda (e) + (and (eq (org-element-type e) 'plain-list) + (not (eq (org-element-type (org-export-get-parent e)) + 'item)))) + genealogy) + (plist-get info :ascii-list-margin)) ;; Text width within a plain-list is restricted by ;; indentation of current item. If that's the case, ;; compute it with the help of `:structure' property from ;; parent item, if any. - (let ((parent-item + (let ((item (if (eq (org-element-type element) 'item) element - (loop for parent in genealogy - when (eq (org-element-type parent) 'item) - return parent)))) - (if (not parent-item) 0 + (cl-find-if (lambda (parent) + (eq (org-element-type parent) 'item)) + genealogy)))) + (if (not item) 0 ;; Compute indentation offset of the current item, ;; that is the sum of the difference between its ;; indentation and the indentation of the top item in ;; the list and current item bullet's length. Also ;; remove checkbox length, and tag length (for ;; description lists) or bullet length. - (let ((struct (org-element-property :structure parent-item)) - (beg-item (org-element-property :begin parent-item))) + (let ((struct (org-element-property :structure item)) + (beg-item (org-element-property :begin item))) (+ (- (org-list-get-ind beg-item struct) (org-list-get-ind (org-list-get-top-point struct) struct)) - (string-width (or (org-ascii--checkbox parent-item info) + (string-width (or (org-ascii--checkbox item info) "")) (string-width - (or (org-list-get-tag beg-item struct) - (org-list-get-bullet beg-item struct))))))))))))) + (let ((tag (org-element-property :tag item))) + (if tag (org-export-data tag info) + (org-element-property :bullet item)))))))))))))) + +(defun org-ascii--current-justification (element) + "Return expected justification for ELEMENT's contents. +Return value is a symbol among `left', `center', `right' and +`full'." + (let (justification) + (while (and (not justification) + (setq element (org-element-property :parent element))) + (pcase (org-element-type element) + (`center-block (setq justification 'center)) + (`special-block + (let ((name (org-element-property :type element))) + (cond ((string= name "JUSTIFYRIGHT") (setq justification 'right)) + ((string= name "JUSTIFYLEFT") (setq justification 'left))))))) + (or justification 'left))) (defun org-ascii--build-title (element info text-width &optional underline notags toc) @@ -601,14 +706,14 @@ possible. It doesn't apply to `inlinetask' elements." (let ((under-char (nth (1- (org-export-get-relative-level element info)) (cdr (assq (plist-get info :ascii-charset) - org-ascii-underline))))) + (plist-get info :ascii-underline)))))) (and under-char (concat "\n" (make-string (/ (string-width first-part) (char-width under-char)) under-char)))))))) -(defun org-ascii--has-caption-p (element info) +(defun org-ascii--has-caption-p (element _info) "Non-nil when ELEMENT has a caption affiliated keyword. INFO is a plist used as a communication channel. This function is meant to be used as a predicate for `org-export-get-ordinal'." @@ -630,9 +735,9 @@ caption keyword." (org-export-get-ordinal element info nil 'org-ascii--has-caption-p)) (title-fmt (org-ascii--translate - (case (org-element-type element) - (table "Table %d:") - (src-block "Listing %d:")) + (pcase (org-element-type element) + (`table "Table %d:") + (`src-block "Listing %d:")) info))) (org-ascii--fill-string (concat (format title-fmt reference) @@ -640,7 +745,7 @@ caption keyword." (org-export-data caption info)) (org-ascii--current-text-width element info) info))))) -(defun org-ascii--build-toc (info &optional n keyword) +(defun org-ascii--build-toc (info &optional n keyword local) "Return a table of contents. INFO is a plist used as a communication channel. @@ -649,28 +754,34 @@ Optional argument N, when non-nil, is an integer specifying the depth of the table. Optional argument KEYWORD specifies the TOC keyword, if any, from -which the table of contents generation has been initiated." - (let ((title (org-ascii--translate "Table of Contents" info))) - (concat - title "\n" - (make-string (string-width title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) - "\n\n" - (let ((text-width - (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin)))) - (mapconcat - (lambda (headline) - (let* ((level (org-export-get-relative-level headline info)) - (indent (* (1- level) 3))) - (concat - (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) - (org-ascii--build-title - headline info (- text-width indent) nil - (or (not (plist-get info :with-tags)) - (eq (plist-get info :with-tags) 'not-in-toc)) - 'toc)))) - (org-export-collect-headlines info n) "\n"))))) +which the table of contents generation has been initiated. + +When optional argument LOCAL is non-nil, build a table of +contents according to the current headline." + (concat + (unless local + (let ((title (org-ascii--translate "Table of Contents" info))) + (concat title "\n" + (make-string + (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n"))) + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- (plist-get info :ascii-text-width) + (plist-get info :ascii-global-margin))))) + (mapconcat + (lambda (headline) + (let* ((level (org-export-get-relative-level headline info)) + (indent (* (1- level) 3))) + (concat + (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) + (org-ascii--build-title + headline info (- text-width indent) nil + (or (not (plist-get info :with-tags)) + (eq (plist-get info :with-tags) 'not-in-toc)) + 'toc)))) + (org-export-collect-headlines info n (and local keyword)) "\n")))) (defun org-ascii--list-listings (keyword info) "Return a list of listings. @@ -685,7 +796,8 @@ generation. INFO is a plist used as a communication channel." "\n\n" (let ((text-width (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin))) + (- (plist-get info :ascii-text-width) + (plist-get info :ascii-global-margin)))) ;; Use a counter instead of retrieving ordinal of each ;; src-block. (count 0)) @@ -696,7 +808,7 @@ generation. INFO is a plist used as a communication channel." ;; filling (like contents of a description list item). (let* ((initial-text (format (org-ascii--translate "Listing %d:" info) - (incf count))) + (cl-incf count))) (initial-width (string-width initial-text))) (concat initial-text " " @@ -724,7 +836,8 @@ generation. INFO is a plist used as a communication channel." "\n\n" (let ((text-width (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin))) + (- (plist-get info :ascii-text-width) + (plist-get info :ascii-global-margin)))) ;; Use a counter instead of retrieving ordinal of each ;; src-block. (count 0)) @@ -735,7 +848,7 @@ generation. INFO is a plist used as a communication channel." ;; filling (like contents of a description list item). (let* ((initial-text (format (org-ascii--translate "Table %d:" info) - (incf count))) + (cl-incf count))) (initial-width (string-width initial-text))) (concat initial-text " " @@ -756,69 +869,105 @@ ELEMENT is either a headline element or a section element. INFO is a plist used as a communication channel." (let* (seen (unique-link-p - (function - ;; Return LINK if it wasn't referenced so far, or nil. - ;; Update SEEN links along the way. - (lambda (link) - (let ((footprint - ;; Normalize description in footprints. - (cons (org-element-property :raw-link link) - (let ((contents (org-element-contents link))) - (and contents - (replace-regexp-in-string - "[ \r\t\n]+" " " - (org-trim - (org-element-interpret-data contents)))))))) - ;; Ignore LINK if it hasn't been translated already. - ;; It can happen if it is located in an affiliated - ;; keyword that was ignored. - (when (and (org-string-nw-p - (gethash link (plist-get info :exported-data))) - (not (member footprint seen))) - (push footprint seen) link))))) - ;; If at a section, find parent headline, if any, in order to - ;; count links that might be in the title. - (headline - (if (eq (org-element-type element) 'headline) element - (or (org-export-get-parent-headline element) element)))) - ;; Get all links in HEADLINE. - (org-element-map headline 'link - (lambda (l) (funcall unique-link-p l)) info nil nil t))) + ;; Return LINK if it wasn't referenced so far, or nil. + ;; Update SEEN links along the way. + (lambda (link) + (let ((footprint + ;; Normalize description in footprints. + (cons (org-element-property :raw-link link) + (let ((contents (org-element-contents link))) + (and contents + (replace-regexp-in-string + "[ \r\t\n]+" " " + (org-trim + (org-element-interpret-data contents)))))))) + ;; Ignore LINK if it hasn't been translated already. It + ;; can happen if it is located in an affiliated keyword + ;; that was ignored. + (when (and (org-string-nw-p + (gethash link (plist-get info :exported-data))) + (not (member footprint seen))) + (push footprint seen) link))))) + (org-element-map (if (eq (org-element-type element) 'section) + element + ;; In a headline, only retrieve links in title + ;; and relative section, not in children. + (list (org-element-property :title element) + (car (org-element-contents element)))) + 'link unique-link-p info nil 'headline t))) + +(defun org-ascii--describe-datum (datum info) + "Describe DATUM object or element. +If DATUM is a string, consider it to be a file name, per +`org-export-resolve-id-link'. INFO is the communication channel, +as a plist." + (pcase (org-element-type datum) + (`plain-text (format "See file %s" datum)) ;External file + (`headline + (format (org-ascii--translate "See section %s" info) + (if (org-export-numbered-headline-p datum info) + (mapconcat #'number-to-string + (org-export-get-headline-number datum info) + ".") + (org-export-data (org-element-property :title datum) info)))) + (_ + (let ((number (org-export-get-ordinal + datum info nil #'org-ascii--has-caption-p)) + ;; If destination is a target, make sure we can name the + ;; container it refers to. + (enumerable + (org-element-lineage datum '(headline paragrah src-block table) t))) + (pcase (org-element-type enumerable) + (`headline + (format (org-ascii--translate "See section %s" info) + (if (org-export-numbered-headline-p enumerable info) + (mapconcat #'number-to-string number ".") + (org-export-data + (org-element-property :title enumerable) info)))) + ((guard (not number)) + (org-ascii--translate "Unknown reference" info)) + (`paragraph + (format (org-ascii--translate "See figure %s" info) number)) + (`src-block + (format (org-ascii--translate "See listing %s" info) number)) + (`table + (format (org-ascii--translate "See table %s" info) number)) + (_ (org-ascii--translate "Unknown reference" info))))))) (defun org-ascii--describe-links (links width info) "Return a string describing a list of links. - LINKS is a list of link type objects, as returned by `org-ascii--unique-links'. WIDTH is the text width allowed for the output string. INFO is a plist used as a communication channel." (mapconcat (lambda (link) - (let ((type (org-element-property :type link)) - (anchor (let ((desc (org-element-contents link))) - (if desc (org-export-data desc info) - (org-element-property :raw-link link))))) + (let* ((type (org-element-property :type link)) + (description (org-element-contents link)) + (anchor (org-export-data + (or description (org-element-property :raw-link link)) + info))) (cond - ;; Coderefs, radio links and fuzzy links are ignored. - ((member type '("coderef" "radio" "fuzzy")) nil) - ;; Id and custom-id links: Headlines refer to their numbering. - ((member type '("custom-id" "id")) - (let ((dest (org-export-resolve-id-link link info))) - (concat - (org-ascii--fill-string - (format - "[%s] %s" - anchor - (if (not dest) (org-ascii--translate "Unknown reference" info) - (format - (org-ascii--translate "See section %s" info) - (mapconcat 'number-to-string - (org-export-get-headline-number dest info) ".")))) - width info) "\n\n"))) + ((member type '("coderef" "radio")) nil) + ((member type '("custom-id" "fuzzy" "id")) + ;; Only links with a description need an entry. Other are + ;; already handled in `org-ascii-link'. + (when description + (let ((dest (if (equal type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (concat + (org-ascii--fill-string + (format "[%s] %s" anchor (org-ascii--describe-datum dest info)) + width info) + "\n\n")))) ;; Do not add a link that cannot be resolved and doesn't have ;; any description: destination is already visible in the ;; paragraph. ((not (org-element-contents link)) nil) + ;; Do not add a link already handled by custom export + ;; functions. + ((org-export-custom-protocol-maybe link anchor 'ascii) nil) (t (concat (org-ascii--fill-string @@ -831,10 +980,10 @@ channel." "Return checkbox string for ITEM or nil. INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (case (org-element-property :checkbox item) - (on (if utf8p "☑ " "[X] ")) - (off (if utf8p "☐ " "[ ] ")) - (trans (if utf8p "☒ " "[-] "))))) + (pcase (org-element-property :checkbox item) + (`on (if utf8p "☑ " "[X] ")) + (`off (if utf8p "☐ " "[ ] ")) + (`trans (if utf8p "☒ " "[-] "))))) @@ -843,11 +992,15 @@ INFO is a plist used as a communication channel." (defun org-ascii-template--document-title (info) "Return document title, as a string. INFO is a plist used as a communication channel." - (let* ((text-width org-ascii-text-width) + (let* ((text-width (plist-get info :ascii-text-width)) ;; Links in the title will not be resolved later, so we make ;; sure their path is located right after them. - (org-ascii-links-to-notes nil) - (title (org-export-data (plist-get info :title) info)) + (info (org-combine-plists info '(:ascii-links-to-notes nil))) + (with-title (plist-get info :with-title)) + (title (org-export-data + (when with-title (plist-get info :title)) info)) + (subtitle (org-export-data + (when with-title (plist-get info :subtitle)) info)) (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-data auth info))))) @@ -878,7 +1031,7 @@ INFO is a plist used as a communication channel." date "\n\n\n")) ((org-string-nw-p date) (concat - (org-ascii--justify-string date text-width 'right) + (org-ascii--justify-lines date text-width 'right) "\n\n\n")) ((and (org-string-nw-p author) (org-string-nw-p email)) (concat author "\n" email "\n\n\n")) @@ -890,8 +1043,14 @@ INFO is a plist used as a communication channel." (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) ;; Format TITLE. It may be filled if it is too wide, ;; that is wider than the two thirds of the total width. - (title-len (min (length title) (/ (* 2 text-width) 3))) + (title-len (min (apply #'max + (mapcar #'length + (org-split-string + (concat title "\n" subtitle) "\n"))) + (/ (* 2 text-width) 3))) (formatted-title (org-ascii--fill-string title title-len info)) + (formatted-subtitle (when (org-string-nw-p subtitle) + (org-ascii--fill-string subtitle title-len info))) (line (make-string (min (+ (max title-len @@ -899,17 +1058,16 @@ INFO is a plist used as a communication channel." (string-width (or email ""))) 2) text-width) (if utf8p ?━ ?_)))) - (org-ascii--justify-string + (org-ascii--justify-lines (concat line "\n" (unless utf8p "\n") (upcase formatted-title) + (and formatted-subtitle (concat "\n" formatted-subtitle)) (cond ((and (org-string-nw-p author) (org-string-nw-p email)) - (concat (if utf8p "\n\n\n" "\n\n") author "\n" email)) - ((org-string-nw-p author) - (concat (if utf8p "\n\n\n" "\n\n") author)) - ((org-string-nw-p email) - (concat (if utf8p "\n\n\n" "\n\n") email))) + (concat "\n\n" author "\n" email)) + ((org-string-nw-p author) (concat "\n\n" author)) + ((org-string-nw-p email) (concat "\n\n" email))) "\n" line (when (org-string-nw-p date) (concat "\n\n\n" date)) "\n\n\n") text-width 'center))))) @@ -919,81 +1077,83 @@ INFO is a plist used as a communication channel." CONTENTS is the transcoded contents string. INFO is a plist holding export options." (org-element-normalize-string - (org-ascii--indent-string - (concat - ;; 1. Document's body. - contents - ;; 2. Footnote definitions. - (let ((definitions (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) - ;; Insert full links right inside the footnote definition - ;; as they have no chance to be inserted later. - (org-ascii-links-to-notes nil)) - (when definitions - (concat - "\n\n\n" - (let ((title (org-ascii--translate "Footnotes" info))) - (concat - title "\n" - (make-string - (string-width title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) - "\n\n" - (let ((text-width (- org-ascii-text-width org-ascii-global-margin))) - (mapconcat - (lambda (ref) - (let ((id (format "[%s] " (car ref)))) - ;; Distinguish between inline definitions and - ;; full-fledged definitions. - (org-trim - (let ((def (nth 2 ref))) - (if (eq (org-element-type def) 'org-data) - ;; Full-fledged definition: footnote ID is - ;; inserted inside the first parsed paragraph - ;; (FIRST), if any, to be sure filling will - ;; take it into consideration. - (let ((first (car (org-element-contents def)))) - (if (not (eq (org-element-type first) 'paragraph)) - (concat id "\n" (org-export-data def info)) - (push id (nthcdr 2 first)) - (org-export-data def info))) - ;; Fill paragraph once footnote ID is inserted - ;; in order to have a correct length for first - ;; line. - (org-ascii--fill-string - (concat id (org-export-data def info)) - text-width info)))))) - definitions "\n\n")))))) - org-ascii-global-margin))) + (let ((global-margin (plist-get info :ascii-global-margin))) + (org-ascii--indent-string + (concat + ;; 1. Document's body. + contents + ;; 2. Footnote definitions. + (let ((definitions (org-export-collect-footnote-definitions info)) + ;; Insert full links right inside the footnote definition + ;; as they have no chance to be inserted later. + (info (org-combine-plists info '(:ascii-links-to-notes nil)))) + (when definitions + (concat + "\n\n\n" + (let ((title (org-ascii--translate "Footnotes" info))) + (concat + title "\n" + (make-string + (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) + "\n\n" + (let ((text-width (- (plist-get info :ascii-text-width) + global-margin))) + (mapconcat + (lambda (ref) + (let ((id (format "[%s] " (car ref)))) + ;; Distinguish between inline definitions and + ;; full-fledged definitions. + (org-trim + (let ((def (nth 2 ref))) + (if (org-element-map def org-element-all-elements + #'identity info 'first-match) + ;; Full-fledged definition: footnote ID is + ;; inserted inside the first parsed + ;; paragraph (FIRST), if any, to be sure + ;; filling will take it into consideration. + (let ((first (car (org-element-contents def)))) + (if (not (eq (org-element-type first) 'paragraph)) + (concat id "\n" (org-export-data def info)) + (push id (nthcdr 2 first)) + (org-export-data def info))) + ;; Fill paragraph once footnote ID is inserted + ;; in order to have a correct length for first + ;; line. + (org-ascii--fill-string + (concat id (org-export-data def info)) + text-width info)))))) + definitions "\n\n")))))) + global-margin)))) (defun org-ascii-template (contents info) "Return complete document string after ASCII conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." - (concat - ;; 1. Build title block. - (org-ascii--indent-string - (concat (org-ascii-template--document-title info) - ;; 2. Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat - (org-ascii--build-toc info (and (wholenump depth) depth)) - "\n\n\n")))) - org-ascii-global-margin) - ;; 3. Document's body. - contents - ;; 4. Creator. Ignore `comment' value as there are no comments in - ;; ASCII. Justify it to the bottom right. - (org-ascii--indent-string - (let ((creator-info (plist-get info :with-creator)) - (text-width (- org-ascii-text-width org-ascii-global-margin))) - (unless (or (not creator-info) (eq creator-info 'comment)) - (concat - "\n\n\n" - (org-ascii--fill-string - (plist-get info :creator) text-width info 'right)))) - org-ascii-global-margin))) + (let ((global-margin (plist-get info :ascii-global-margin))) + (concat + ;; Build title block. + (org-ascii--indent-string + (concat (org-ascii-template--document-title info) + ;; 2. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (org-ascii--build-toc info (and (wholenump depth) depth)) + "\n\n\n")))) + global-margin) + ;; Document's body. + contents + ;; Creator. Justify it to the bottom right. + (and (plist-get info :with-creator) + (org-ascii--indent-string + (let ((text-width + (- (plist-get info :ascii-text-width) global-margin))) + (concat + "\n\n\n" + (org-ascii--fill-string + (plist-get info :creator) text-width info 'right))) + global-margin))))) (defun org-ascii--translate (s info) "Translate string S according to specified language and charset. @@ -1007,7 +1167,7 @@ INFO is a plist used as a communication channel." ;;;; Bold -(defun org-ascii-bold (bold contents info) +(defun org-ascii-bold (_bold contents _info) "Transcode BOLD from Org to ASCII. CONTENTS is the text with bold markup. INFO is a plist holding contextual information." @@ -1016,39 +1176,41 @@ contextual information." ;;;; Center Block -(defun org-ascii-center-block (center-block contents info) +(defun org-ascii-center-block (_center-block contents _info) "Transcode a CENTER-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (org-ascii--justify-string - contents (org-ascii--current-text-width center-block info) 'center)) + ;; Center has already been taken care of at a lower level, so + ;; there's nothing left to do. + contents) ;;;; Clock -(defun org-ascii-clock (clock contents info) +(defun org-ascii-clock (clock _contents info) "Transcode a CLOCK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (concat org-clock-string " " - (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) - (let ((time (org-element-property :duration clock))) - (and time - (concat " => " - (apply 'format - "%2s:%02s" - (org-split-string time ":"))))))) + (org-ascii--justify-element + (concat org-clock-string " " + (org-timestamp-translate (org-element-property :value clock)) + (let ((time (org-element-property :duration clock))) + (and time + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string time ":")))))) + clock info)) ;;;; Code -(defun org-ascii-code (code contents info) +(defun org-ascii-code (code _contents info) "Return a CODE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (format org-ascii-verbatim-format (org-element-property :value code))) + (format (plist-get info :ascii-verbatim-format) + (org-element-property :value code))) ;;;; Drawer @@ -1059,12 +1221,13 @@ CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((name (org-element-property :drawer-name drawer)) (width (org-ascii--current-text-width drawer info))) - (funcall org-ascii-format-drawer-function name contents width))) + (funcall (plist-get info :ascii-format-drawer-function) + name contents width))) ;;;; Dynamic Block -(defun org-ascii-dynamic-block (dynamic-block contents info) +(defun org-ascii-dynamic-block (_dynamic-block contents _info) "Transcode a DYNAMIC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." @@ -1073,7 +1236,7 @@ holding contextual information." ;;;; Entity -(defun org-ascii-entity (entity contents info) +(defun org-ascii-entity (entity _contents info) "Transcode an ENTITY object from Org to ASCII. CONTENTS are the definition itself. INFO is a plist holding contextual information." @@ -1084,16 +1247,18 @@ contextual information." ;;;; Example Block -(defun org-ascii-example-block (example-block contents info) +(defun org-ascii-example-block (example-block _contents info) "Transcode a EXAMPLE-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-ascii--box-string - (org-export-format-code-default example-block info) info)) + (org-ascii--justify-element + (org-ascii--box-string + (org-export-format-code-default example-block info) info) + example-block info)) ;;;; Export Snippet -(defun org-ascii-export-snippet (export-snippet contents info) +(defun org-ascii-export-snippet (export-snippet _contents _info) "Transcode a EXPORT-SNIPPET object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (eq (org-export-snippet-backend export-snippet) 'ascii) @@ -1102,21 +1267,24 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Export Block -(defun org-ascii-export-block (export-block contents info) +(defun org-ascii-export-block (export-block _contents info) "Transcode a EXPORT-BLOCK element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (string= (org-element-property :type export-block) "ASCII") - (org-remove-indentation (org-element-property :value export-block)))) + (org-ascii--justify-element + (org-element-property :value export-block) export-block info))) ;;;; Fixed Width -(defun org-ascii-fixed-width (fixed-width contents info) +(defun org-ascii-fixed-width (fixed-width _contents info) "Transcode a FIXED-WIDTH element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (org-ascii--box-string - (org-remove-indentation - (org-element-property :value fixed-width)) info)) + (org-ascii--justify-element + (org-ascii--box-string + (org-remove-indentation + (org-element-property :value fixed-width)) info) + fixed-width info)) ;;;; Footnote Definition @@ -1127,7 +1295,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Footnote Reference -(defun org-ascii-footnote-reference (footnote-reference contents info) +(defun org-ascii-footnote-reference (footnote-reference _contents info) "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (format "[%s]" (org-export-get-footnote-number footnote-reference info))) @@ -1142,57 +1310,62 @@ holding contextual information." ;; Don't export footnote section, which will be handled at the end ;; of the template. (unless (org-element-property :footnote-section-p headline) - (let* ((low-level-rank (org-export-low-level-p headline info)) + (let* ((low-level (org-export-low-level-p headline info)) (width (org-ascii--current-text-width headline info)) + ;; Export title early so that any link in it can be + ;; exported and seen in `org-ascii--unique-links'. + (title (org-ascii--build-title headline info width (not low-level))) ;; Blank lines between headline and its contents. ;; `org-ascii-headline-spacing', when set, overwrites ;; original buffer's spacing. (pre-blanks - (make-string - (if org-ascii-headline-spacing (car org-ascii-headline-spacing) - (org-element-property :pre-blank headline)) ?\n)) - ;; Even if HEADLINE has no section, there might be some - ;; links in its title that we shouldn't forget to describe. - (links - (unless (or (eq (caar (org-element-contents headline)) 'section)) - (let ((title (org-element-property :title headline))) - (when (consp title) - (org-ascii--describe-links - (org-ascii--unique-links title info) width info)))))) + (make-string (or (car (plist-get info :ascii-headline-spacing)) + (org-element-property :pre-blank headline) + 0) + ?\n)) + (links (and (plist-get info :ascii-links-to-notes) + (org-ascii--describe-links + (org-ascii--unique-links headline info) width info))) + ;; Re-build contents, inserting section links at the right + ;; place. The cost is low since build results are cached. + (body + (if (not (org-string-nw-p links)) contents + (let* ((contents (org-element-contents headline)) + (section (let ((first (car contents))) + (and (eq (org-element-type first) 'section) + first)))) + (concat (and section + (concat (org-element-normalize-string + (org-export-data section info)) + "\n\n")) + links + (mapconcat (lambda (e) (org-export-data e info)) + (if section (cdr contents) contents) + "")))))) ;; Deep subtree: export it as a list item. - (if low-level-rank - (concat - ;; Bullet. - (let ((bullets (cdr (assq (plist-get info :ascii-charset) - org-ascii-bullets)))) - (char-to-string - (nth (mod (1- low-level-rank) (length bullets)) bullets))) - " " - ;; Title. - (org-ascii--build-title headline info width) "\n" - ;; Contents, indented by length of bullet. - pre-blanks - (org-ascii--indent-string - (concat contents - (when (org-string-nw-p links) (concat "\n\n" links))) - 2)) + (if low-level + (let* ((bullets (cdr (assq (plist-get info :ascii-charset) + (plist-get info :ascii-bullets)))) + (bullet + (format "%c " + (nth (mod (1- low-level) (length bullets)) bullets)))) + (concat bullet title "\n" pre-blanks + ;; Contents, indented by length of bullet. + (org-ascii--indent-string body (length bullet)))) ;; Else: Standard headline. - (concat - (org-ascii--build-title headline info width 'underline) - "\n" pre-blanks - (concat (when (org-string-nw-p links) links) contents)))))) + (concat title "\n" pre-blanks body))))) ;;;; Horizontal Rule -(defun org-ascii-horizontal-rule (horizontal-rule contents info) +(defun org-ascii-horizontal-rule (horizontal-rule _contents info) "Transcode an HORIZONTAL-RULE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (let ((text-width (org-ascii--current-text-width horizontal-rule info)) (spec-width (org-export-read-attribute :attr_ascii horizontal-rule :width))) - (org-ascii--justify-string + (org-ascii--justify-lines (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width)) (string-to-number spec-width) text-width) @@ -1202,23 +1375,23 @@ information." ;;;; Inline Src Block -(defun org-ascii-inline-src-block (inline-src-block contents info) +(defun org-ascii-inline-src-block (inline-src-block _contents info) "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (format org-ascii-verbatim-format + (format (plist-get info :ascii-verbatim-format) (org-element-property :value inline-src-block))) ;;;; Inlinetask (defun org-ascii-format-inlinetask-default - (todo type priority name tags contents width inlinetask info) + (_todo _type _priority _name _tags contents width inlinetask info) "Format an inline task element for ASCII export. See `org-ascii-format-inlinetask-function' for a description of the parameters." (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - (width (or width org-ascii-inlinetask-width))) + (width (or width (plist-get info :ascii-inlinetask-width)))) (org-ascii--indent-string (concat ;; Top line, with an additional blank line if not in UTF-8. @@ -1236,9 +1409,9 @@ of the parameters." ;; Bottom line. (make-string width (if utf8p ?━ ?_))) ;; Flush the inlinetask to the right. - (- org-ascii-text-width org-ascii-global-margin + (- (plist-get info :ascii-text-width) (plist-get info :ascii-global-margin) (if (not (org-export-get-parent-headline inlinetask)) 0 - org-ascii-inner-margin) + (plist-get info :ascii-inner-margin)) (org-ascii--current-text-width inlinetask info))))) (defun org-ascii-inlinetask (inlinetask contents info) @@ -1246,7 +1419,7 @@ of the parameters." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((width (org-ascii--current-text-width inlinetask info))) - (funcall org-ascii-format-inlinetask-function + (funcall (plist-get info :ascii-format-inlinetask-function) ;; todo. (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property @@ -1268,7 +1441,7 @@ holding contextual information." ;;;; Italic -(defun org-ascii-italic (italic contents info) +(defun org-ascii-italic (_italic contents _info) "Transcode italic from Org to ASCII. CONTENTS is the text with italic markup. INFO is a plist holding contextual information." @@ -1288,12 +1461,12 @@ contextual information." ;; First parent of ITEM is always the plain-list. Get ;; `:type' property from it. (org-list-bullet-string - (case list-type - (descriptive + (pcase list-type + (`descriptive (concat checkbox (org-export-data (org-element-property :tag item) info) ": ")) - (ordered + (`ordered ;; Return correct number for ITEM, paying attention to ;; counters. (let* ((struct (org-element-property :structure item)) @@ -1305,7 +1478,7 @@ contextual information." (org-list-prevs-alist struct) (org-list-parents-alist struct))))))) (replace-regexp-in-string "[0-9]+" num bul))) - (t (let ((bul (org-element-property :bullet item))) + (_ (let ((bul (org-element-property :bullet item))) ;; Change bullets into more visible form if UTF-8 is active. (if (not utf8p) bul (replace-regexp-in-string @@ -1327,42 +1500,45 @@ contextual information." ;;;; Keyword -(defun org-ascii-keyword (keyword contents info) +(defun org-ascii-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (let ((key (org-element-property :key keyword)) (value (org-element-property :value keyword))) (cond - ((string= key "ASCII") value) + ((string= key "ASCII") (org-ascii--justify-element value keyword info)) ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (org-ascii--build-toc - info (and (wholenump depth) depth) keyword))) - ((string= "tables" value) - (org-ascii--list-tables keyword info)) - ((string= "listings" value) - (org-ascii--list-listings keyword info)))))))) + (org-ascii--justify-element + (let ((case-fold-search t)) + (cond + ((string-match-p "\\" value) + (let ((depth (and (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (localp (string-match-p "\\" value))) + (org-ascii--build-toc info depth keyword localp))) + ((string-match-p "\\" value) + (org-ascii--list-tables keyword info)) + ((string-match-p "\\" value) + (org-ascii--list-listings keyword info)))) + keyword info))))) ;;;; Latex Environment -(defun org-ascii-latex-environment (latex-environment contents info) +(defun org-ascii-latex-environment (latex-environment _contents info) "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (when (plist-get info :with-latex) - (org-remove-indentation (org-element-property :value latex-environment)))) + (org-ascii--justify-element + (org-remove-indentation (org-element-property :value latex-environment)) + latex-environment info))) ;;;; Latex Fragment -(defun org-ascii-latex-fragment (latex-fragment contents info) +(defun org-ascii-latex-fragment (latex-fragment _contents info) "Transcode a LATEX-FRAGMENT object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." @@ -1372,7 +1548,7 @@ information." ;;;; Line Break -(defun org-ascii-line-break (line-break contents info) +(defun org-ascii-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." hard-newline) @@ -1385,9 +1561,9 @@ CONTENTS is nil. INFO is a plist holding contextual DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information." - (let ((raw-link (org-element-property :raw-link link)) - (type (org-element-property :type link))) + (let ((type (org-element-property :type link))) (cond + ((org-export-custom-protocol-maybe link desc 'ascii)) ((string= type "coderef") (let ((ref (org-element-property :path link))) (format (org-export-get-coderef-format ref desc) @@ -1395,23 +1571,51 @@ INFO is a plist holding contextual information." ;; Do not apply a special syntax on radio links. Though, use ;; transcoded target's contents as output. ((string= type "radio") desc) - ;; Do not apply a special syntax on fuzzy links pointing to - ;; targets. - ((string= type "fuzzy") - (let ((destination (org-export-resolve-fuzzy-link link info))) - (if (org-string-nw-p desc) desc - (when destination - (let ((number - (org-export-get-ordinal - destination info nil 'org-ascii--has-caption-p))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number ".")))))))) + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (pcase (org-element-type destination) + ((guard desc) + (if (plist-get info :ascii-links-to-notes) + (format "[%s]" desc) + (concat desc + (format " (%s)" + (org-ascii--describe-datum destination info))))) + ;; External file. + (`plain-text destination) + (`headline + (if (org-export-numbered-headline-p destination info) + (mapconcat #'number-to-string + (org-export-get-headline-number destination info) + ".") + (org-export-data (org-element-property :title destination) info))) + ;; Handle enumerable elements and targets within them. + ((and (let number (org-export-get-ordinal + destination info nil #'org-ascii--has-caption-p)) + (guard number)) + (if (atom number) (number-to-string number) + (mapconcat #'number-to-string number "."))) + ;; Don't know what to do. Signal it. + (_ "???")))) (t - (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) - (concat - (format "[%s]" desc) - (unless org-ascii-links-to-notes (format " (%s)" raw-link)))))))) + (let ((raw-link (org-element-property :raw-link link))) + (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) + (concat (format "[%s]" desc) + (and (not (plist-get info :ascii-links-to-notes)) + (format " (%s)" raw-link))))))))) + + +;;;; Node Properties + +(defun org-ascii-node-property (node-property _contents _info) + "Transcode a NODE-PROPERTY element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "%s:%s" + (org-element-property :key node-property) + (let ((value (org-element-property :value node-property))) + (if value (concat " " value) "")))) ;;;; Paragraph @@ -1420,16 +1624,17 @@ INFO is a plist holding contextual information." "Transcode a PARAGRAPH element from Org to ASCII. CONTENTS is the contents of the paragraph, as a string. INFO is the plist used as a communication channel." - (org-ascii--fill-string - (if (not (wholenump org-ascii-indented-line-width)) contents - (concat - ;; Do not indent first paragraph in a section. - (unless (and (not (org-export-get-previous-element paragraph info)) - (eq (org-element-type (org-export-get-parent paragraph)) - 'section)) - (make-string org-ascii-indented-line-width ?\s)) - (replace-regexp-in-string "\\`[ \t]+" "" contents))) - (org-ascii--current-text-width paragraph info) info)) + (org-ascii--justify-element + (let ((indented-line-width (plist-get info :ascii-indented-line-width))) + (if (not (wholenump indented-line-width)) contents + (concat + ;; Do not indent first paragraph in a section. + (unless (and (not (org-export-get-previous-element paragraph info)) + (eq (org-element-type (org-export-get-parent paragraph)) + 'section)) + (make-string indented-line-width ?\s)) + (replace-regexp-in-string "\\`[ \t]+" "" contents)))) + paragraph info)) ;;;; Plain List @@ -1438,7 +1643,11 @@ the plist used as a communication channel." "Transcode a PLAIN-LIST element from Org to ASCII. CONTENTS is the contents of the list. INFO is a plist holding contextual information." - contents) + (let ((margin (plist-get info :ascii-list-margin))) + (if (or (< margin 1) + (eq (org-element-type (org-export-get-parent plain-list)) 'item)) + contents + (org-ascii--indent-string contents margin)))) ;;;; Plain Text @@ -1462,62 +1671,52 @@ INFO is a plist used as a communication channel." ;;;; Planning -(defun org-ascii-planning (planning contents info) +(defun org-ascii-planning (planning _contents info) "Transcode a PLANNING element from Org to ASCII. CONTENTS is nil. INFO is a plist used as a communication channel." - (mapconcat - 'identity - (delq nil - (list (let ((closed (org-element-property :closed planning))) - (when closed - (concat org-closed-string " " - (org-translate-time - (org-element-property :raw-value closed))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat org-deadline-string " " - (org-translate-time - (org-element-property :raw-value deadline))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat org-scheduled-string " " - (org-translate-time - (org-element-property :raw-value scheduled))))))) - " ")) + (org-ascii--justify-element + (mapconcat + #'identity + (delq nil + (list (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-timestamp-translate closed)))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-timestamp-translate deadline)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " " + (org-timestamp-translate scheduled)))))) + " ") + planning info)) + + +;;;; Property Drawer + +(defun org-ascii-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to ASCII. +CONTENTS holds the contents of the drawer. INFO is a plist +holding contextual information." + (and (org-string-nw-p contents) + (org-ascii--justify-element contents property-drawer info))) ;;;; Quote Block -(defun org-ascii-quote-block (quote-block contents info) +(defun org-ascii-quote-block (_quote-block contents info) "Transcode a QUOTE-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." - (org-ascii--indent-string contents org-ascii-quote-margin)) - - -;;;; Quote Section - -(defun org-ascii-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((width (org-ascii--current-text-width quote-section info)) - (value - (org-export-data - (org-remove-indentation (org-element-property :value quote-section)) - info))) - (org-ascii--indent-string - value - (+ org-ascii-quote-margin - ;; Don't apply inner margin if parent headline is low level. - (let ((headline (org-export-get-parent-headline quote-section))) - (if (org-export-low-level-p headline info) 0 - org-ascii-inner-margin)))))) + (org-ascii--indent-string contents (plist-get info :ascii-quote-margin))) ;;;; Radio Target -(defun org-ascii-radio-target (radio-target contents info) +(defun org-ascii-radio-target (_radio-target contents _info) "Transcode a RADIO-TARGET object from Org to ASCII. CONTENTS is the contents of the target. INFO is a plist holding contextual information." @@ -1530,50 +1729,56 @@ contextual information." "Transcode a SECTION element from Org to ASCII. CONTENTS is the contents of the section. INFO is a plist holding contextual information." - (org-ascii--indent-string - (concat - contents - (when org-ascii-links-to-notes - ;; Add list of links at the end of SECTION. - (let ((links (org-ascii--describe-links - (org-ascii--unique-links section info) - (org-ascii--current-text-width section info) info))) - ;; Separate list of links and section contents. - (when (org-string-nw-p links) (concat "\n\n" links))))) - ;; Do not apply inner margin if parent headline is low level. - (let ((headline (org-export-get-parent-headline section))) - (if (or (not headline) (org-export-low-level-p headline info)) 0 - org-ascii-inner-margin)))) + (let ((links + (and (plist-get info :ascii-links-to-notes) + ;; Take care of links in first section of the document. + (not (org-element-lineage section '(headline))) + (org-ascii--describe-links + (org-ascii--unique-links section info) + (org-ascii--current-text-width section info) + info)))) + (org-ascii--indent-string + (if (not (org-string-nw-p links)) contents + (concat (org-element-normalize-string contents) "\n\n" links)) + ;; Do not apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline section))) + (if (or (not headline) (org-export-low-level-p headline info)) 0 + (plist-get info :ascii-inner-margin)))))) ;;;; Special Block -(defun org-ascii-special-block (special-block contents info) +(defun org-ascii-special-block (_special-block contents _info) "Transcode a SPECIAL-BLOCK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." + ;; "JUSTIFYLEFT" and "JUSTFYRIGHT" have already been taken care of + ;; at a lower level. There is no other special block type to + ;; handle. contents) ;;;; Src Block -(defun org-ascii-src-block (src-block contents info) +(defun org-ascii-src-block (src-block _contents info) "Transcode a SRC-BLOCK element from Org to ASCII. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." (let ((caption (org-ascii--build-caption src-block info)) + (caption-above-p (plist-get info :ascii-caption-above)) (code (org-export-format-code-default src-block info))) (if (equal code "") "" - (concat - (when (and caption org-ascii-caption-above) (concat caption "\n")) - (org-ascii--box-string code info) - (when (and caption (not org-ascii-caption-above)) - (concat "\n" caption)))))) + (org-ascii--justify-element + (concat + (and caption caption-above-p (concat caption "\n")) + (org-ascii--box-string code info) + (and caption (not caption-above-p) (concat "\n" caption))) + src-block info)))) ;;;; Statistics Cookie -(defun org-ascii-statistics-cookie (statistics-cookie contents info) +(defun org-ascii-statistics-cookie (statistics-cookie _contents _info) "Transcode a STATISTICS-COOKIE object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-element-property :value statistics-cookie)) @@ -1581,7 +1786,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Subscript -(defun org-ascii-subscript (subscript contents info) +(defun org-ascii-subscript (subscript contents _info) "Transcode a SUBSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1592,7 +1797,7 @@ contextual information." ;;;; Superscript -(defun org-ascii-superscript (superscript contents info) +(defun org-ascii-superscript (superscript contents _info) "Transcode a SUPERSCRIPT object from Org to ASCII. CONTENTS is the contents of the object. INFO is a plist holding contextual information." @@ -1603,7 +1808,7 @@ contextual information." ;;;; Strike-through -(defun org-ascii-strike-through (strike-through contents info) +(defun org-ascii-strike-through (_strike-through contents _info) "Transcode STRIKE-THROUGH from Org to ASCII. CONTENTS is text with strike-through markup. INFO is a plist holding contextual information." @@ -1616,26 +1821,29 @@ holding contextual information." "Transcode a TABLE element from Org to ASCII. CONTENTS is the contents of the table. INFO is a plist holding contextual information." - (let ((caption (org-ascii--build-caption table info))) - (concat - ;; Possibly add a caption string above. - (when (and caption org-ascii-caption-above) (concat caption "\n")) - ;; Insert table. Note: "table.el" tables are left unmodified. - (cond ((eq (org-element-property :type table) 'org) contents) - ((and org-ascii-table-use-ascii-art - (eq (plist-get info :ascii-charset) 'utf-8) - (require 'ascii-art-to-unicode nil t)) - (with-temp-buffer - (insert (org-remove-indentation - (org-element-property :value table))) - (goto-char (point-min)) - (aa2u) - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (buffer-substring (point-min) (point)))) - (t (org-remove-indentation (org-element-property :value table)))) - ;; Possible add a caption string below. - (and (not org-ascii-caption-above) caption)))) + (let ((caption (org-ascii--build-caption table info)) + (caption-above-p (plist-get info :ascii-caption-above))) + (org-ascii--justify-element + (concat + ;; Possibly add a caption string above. + (and caption caption-above-p (concat caption "\n")) + ;; Insert table. Note: "table.el" tables are left unmodified. + (cond ((eq (org-element-property :type table) 'org) contents) + ((and (plist-get info :ascii-table-use-ascii-art) + (eq (plist-get info :ascii-charset) 'utf-8) + (require 'ascii-art-to-unicode nil t)) + (with-temp-buffer + (insert (org-remove-indentation + (org-element-property :value table))) + (goto-char (point-min)) + (aa2u) + (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (buffer-substring (point-min) (point)))) + (t (org-remove-indentation (org-element-property :value table)))) + ;; Possible add a caption string below. + (and (not caption-above-p) caption)) + table info))) ;;;; Table Cell @@ -1661,12 +1869,13 @@ are ignored." (plist-put info :ascii-table-cell-width-cache (make-hash-table :test 'equal))) :ascii-table-cell-width-cache))) - (key (cons table col))) + (key (cons table col)) + (widenp (plist-get info :ascii-table-widen-columns))) (or (gethash key cache) (puthash key (let ((cookie-width (org-export-table-cell-width table-cell info))) - (or (and (not org-ascii-table-widen-columns) cookie-width) + (or (and (not widenp) cookie-width) (let ((contents-width (let ((max-width 0)) (org-element-map table 'table-row @@ -1681,8 +1890,7 @@ are ignored." info) max-width))) (cond ((not cookie-width) contents-width) - (org-ascii-table-widen-columns - (max cookie-width contents-width)) + (widenp (max cookie-width contents-width)) (t cookie-width))))) cache)))) @@ -1696,14 +1904,14 @@ a communication channel." ;; each cell in the column. (let ((width (org-ascii--table-cell-width table-cell info))) ;; When contents are too large, truncate them. - (unless (or org-ascii-table-widen-columns + (unless (or (plist-get info :ascii-table-widen-columns) (<= (string-width (or contents "")) width)) (setq contents (concat (substring contents 0 (- width 2)) "=>"))) ;; Align contents correctly within the cell. (let* ((indent-tabs-mode nil) (data (when contents - (org-ascii--justify-string + (org-ascii--justify-lines contents width (org-export-table-cell-alignment table-cell info))))) (setq contents @@ -1770,7 +1978,7 @@ a communication channel." ;;;; Timestamp -(defun org-ascii-timestamp (timestamp contents info) +(defun org-ascii-timestamp (timestamp _contents info) "Transcode a TIMESTAMP object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." (org-ascii-plain-text (org-timestamp-translate timestamp) info)) @@ -1778,7 +1986,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Underline -(defun org-ascii-underline (underline contents info) +(defun org-ascii-underline (_underline contents _info) "Transcode UNDERLINE from Org to ASCII. CONTENTS is the text with underline markup. INFO is a plist holding contextual information." @@ -1787,10 +1995,10 @@ holding contextual information." ;;;; Verbatim -(defun org-ascii-verbatim (verbatim contents info) +(defun org-ascii-verbatim (verbatim _contents info) "Return a VERBATIM object from Org to ASCII. CONTENTS is nil. INFO is a plist holding contextual information." - (format org-ascii-verbatim-format + (format (plist-get info :ascii-verbatim-format) (org-element-property :value verbatim))) @@ -1800,48 +2008,48 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Transcode a VERSE-BLOCK element from Org to ASCII. CONTENTS is verse block contents. INFO is a plist holding contextual information." - (let ((verse-width (org-ascii--current-text-width verse-block info))) - (org-ascii--indent-string - (org-ascii--justify-string contents verse-width 'left) - org-ascii-quote-margin))) + (org-ascii--indent-string + (org-ascii--justify-element contents verse-block info) + (plist-get info :ascii-quote-margin))) ;;; Filters -(defun org-ascii-filter-headline-blank-lines (headline back-end info) +(defun org-ascii-filter-headline-blank-lines (headline _backend info) "Filter controlling number of blank lines after a headline. -HEADLINE is a string representing a transcoded headline. -BACK-END is symbol specifying back-end used for export. INFO is -plist containing the communication channel. +HEADLINE is a string representing a transcoded headline. BACKEND +is symbol specifying back-end used for export. INFO is plist +containing the communication channel. This function only applies to `ascii' back-end. See `org-ascii-headline-spacing' for information." - (if (not org-ascii-headline-spacing) headline - (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n))) - (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))) + (let ((headline-spacing (plist-get info :ascii-headline-spacing))) + (if (not headline-spacing) headline + (let ((blanks (make-string (1+ (cdr headline-spacing)) ?\n))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))))) -(defun org-ascii-filter-paragraph-spacing (tree back-end info) +(defun org-ascii-filter-paragraph-spacing (tree _backend info) "Filter controlling number of blank lines between paragraphs. -TREE is the parse tree. BACK-END is the symbol specifying +TREE is the parse tree. BACKEND is the symbol specifying back-end used for export. INFO is a plist used as a communication channel. See `org-ascii-paragraph-spacing' for information." - (when (wholenump org-ascii-paragraph-spacing) - (org-element-map tree 'paragraph - (lambda (p) - (when (eq (org-element-type (org-export-get-next-element p info)) - 'paragraph) - (org-element-put-property - p :post-blank org-ascii-paragraph-spacing))))) + (let ((paragraph-spacing (plist-get info :ascii-paragraph-spacing))) + (when (wholenump paragraph-spacing) + (org-element-map tree 'paragraph + (lambda (p) + (when (eq (org-element-type (org-export-get-next-element p info)) + 'paragraph) + (org-element-put-property p :post-blank paragraph-spacing)))))) tree) -(defun org-ascii-filter-comment-spacing (tree backend info) +(defun org-ascii-filter-comment-spacing (tree _backend info) "Filter removing blank lines between comments. -TREE is the parse tree. BACK-END is the symbol specifying +TREE is the parse tree. BACKEND is the symbol specifying back-end used for export. INFO is a plist used as a communication channel." (org-element-map tree '(comment comment-block) diff --git a/lisp/org/ox-beamer.el b/lisp/org/ox-beamer.el index a8d48b6718..82651d3848 100644 --- a/lisp/org/ox-beamer.el +++ b/lisp/org/ox-beamer.el @@ -1,4 +1,4 @@ -;;; ox-beamer.el --- Beamer Back-End for Org Export Engine +;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2007-2017 Free Software Foundation, Inc. @@ -29,7 +29,7 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox-latex) ;; Install a default set-up for Beamer export. @@ -105,7 +105,9 @@ key Selection key for `org-beamer-select-environment' open The opening template for the environment, with the following escapes %a the action/overlay specification %A the default action/overlay specification - %o the options argument of the template + %R the raw BEAMER_act value + %o the options argument, with square brackets + %O the raw BEAMER_opt value %h the headline text %r the raw headline text (i.e. without any processing) %H if there is headline text, that raw text in {} braces @@ -133,6 +135,15 @@ You might want to put e.g. \"allowframebreaks=0.9\" here." :type '(string :tag "Outline frame options")) +(defcustom org-beamer-subtitle-format "\\subtitle{%s}" + "Format string used for transcoded subtitle. +The format string should have at most one \"%s\"-expression, +which is replaced with the subtitle." + :group 'org-export-beamer + :version "26.1" + :package-version '(Org . "8.3") + :type '(string :tag "Format string")) + ;;; Internal Variables @@ -191,19 +202,14 @@ TYPE is a symbol among the following: `defaction' Return ARGUMENT within both square and angular brackets. `option' Return ARGUMENT within square brackets." (if (not (string-match "\\S-" argument)) "" - (case type - (action (if (string-match "\\`<.*>\\'" argument) argument - (format "<%s>" argument))) - (defaction (cond - ((string-match "\\`\\[<.*>\\]\\'" argument) argument) - ((string-match "\\`<.*>\\'" argument) - (format "[%s]" argument)) - ((string-match "\\`\\[\\(.*\\)\\]\\'" argument) - (format "[<%s>]" (match-string 1 argument))) - (t (format "[<%s>]" argument)))) - (option (if (string-match "\\`\\[.*\\]\\'" argument) argument - (format "[%s]" argument))) - (otherwise argument)))) + (cl-case type + (action (format "<%s>" (org-unbracket-string "<" ">" argument))) + (defaction + (format "[<%s>]" + (org-unbracket-string "<" ">" (org-unbracket-string "[" "]" argument)))) + (option (format "[%s]" (org-unbracket-string "[" "]" argument))) + (otherwise (error "Invalid `type' argument to `org-beamer--normalize-argument': %s" + type))))) (defun org-beamer--element-has-overlay-p (element) "Non-nil when ELEMENT has an overlay specified. @@ -213,14 +219,14 @@ Return overlay specification, as a string, or nil." (let ((first-object (car (org-element-contents element)))) (when (eq (org-element-type first-object) 'export-snippet) (let ((value (org-element-property :value first-object))) - (and (string-match "\\`<.*>\\'" value) value))))) + (and (string-prefix-p "<" value) (string-suffix-p ">" value) + value))))) ;;; Define Back-End (org-export-define-derived-backend 'beamer 'latex - :export-block "BEAMER" :menu-entry '(?l 1 ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) @@ -231,15 +237,20 @@ Return overlay specification, as a string, or nil." (if a (org-beamer-export-to-pdf t s v b) (org-open-file (org-beamer-export-to-pdf nil s v b))))))) :options-alist - '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme) + '((:headline-levels nil "H" org-beamer-frame-level) + (:latex-class "LATEX_CLASS" nil "beamer" t) + (:beamer-subtitle-format nil nil org-beamer-subtitle-format) + (:beamer-column-view-format "COLUMNS" nil org-beamer-column-view-format) + (:beamer-theme "BEAMER_THEME" nil org-beamer-theme) (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) - (:beamer-header-extra "BEAMER_HEADER" nil nil newline) - ;; Modify existing properties. - (:headline-levels nil "H" org-beamer-frame-level) - (:latex-class "LATEX_CLASS" nil "beamer" t)) + (:beamer-header "BEAMER_HEADER" nil nil newline) + (:beamer-environments-extra nil nil org-beamer-environments-extra) + (:beamer-frame-default-options nil nil org-beamer-frame-default-options) + (:beamer-outline-frame-options nil nil org-beamer-outline-frame-options) + (:beamer-outline-frame-title nil nil org-beamer-outline-frame-title)) :translate-alist '((bold . org-beamer-bold) (export-block . org-beamer-export-block) (export-snippet . org-beamer-export-snippet) @@ -249,7 +260,6 @@ Return overlay specification, as a string, or nil." (link . org-beamer-link) (plain-list . org-beamer-plain-list) (radio-target . org-beamer-radio-target) - (target . org-beamer-target) (template . org-beamer-template))) @@ -258,7 +268,7 @@ Return overlay specification, as a string, or nil." ;;;; Bold -(defun org-beamer-bold (bold contents info) +(defun org-beamer-bold (bold contents _info) "Transcode BLOCK object into Beamer code. CONTENTS is the text being bold. INFO is a plist used as a communication channel." @@ -269,7 +279,7 @@ a communication channel." ;;;; Export Block -(defun org-beamer-export-block (export-block contents info) +(defun org-beamer-export-block (export-block _contents _info) "Transcode an EXPORT-BLOCK element into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -279,7 +289,7 @@ channel." ;;;; Export Snippet -(defun org-beamer-export-snippet (export-snippet contents info) +(defun org-beamer-export-snippet (export-snippet _contents info) "Transcode an EXPORT-SNIPPET object into Beamer code. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -315,16 +325,21 @@ channel." INFO is a plist used as a communication channel. The value is either the label specified in \"BEAMER_opt\" -property, or a fallback value built from headline's number. This -function assumes HEADLINE will be treated as a frame." - (let ((opt (org-element-property :BEAMER_OPT headline))) - (if (and (org-string-nw-p opt) - (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) - (match-string 1 opt) - (format "sec-%s" - (mapconcat 'number-to-string - (org-export-get-headline-number headline info) - "-"))))) +property, the custom ID, if there is one and +`:latex-prefer-user-labels' property has a non nil value, or +a unique internal label. This function assumes HEADLINE will be +treated as a frame." + (cond + ((let ((opt (org-element-property :BEAMER_OPT headline))) + (and (stringp opt) + (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt) + (let ((label (match-string 1 opt))) + (if (string-match-p "\\`{.*}\\'" label) + (substring label 1 -1) + label))))) + ((and (plist-get info :latex-prefer-user-labels) + (org-element-property :CUSTOM_ID headline))) + (t (format "sec:%s" (org-export-get-reference headline info))))) (defun org-beamer--frame-level (headline info) "Return frame level in subtree containing HEADLINE. @@ -333,12 +348,10 @@ INFO is a plist used as a communication channel." ;; 1. Look for "frame" environment in parents, starting from the ;; farthest. (catch 'exit - (mapc (lambda (parent) - (let ((env (org-element-property :BEAMER_ENV parent))) - (when (and env (member-ignore-case env '("frame" "fullframe"))) - (throw 'exit (org-export-get-relative-level parent info))))) - (nreverse (org-export-get-genealogy headline))) - nil) + (dolist (parent (nreverse (org-element-lineage headline))) + (let ((env (org-element-property :BEAMER_ENV parent))) + (when (and env (member-ignore-case env '("frame" "fullframe"))) + (throw 'exit (org-export-get-relative-level parent info)))))) ;; 2. Look for "frame" environment in HEADLINE. (let ((env (org-element-property :BEAMER_ENV headline))) (and env (member-ignore-case env '("frame" "fullframe")) @@ -413,7 +426,8 @@ used as a communication channel." ;; Collect options from default value and headline's ;; properties. Also add a label for links. (append - (org-split-string org-beamer-frame-default-options ",") + (org-split-string + (plist-get info :beamer-frame-default-options) ",") (and beamer-opt (org-split-string ;; Remove square brackets if user provided @@ -422,12 +436,20 @@ used as a communication channel." (match-string 1 beamer-opt)) ",")) ;; Provide an automatic label for the frame - ;; unless the user specified one. + ;; unless the user specified one. Also refrain + ;; from labeling `allowframebreaks' frames; this + ;; is not allowed by beamer. (unless (and beamer-opt - (string-match "\\(^\\|,\\)label=" beamer-opt)) + (or (string-match "\\(^\\|,\\)label=" beamer-opt) + (string-match "allowframebreaks" beamer-opt))) (list - (format "label=%s" - (org-beamer--get-label headline info))))))) + (let ((label (org-beamer--get-label headline info))) + ;; Labels containing colons need to be + ;; wrapped within braces. + (format (if (string-match-p ":" label) + "label={%s}" + "label=%s") + label))))))) ;; Change options list into a string. (org-beamer--normalize-argument (mapconcat @@ -475,14 +497,15 @@ used as a communication channel." (env-format (cond ((member environment '("column" "columns")) nil) ((assoc environment - (append org-beamer-environments-extra + (append (plist-get info :beamer-environments-extra) org-beamer-environments-default))) (t (user-error "Wrong block type at a headline named \"%s\"" raw-title)))) (title (org-export-data (org-element-property :title headline) info)) - (options (let ((options (org-element-property :BEAMER_OPT headline))) - (if (not options) "" - (org-beamer--normalize-argument options 'option)))) + (raw-options (org-element-property :BEAMER_OPT headline)) + (options (if raw-options + (org-beamer--normalize-argument raw-options 'option) + "")) ;; Start a "columns" environment when explicitly requested or ;; when there is no previous headline or the previous ;; headline do not have a BEAMER_column property. @@ -521,7 +544,7 @@ used as a communication channel." ;; One can specify placement for column only when ;; HEADLINE stands for a column on its own. (if (equal environment "column") options "") - (format "%s\\textwidth" column-width))) + (format "%s\\columnwidth" column-width))) ;; Block's opening string. (when (nth 2 env-format) (concat @@ -534,15 +557,19 @@ used as a communication channel." ;; overlay specification and the default one is nil. (let ((action (org-element-property :BEAMER_ACT headline))) (cond - ((not action) (list (cons "a" "") (cons "A" ""))) - ((string-match "\\`\\[.*\\]\\'" action) + ((not action) (list (cons "a" "") (cons "A" "") (cons "R" ""))) + ((and (string-prefix-p "[" action) + (string-suffix-p "]" action)) (list (cons "A" (org-beamer--normalize-argument action 'defaction)) - (cons "a" ""))) + (cons "a" "") + (cons "R" action))) (t (list (cons "a" (org-beamer--normalize-argument action 'action)) - (cons "A" ""))))) + (cons "A" "") + (cons "R" action))))) (list (cons "o" options) + (cons "O" (or raw-options "")) (cons "h" title) (cons "r" raw-title) (cons "H" (if (equal raw-title "") "" @@ -578,28 +605,27 @@ as a communication channel." (when overlay (org-beamer--normalize-argument overlay - (if (string-match "^\\[.*\\]$" overlay) 'defaction + (if (string-match "\\`\\[.*\\]\\'" overlay) 'defaction 'action)))) ;; Options. (let ((options (org-element-property :BEAMER_OPT headline))) (when options (org-beamer--normalize-argument options 'option))) ;; Resolve reference provided by "BEAMER_ref" - ;; property. This is done by building a minimal fake - ;; link and calling the appropriate resolve function, - ;; depending on the reference syntax. - (let* ((type - (progn - (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) - (cond - ((or (not (match-string 1 ref)) - (equal (match-string 1 ref) "*")) 'fuzzy) - ((equal (match-string 1 ref) "id:") 'id) - (t 'custom-id)))) - (link (list 'link (list :path (match-string 2 ref)))) - (target (if (eq type 'fuzzy) - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) + ;; property. This is done by building a minimal + ;; fake link and calling the appropriate resolve + ;; function, depending on the reference syntax. + (let ((target + (if (string-match "\\`\\(id:\\|#\\)" ref) + (org-export-resolve-id-link + `(link (:path ,(substring ref (match-end 0)))) + info) + (org-export-resolve-fuzzy-link + `(link (:path + ;; Look for headlines only. + ,(if (eq (string-to-char ref) ?*) ref + (concat "*" ref)))) + info)))) ;; Now use user-defined label provided in TARGET ;; headline, or fallback to standard one. (format "{%s}" (org-beamer--get-label target info))))))) @@ -640,15 +666,27 @@ as a communication channel." "Transcode an ITEM element into Beamer code. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let ((action (let ((first-element (car (org-element-contents item)))) - (and (eq (org-element-type first-element) 'paragraph) - (org-beamer--element-has-overlay-p first-element)))) - (output (org-export-with-backend 'latex item contents info))) - (if (or (not action) (not (string-match "\\\\item" output))) output - ;; If the item starts with a paragraph and that paragraph starts - ;; with an export snippet specifying an overlay, insert it after - ;; \item command. - (replace-match (concat "\\\\item" action) nil nil output)))) + (org-export-with-backend + ;; Delegate item export to `latex'. However, we use `beamer' + ;; transcoders for objects in the description tag. + (org-export-create-backend + :parent 'beamer + :transcoders + (list + (cons + 'item + (lambda (item _c _i) + (let ((action + (let ((first (car (org-element-contents item)))) + (and (eq (org-element-type first) 'paragraph) + (org-beamer--element-has-overlay-p first)))) + (output (org-latex-item item contents info))) + (if (not (and action (string-match "\\\\item" output))) output + ;; If the item starts with a paragraph and that paragraph + ;; starts with an export snippet specifying an overlay, + ;; append it to the \item command. + (replace-match (concat "\\\\item" action) nil nil output))))))) + item contents info)) ;;;; Keyword @@ -681,46 +719,16 @@ channel." "Transcode a LINK object into Beamer code. CONTENTS is the description part of the link. INFO is a plist used as a communication channel." - (let ((type (org-element-property :type link)) - (path (org-element-property :path link))) - ;; Use \hyperlink command for all internal links. - (cond - ((equal type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (if (not destination) contents - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - (org-export-solidify-link-text - (org-element-property :value destination)) - contents)))) - ((and (member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - (headline - (let ((label - (format "sec-%s" - (mapconcat - 'number-to-string - (org-export-get-headline-number - destination info) - "-")))) - (if (and (plist-get info :section-numbers) (not contents)) - (format "\\ref{%s}" label) - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - label - contents)))) - (target - (let ((path (org-export-solidify-link-text path))) - (if (not contents) (format "\\ref{%s}" path) - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - path - contents)))))))) - ;; Otherwise, use `latex' back-end. - (t (org-export-with-backend 'latex link contents info))))) + (or (org-export-custom-protocol-maybe link contents 'beamer) + ;; Fall-back to LaTeX export. However, prefer "\hyperlink" over + ;; "\hyperref" since the former handles overlay specifications. + (let ((latex-link (org-export-with-backend 'latex link contents info))) + (if (string-match "\\`\\\\hyperref\\[\\(.*?\\)\\]" latex-link) + (replace-match + (format "\\\\hyperlink%s{\\1}" + (or (org-beamer--element-has-overlay-p link) "")) + nil nil latex-link) + latex-link)))) ;;;; Plain List @@ -755,7 +763,8 @@ contextual information." 'option) ;; Eventually insert contents and close environment. contents - latex-type)))) + latex-type) + info))) ;;;; Radio Target @@ -766,21 +775,10 @@ TEXT is the text of the target. INFO is a plist holding contextual information." (format "\\hypertarget%s{%s}{%s}" (or (org-beamer--element-has-overlay-p radio-target) "") - (org-export-solidify-link-text - (org-element-property :value radio-target)) + (org-export-get-reference radio-target info) text)) -;;;; Target - -(defun org-beamer-target (target contents info) - "Transcode a TARGET object into Beamer code. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "\\hypertarget{%s}{}" - (org-export-solidify-link-text (org-element-property :value target)))) - - ;;;; Template ;; ;; Template used is similar to the one used in `latex' back-end, @@ -790,37 +788,17 @@ information." "Return complete document string after Beamer conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." - (let ((title (org-export-data (plist-get info :title) info))) + (let ((title (org-export-data (plist-get info :title) info)) + (subtitle (org-export-data (plist-get info :subtitle) info))) (concat - ;; 1. Time-stamp. + ;; Time-stamp. (and (plist-get info :time-stamp-file) (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; 2. Document class and packages. - (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-element-normalize-string - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (org-element-normalize-string - (plist-get info :latex-header)) - (org-element-normalize-string - (plist-get info :latex-header-extra)) - (plist-get info :beamer-header-extra))))) - info))) - ;; 3. Insert themes. + ;; LaTeX compiler + (org-latex--insert-compiler info) + ;; Document class and packages. + (org-latex-make-preamble info) + ;; Insert themes. (let ((format-theme (function (lambda (prop command) @@ -840,11 +818,11 @@ holding export options." (:beamer-inner-theme "\\useinnertheme") (:beamer-outer-theme "\\useoutertheme")) "")) - ;; 4. Possibly limit depth for headline numbering. + ;; Possibly limit depth for headline numbering. (let ((sec-num (plist-get info :section-numbers))) (when (integerp sec-num) (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) - ;; 5. Author. + ;; Author. (let ((author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-data auth info))))) @@ -852,52 +830,52 @@ holding export options." (org-export-data (plist-get info :email) info)))) (cond ((and author email (not (string= "" email))) (format "\\author{%s\\thanks{%s}}\n" author email)) - (author (format "\\author{%s}\n" author)) - (t "\\author{}\n"))) - ;; 6. Date. + ((or author email) (format "\\author{%s}\n" (or author email))))) + ;; Date. (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) (format "\\date{%s}\n" (org-export-data date info))) - ;; 7. Title + ;; Title (format "\\title{%s}\n" title) - ;; 8. Hyperref options. - (when (plist-get info :latex-hyperref-p) - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (if (not (plist-get info :with-creator)) "" - (plist-get info :creator)))) - ;; 9. Document start. + (when (org-string-nw-p subtitle) + (concat (format (plist-get info :beamer-subtitle-format) subtitle) "\n")) + ;; Beamer-header + (let ((beamer-header (plist-get info :beamer-header))) + (when beamer-header + (format "%s\n" (plist-get info :beamer-header)))) + ;; 9. Hyperref options. + (let ((template (plist-get info :latex-hyperref-template))) + (and (stringp template) + (format-spec template (org-latex--format-spec info)))) + ;; Document start. "\\begin{document}\n\n" - ;; 10. Title command. + ;; Title command. (org-element-normalize-string - (cond ((string= "" title) nil) + (cond ((not (plist-get info :with-title)) nil) + ((string= "" title) nil) ((not (stringp org-latex-title-command)) nil) ((string-match "\\(?:[^%]\\|^\\)%s" org-latex-title-command) (format org-latex-title-command title)) (t org-latex-title-command))) - ;; 11. Table of contents. + ;; Table of contents. (let ((depth (plist-get info :with-toc))) (when depth (concat (format "\\begin{frame}%s{%s}\n" (org-beamer--normalize-argument - org-beamer-outline-frame-options 'option) - org-beamer-outline-frame-title) + (plist-get info :beamer-outline-frame-options) 'option) + (plist-get info :beamer-outline-frame-title)) (when (wholenump depth) (format "\\setcounter{tocdepth}{%d}\n" depth)) "\\tableofcontents\n" "\\end{frame}\n\n"))) - ;; 12. Document's body. + ;; Document's body. contents - ;; 13. Creator. - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) - (format "%% %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) - ;; 14. Document end. + ;; Creator. + (if (plist-get info :with-creator) + (concat (plist-get info :creator) "\n") + "") + ;; Document end. "\\end{document}"))) @@ -933,7 +911,7 @@ value." (save-excursion (org-back-to-heading t) ;; Filter out Beamer-related tags and install environment tag. - (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) + (let ((tags (cl-remove-if (lambda (x) (string-match "^B_" x)) (org-get-tags))) (env-tag (and (org-string-nw-p value) (concat "B_" value)))) (org-set-tags-to (if env-tag (cons env-tag tags) tags)) @@ -1085,7 +1063,7 @@ aid, but the tag does not have any semantic meaning." (let* ((envs (append org-beamer-environments-special org-beamer-environments-extra org-beamer-environments-default)) - (org-tag-alist + (org-current-tag-alist (append '((:startgroup)) (mapcar (lambda (e) (cons (concat "B_" (car e)) (string-to-char (nth 1 e)))) @@ -1120,30 +1098,6 @@ aid, but the tag does not have any semantic meaning." (org-entry-put nil "BEAMER_env" (match-string 1 tags))) (t (org-entry-delete nil "BEAMER_env")))))) -;;;###autoload -(defun org-beamer-insert-options-template (&optional kind) - "Insert a settings template, to make sure users do this right." - (interactive (progn - (message "Current [s]ubtree or [g]lobal?") - (if (eq (read-char-exclusive) ?g) (list 'global) - (list 'subtree)))) - (if (eq kind 'subtree) - (progn - (org-back-to-heading t) - (org-reveal) - (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer") - (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]") - (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") - (when org-beamer-column-view-format - (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) - (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths)) - (insert "#+LaTeX_CLASS: beamer\n") - (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") - (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n")) - (when org-beamer-column-view-format - (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) - (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n"))) - ;;;###autoload (defun org-beamer-publish-to-latex (plist filename pub-dir) "Publish an Org file to a Beamer presentation (LaTeX). @@ -1168,9 +1122,13 @@ Return output file name." ;; working directory and then moved to publishing directory. (org-publish-attachment plist - (org-latex-compile - (org-publish-org-to - 'beamer filename ".tex" plist (file-name-directory filename))) + ;; Default directory could be anywhere when this function is + ;; called. We ensure it is set to source file directory during + ;; compilation so as to not break links to external documents. + (let ((default-directory (file-name-directory filename))) + (org-latex-compile + (org-publish-org-to + 'beamer filename ".tex" plist (file-name-directory filename)))) pub-dir)) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 86ca3a6bb2..9c0ba65398 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -1,4 +1,4 @@ -;;; ox-html.el --- HTML Back-End for Org Export Engine +;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -30,20 +30,24 @@ ;;; Dependencies +(require 'cl-lib) +(require 'format-spec) (require 'ox) (require 'ox-publish) -(require 'format-spec) -(eval-when-compile (require 'cl) (require 'table nil 'noerror)) +(require 'table) ;;; Function Declarations (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) (declare-function mm-url-decode-entities "mm-url" ()) +(defvar htmlize-css-name-prefix) +(defvar htmlize-output-type) +(defvar htmlize-output-type) +(defvar htmlize-css-name-prefix) + ;;; Define Back-End (org-export-define-backend 'html @@ -72,13 +76,13 @@ (latex-fragment . org-html-latex-fragment) (line-break . org-html-line-break) (link . org-html-link) + (node-property . org-html-node-property) (paragraph . org-html-paragraph) (plain-list . org-html-plain-list) (plain-text . org-html-plain-text) (planning . org-html-planning) (property-drawer . org-html-property-drawer) (quote-block . org-html-quote-block) - (quote-section . org-html-quote-section) (radio-target . org-html-radio-target) (section . org-html-section) (special-block . org-html-special-block) @@ -96,7 +100,6 @@ (underline . org-html-underline) (verbatim . org-html-verbatim) (verse-block . org-html-verse-block)) - :export-block "HTML" :filters-alist '((:filter-options . org-html-infojs-install-script) (:filter-final-output . org-html-final-function)) :menu-entry @@ -108,10 +111,10 @@ (if a (org-html-export-to-html t s v b) (org-open-file (org-html-export-to-html nil s v b))))))) :options-alist - '((:html-extension nil nil org-html-extension) - (:html-link-org-as-html nil nil org-html-link-org-files-as-html) - (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) + '((:html-doctype "HTML_DOCTYPE" nil org-html-doctype) (:html-container "HTML_CONTAINER" nil org-html-container-element) + (:description "DESCRIPTION" nil nil newline) + (:keywords "KEYWORDS" nil nil space) (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) @@ -121,12 +124,52 @@ (:html-preamble nil "html-preamble" org-html-preamble) (:html-head "HTML_HEAD" nil org-html-head newline) (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) - (:html-head-include-default-style nil "html-style" org-html-head-include-default-style) + (:subtitle "SUBTITLE" nil nil parse) + (:html-head-include-default-style + nil "html-style" org-html-head-include-default-style) (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts) + (:html-allow-name-attribute-in-anchors + nil nil org-html-allow-name-attribute-in-anchors) + (:html-divs nil nil org-html-divs) + (:html-checkbox-type nil nil org-html-checkbox-type) + (:html-extension nil nil org-html-extension) + (:html-footnote-format nil nil org-html-footnote-format) + (:html-footnote-separator nil nil org-html-footnote-separator) + (:html-footnotes-section nil nil org-html-footnotes-section) + (:html-format-drawer-function nil nil org-html-format-drawer-function) + (:html-format-headline-function nil nil org-html-format-headline-function) + (:html-format-inlinetask-function + nil nil org-html-format-inlinetask-function) + (:html-home/up-format nil nil org-html-home/up-format) + (:html-indent nil nil org-html-indent) + (:html-infojs-options nil nil org-html-infojs-options) + (:html-infojs-template nil nil org-html-infojs-template) + (:html-inline-image-rules nil nil org-html-inline-image-rules) + (:html-link-org-files-as-html nil nil org-html-link-org-files-as-html) + (:html-mathjax-options nil nil org-html-mathjax-options) + (:html-mathjax-template nil nil org-html-mathjax-template) + (:html-metadata-timestamp-format nil nil org-html-metadata-timestamp-format) + (:html-postamble-format nil nil org-html-postamble-format) + (:html-preamble-format nil nil org-html-preamble-format) + (:html-table-align-individual-fields + nil nil org-html-table-align-individual-fields) + (:html-table-caption-above nil nil org-html-table-caption-above) + (:html-table-data-tags nil nil org-html-table-data-tags) + (:html-table-header-tags nil nil org-html-table-header-tags) + (:html-table-use-header-tags-for-first-column + nil nil org-html-table-use-header-tags-for-first-column) + (:html-tag-class-prefix nil nil org-html-tag-class-prefix) + (:html-text-markup-alist nil nil org-html-text-markup-alist) + (:html-todo-kwd-class-prefix nil nil org-html-todo-kwd-class-prefix) + (:html-toplevel-hlevel nil nil org-html-toplevel-hlevel) + (:html-use-infojs nil nil org-html-use-infojs) + (:html-validation-link nil nil org-html-validation-link) + (:html-viewport nil nil org-html-viewport) + (:html-inline-images nil nil org-html-inline-images) (:html-table-attributes nil nil org-html-table-default-attributes) - (:html-table-row-tags nil nil org-html-table-row-tags) + (:html-table-row-open-tag nil nil org-html-table-row-open-tag) + (:html-table-row-close-tag nil nil org-html-table-row-close-tag) (:html-xml-declaration nil nil org-html-xml-declaration) - (:html-inline-images nil nil org-html-inline-images) (:infojs-opt "INFOJS_OPT" nil nil) ;; Redefine regular options. (:creator "CREATOR" nil org-html-creator-string) @@ -186,7 +229,7 @@ property on the headline itself.") @licstart The following is the entire license notice for the JavaScript code in this tag. -Copyright (C) 2012-2013 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. The JavaScript code in this tag is free software: you can redistribute it and/or modify it under the terms of the GNU @@ -232,16 +275,22 @@ for the JavaScript code in this tag. (defconst org-html-style-default "" "The default style specification for exported HTML files. @@ -447,23 +580,24 @@ Option settings will replace the %MANAGER-OPTIONS cookie." :package-version '(Org . "8.0") :type 'string) -(defun org-html-infojs-install-script (exp-plist backend) +(defun org-html-infojs-install-script (exp-plist _backend) "Install script in export options when appropriate. EXP-PLIST is a plist containing export options. BACKEND is the export back-end currently used." (unless (or (memq 'body-only (plist-get exp-plist :export-options)) - (not org-html-use-infojs) - (and (eq org-html-use-infojs 'when-configured) - (or (not (plist-get exp-plist :infojs-opt)) - (string= "" (plist-get exp-plist :infojs-opt)) - (string-match "\\" - (plist-get exp-plist :infojs-opt))))) - (let* ((template org-html-infojs-template) + (not (plist-get exp-plist :html-use-infojs)) + (and (eq (plist-get exp-plist :html-use-infojs) 'when-configured) + (let ((opt (plist-get exp-plist :infojs-opt))) + (or (not opt) + (string= "" opt) + (string-match "\\" opt))))) + (let* ((template (plist-get exp-plist :html-infojs-template)) (ptoc (plist-get exp-plist :with-toc)) (hlevels (plist-get exp-plist :headline-levels)) (sdepth hlevels) (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels)) (options (plist-get exp-plist :infojs-opt)) + (infojs-opt (plist-get exp-plist :html-infojs-options)) (table org-html-infojs-opts-table) style) (dolist (entry table) @@ -472,7 +606,7 @@ export back-end currently used." ;; Compute default values for script option OPT from ;; `org-html-infojs-options' variable. (default - (let ((default (cdr (assq opt org-html-infojs-options)))) + (let ((default (cdr (assq opt infojs-opt)))) (if (and (symbolp default) (not (memq default '(t nil)))) (plist-get exp-plist default) default))) @@ -483,21 +617,21 @@ export back-end currently used." options)) (match-string 1 options) default))) - (case opt - (path (setq template - (replace-regexp-in-string - "%SCRIPT_PATH" val template t t))) - (sdepth (when (integerp (read val)) - (setq sdepth (min (read val) sdepth)))) - (tdepth (when (integerp (read val)) - (setq tdepth (min (read val) tdepth)))) - (otherwise (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) style))))) + (pcase opt + (`path (setq template + (replace-regexp-in-string + "%SCRIPT_PATH" val template t t))) + (`sdepth (when (integerp (read val)) + (setq sdepth (min (read val) sdepth)))) + (`tdepth (when (integerp (read val)) + (setq tdepth (min (read val) tdepth)))) + (_ (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) style))))) ;; Now we set the depth of the *generated* TOC to SDEPTH, ;; because the toc will actually determine the splitting. How ;; much of the toc will actually be displayed is governed by the @@ -509,9 +643,9 @@ export back-end currently used." (push (cons "TOC_DEPTH" tdepth) style) ;; Build style string. (setq style (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) - (cdr x))) + (lambda (x) + (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) (cdr x))) style "\n")) (when (and style (> (length style) 0)) (and (string-match "%MANAGER_OPTIONS" template) @@ -561,17 +695,9 @@ Warning: non-nil may break indentation of source code blocks." :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-html-use-unicode-chars nil - "Non-nil means to use unicode characters instead of HTML entities." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - ;;;; Drawers -(defcustom org-html-format-drawer-function - (lambda (name contents) contents) +(defcustom org-html-format-drawer-function (lambda (_name contents) contents) "Function called to format a drawer in HTML code. The function must accept two parameters: @@ -628,28 +754,30 @@ document title." :group 'org-export-html :type 'integer) -(defcustom org-html-format-headline-function 'ignore +(defcustom org-html-format-headline-function + 'org-html-format-headline-default-function "Function to format headline text. -This function will be called with 5 arguments: +This function will be called with six arguments: TODO the todo keyword (string or nil). TODO-TYPE the type of todo (symbol: `todo', `done', nil) PRIORITY the priority of the headline (integer or nil) TEXT the main headline text (string). TAGS the tags (string or nil). +INFO the export options (plist). The function result will be used in the section format string." :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") + :version "26.1" + :package-version '(Org . "8.3") :type 'function) ;;;; HTML-specific -(defcustom org-html-allow-name-attribute-in-anchors t +(defcustom org-html-allow-name-attribute-in-anchors nil "When nil, do not set \"name\" attribute in anchors. -By default, anchors are formatted with both \"id\" and \"name\" -attributes, when appropriate." +By default, when appropriate, anchors are formatted with \"id\" +but without \"name\" attribute." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") @@ -657,21 +785,23 @@ attributes, when appropriate." ;;;; Inlinetasks -(defcustom org-html-format-inlinetask-function 'ignore +(defcustom org-html-format-inlinetask-function + 'org-html-format-inlinetask-default-function "Function called to format an inlinetask in HTML code. -The function must accept six parameters: +The function must accept seven parameters: TODO the todo keyword, as a string TODO-TYPE the todo type, a symbol among `todo', `done' and nil. PRIORITY the inlinetask priority, as a string NAME the inlinetask name, as a string. TAGS the inlinetask tags, as a list of strings. CONTENTS the contents of the inlinetask, as a string. + INFO the export options, as a plist The function should return the string to be exported." :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") + :version "26.1" + :package-version '(Org . "8.3") :type 'function) ;;;; LaTeX @@ -685,24 +815,20 @@ fragments. This option can also be set with the +OPTIONS line, e.g. \"tex:mathjax\". Allowed values are: -nil Ignore math snippets. -`verbatim' Keep everything in verbatim -`dvipng' Process the LaTeX fragments to images. This will also - include processing of non-math environments. -`imagemagick' Convert the LaTeX fragments to pdf files and use - imagemagick to convert pdf files to png files. -`mathjax' Do MathJax preprocessing and arrange for MathJax.js to - be loaded. -t Synonym for `mathjax'." + nil Ignore math snippets. + `verbatim' Keep everything in verbatim + `mathjax', t Do MathJax preprocessing and arrange for MathJax.js to + be loaded. + SYMBOL Any symbol defined in `org-preview-latex-process-alist', + e.g., `dvipng'." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") :type '(choice (const :tag "Do not process math in any way" nil) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Leave math verbatim" verbatim) (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) + (symbol :tag "Convert to image to display math" :value dvipng))) ;;;; Links :: Generic @@ -710,11 +836,11 @@ t Synonym for `mathjax'." "Non-nil means make file links to `file.org' point to `file.html'. When `org-mode' is exporting an `org-mode' file to HTML, links to non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org') should become links to the corresponding html +However, links to other Org files (recognized by the extension +\".org\") should become links to the corresponding HTML file, assuming that the linked `org-mode' file will also be converted to HTML. -When nil, the links still point to the plain `.org' file." +When nil, the links still point to the plain \".org\" file." :group 'org-export-html :type 'boolean) @@ -745,22 +871,20 @@ link's path." ;;;; Plain Text -(defcustom org-html-protect-char-alist +(defvar org-html-protect-char-alist '(("&" . "&") ("<" . "<") (">" . ">")) - "Alist of characters to be converted by `org-html-protect'." - :group 'org-export-html - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) + "Alist of characters to be converted by `org-html-encode-plain-text'.") ;;;; Src Block (defcustom org-html-htmlize-output-type 'inline-css "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. +Choices are `css' to export the CSS selectors only,`inline-css' +to export the CSS attribute values inline in the HTML or `nil' to +export plain text. We use as default `inline-css', in order to +make the resulting HTML self-containing. However, this will fail when using Emacs in batch mode for export, because then no rich font definitions are in place. It will also not be good if @@ -771,9 +895,9 @@ a style file to define the look of these classes. To get a start for your css file, start Emacs session and make sure that all the faces you are interested in are defined, for example by loading files in all modes you want. Then, use the command -\\[org-html-htmlize-generate-css] to extract class definitions." +`\\[org-html-htmlize-generate-css]' to extract class definitions." :group 'org-export-html - :type '(choice (const css) (const inline-css))) + :type '(choice (const css) (const inline-css) (const nil))) (defcustom org-html-htmlize-font-prefix "org-" "The prefix for CSS class names for htmlize font specifications." @@ -796,7 +920,7 @@ When exporting to HTML5, these values will be disregarded." :value-type (string :tag "Value"))) (defcustom org-html-table-header-tags '("" . "") - "The opening tag for table header fields. + "The opening and ending tags for table header fields. This is customizable so that alignment options can be specified. The first %s will be filled with the scope of the field, either row or col. The second %s will be replaced by a style entry to align the field. @@ -806,7 +930,7 @@ See also the variable `org-html-table-align-individual-fields'." :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) (defcustom org-html-table-data-tags '("" . "") - "The opening tag for table data fields. + "The opening and ending tags for table data fields. This is customizable so that alignment options can be specified. The first %s will be filled with the scope of the field, either row or col. The second %s will be replaced by a style entry to align the field. @@ -814,43 +938,50 @@ See also the variable `org-html-table-align-individual-fields'." :group 'org-export-html :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) -(defcustom org-html-table-row-tags '("" . "") - "The opening and ending tags for table rows. +(defcustom org-html-table-row-open-tag "" + "The opening tag for table rows. This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be +Instead of strings, these can be a Lisp function that will be evaluated for each row in order to construct the table row tags. -During evaluation, these variables will be dynamically bound so that -you can reuse them: +The function will be called with these arguments: - `row-number': row number (0 is the first row) - `rowgroup-number': group number of current row - `start-rowgroup-p': non-nil means the row starts a group - `end-rowgroup-p': non-nil means the row ends a group - `top-row-p': non-nil means this is the top row - `bottom-row-p': non-nil means this is the bottom row + `number': row number (0 is the first row) + `group-number': group number of current row + `start-group?': non-nil means the row starts a group + `end-group?': non-nil means the row ends a group + `top?': non-nil means this is the top row + `bottom?': non-nil means this is the bottom row For example: -\(setq org-html-table-row-tags - (cons \\='(cond (top-row-p \"\") - (bottom-row-p \"\") - (t (if (= (mod row-number 2) 1) - \"\" - \"\"))) - \"\")) + (setq org-html-table-row-open-tag + (lambda (number group-number start-group? end-group-p top? bottom?) + (cond (top? \"\") + (bottom? \"\") + (t (if (= (mod number 2) 1) + \"\" + \"\"))))) will use the \"tr-top\" and \"tr-bottom\" classes for the top row and the bottom row, and otherwise alternate between \"tr-odd\" and \"tr-even\" for odd and even rows." :group 'org-export-html - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) + :type '(choice :tag "Opening tag" + (string :tag "Specify") + (function))) + +(defcustom org-html-table-row-close-tag "" + "The closing tag for table rows. +This is customizable so that alignment options can be specified. +Instead of strings, this can be a Lisp function that will be +evaluated for each row in order to construct the table row tags. + +See documentation of `org-html-table-row-open-tag'." + :group 'org-export-html + :type '(choice :tag "Closing tag" + (string :tag "Specify") + (function))) (defcustom org-html-table-align-individual-fields t "Non-nil means attach style attributes for alignment to each table field. @@ -921,7 +1052,10 @@ publishing, with :html-doctype." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type (append + '(choice) + (mapcar (lambda (x) `(const ,(car x))) org-html-doctype-alist) + '((string :tag "Custom doctype" )))) (defcustom org-html-html5-fancy nil "Non-nil means using new HTML5 elements. @@ -954,7 +1088,7 @@ org-info.js for your website." (content "div" "content") (postamble "div" "postamble")) "Alist of the three section elements for HTML export. -The car of each entry is one of 'preamble, 'content or 'postamble. +The car of each entry is one of `preamble', `content' or `postamble'. The cdrs of each entry are the ELEMENT_TYPE and ID for each section of the exported document. @@ -973,6 +1107,41 @@ org-info.js for your website." (list :tag "Postamble" (const :format "" postamble) (string :tag " id") (string :tag "element")))) +(defconst org-html-checkbox-types + '((unicode . + ((on . "☑") (off . "☐") (trans . "☐"))) + (ascii . + ((on . "[X]") + (off . "[ ]") + (trans . "[-]"))) + (html . + ((on . "") + (off . "") + (trans . "")))) + "Alist of checkbox types. +The cdr of each entry is an alist list three checkbox types for +HTML export: `on', `off' and `trans'. + +The choices are: + `unicode' Unicode characters (HTML entities) + `ascii' ASCII characters + `html' HTML checkboxes + +Note that only the ascii characters implement tri-state +checkboxes. The other two use the `off' checkbox for `trans'.") + +(defcustom org-html-checkbox-type 'ascii + "The type of checkboxes to use for HTML export. +See `org-html-checkbox-types' for for the values used for each +option." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "ASCII characters" ascii) + (const :tag "Unicode characters" unicode) + (const :tag "HTML checkboxes" html))) + (defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M" "Format used for timestamps in preamble, postamble and metadata. See `format-time-string' for more information on its components." @@ -984,82 +1153,107 @@ See `format-time-string' for more information on its components." ;;;; Template :: Mathjax (defcustom org-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") + '((path "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_HTML" ) (scale "100") (align "center") - (indent "2em") - (mathml nil)) + (font "TeX") + (linebreaks "false") + (autonumber "AMS") + (indent "0em") + (multlinewidth "85%") + (tagindent ".8em") + (tagside "right")) "Options for MathJax setup. -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. +Alist of the following elements. All values are strings. + +path The path to MathJax. +scale Scaling with HTML-CSS, MathML and SVG output engines. +align How to align display math: left, center, or right. +font The font to use with HTML-CSS and SVG output. As of MathJax 2.5 + the following values are understood: \"TeX\", \"STIX-Web\", + \"Asana-Math\", \"Neo-Euler\", \"Gyre-Pagella\", + \"Gyre-Termes\", and \"Latin-Modern\". +linebreaks Let MathJax perform automatic linebreaks. Valid values + are \"true\" and \"false\". +indent If align is not center, how far from the left/right side? + Valid values are \"left\" and \"right\" +multlinewidth The width of the multline environment. +autonumber How to number equations. Valid values are \"None\", + \"all\" and \"AMS Math\". +tagindent The amount tags are indented. +tagside Which side to show tags/labels on. Valid values are + \"left\" and \"right\" You can also customize this for each buffer, using something like -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" +#+HTML_MATHJAX: align: left indent: 5em tagside: left font: Neo-Euler + +For further information about MathJax options, see the MathJax documentation: + + http://docs.mathjax.org/" :group 'org-export-html + :package-version '(Org . "8.3") :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "font (used to display math)" + (const :format " " font) + (choice (const "TeX") + (const "STIX-Web") + (const "Asana-Math") + (const "Neo-Euler") + (const "Gyre-Pagella") + (const "Gyre-Termes") + (const "Latin-Modern"))) + (list :tag "linebreaks (automatic line-breaking)" + (const :format " " linebreaks) + (choice (const "true") + (const "false"))) + (list :tag "autonumber (when should equations be numbered)" + (const :format " " autonumber) + (choice (const "AMS") + (const "None") + (const "All"))) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "multlinewidth (width to use for the multline environment)" + (const :format " " multlinewidth) (string)) + (list :tag "tagindent (the indentation of tags from left or right)" + (const :format " " tagindent) (string)) + (list :tag "tagside (location of tags)" + (const :format " " tagside) + (choice (const "left") + (const "right"))))) (defcustom org-html-mathjax-template - " -" - "The MathJax setup for XHTML files." +}); + +" + "The MathJax template. See also `org-html-mathjax-options'." :group 'org-export-html :type 'string) @@ -1068,7 +1262,7 @@ You can also customize this for each buffer, using something like (defcustom org-html-postamble 'auto "Non-nil means insert a postamble in HTML export. -When set to 'auto, check against the +When set to `auto', check against the `org-export-with-author/email/creator/date' variables to set the content of the postamble. When set to a string, use this string as the postamble. When t, insert a string as defined by the @@ -1101,6 +1295,7 @@ The second element of each list is a format string to format the postamble itself. This format string can contain these elements: %t stands for the title. + %s stands for the subtitle. %a stands for the author's name. %e stands for the author's email. %d stands for the date. @@ -1165,6 +1360,7 @@ The second element of each list is a format string to format the preamble itself. This format string can contain these elements: %t stands for the title. + %s stands for the subtitle. %a stands for the author's name. %e stands for the author's email. %d stands for the date. @@ -1216,8 +1412,6 @@ ignored." ;;;; Template :: Scripts -(define-obsolete-variable-alias - 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") (defcustom org-html-head-include-scripts t "Non-nil means include the JavaScript snippets in exported HTML files. The actual script is defined in `org-html-scripts' and should @@ -1229,8 +1423,6 @@ not be modified." ;;;; Template :: Styles -(define-obsolete-variable-alias - 'org-html-style-include-default 'org-html-head-include-default-style "24.4") (defcustom org-html-head-include-default-style t "Non-nil means include the default style in exported HTML files. The actual style is defined in `org-html-style-default' and @@ -1243,7 +1435,6 @@ style information." ;;;###autoload (put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) -(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") (defcustom org-html-head "" "Org-wide head definitions for exported HTML files. @@ -1293,6 +1484,54 @@ or for publication projects using the :html-head-extra property." ;;;###autoload (put 'org-html-head-extra 'safe-local-variable 'stringp) +;;;; Template :: Viewport + +(defcustom org-html-viewport '((width "device-width") + (initial-scale "1") + (minimum-scale "") + (maximum-scale "") + (user-scalable "")) + "Viewport options for mobile-optimized sites. + +The following values are recognized + +width Size of the viewport. +initial-scale Zoom level when the page is first loaded. +minimum-scale Minimum allowed zoom level. +maximum-scale Maximum allowed zoom level. +user-scalable Whether zoom can be changed. + +The viewport meta tag is inserted if this variable is non-nil. + +See the following site for a reference: +https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag" + :group 'org-export-html + :version "26.1" + :package-version '(Org . "8.3") + :type '(choice (const :tag "Disable" nil) + (list :tag "Enable" + (list :tag "Width of viewport" + (const :format " " width) + (choice (const :tag "unset" "") + (string))) + (list :tag "Initial scale" + (const :format " " initial-scale) + (choice (const :tag "unset" "") + (string))) + (list :tag "Minimum scale/zoom" + (const :format " " minimum-scale) + (choice (const :tag "unset" "") + (string))) + (list :tag "Maximum scale/zoom" + (const :format " " maximum-scale) + (choice (const :tag "unset" "") + (string))) + (list :tag "User scalable/zoomable" + (const :format " " user-scalable) + (choice (const :tag "unset" "") + (const "true") + (const "false")))))) + ;;;; Todos (defcustom org-html-todo-kwd-class-prefix "" @@ -1315,22 +1554,33 @@ CSS classes, then this prefix can be very useful." (let ((dt (downcase (plist-get info :html-doctype)))) (member dt '("html5" "xhtml5" "")))) +(defun org-html--html5-fancy-p (info) + "Non-nil when exporting to HTML5 with fancy elements. +INFO is the current state of the export process, as a plist." + (and (plist-get info :html-html5-fancy) + (org-html-html5-p info))) + (defun org-html-close-tag (tag attr info) - (concat "<" tag " " attr + "Return close-tag for string TAG. +ATTR specifies additional attributes. INFO is a property list +containing current export state." + (concat "<" tag + (org-string-nw-p (concat " " attr)) (if (org-html-xhtml-p info) " />" ">"))) (defun org-html-doctype (info) - "Return correct html doctype tag from `org-html-doctype-alist', -or the literal value of :html-doctype from INFO if :html-doctype -is not found in the alist. -INFO is a plist used as a communication channel." + "Return correct HTML doctype tag. +INFO is a plist used as a communication channel. Doctype tag is +extracted from `org-html-doctype-alist', or the literal value +of :html-doctype from INFO if :html-doctype is not found in the +alist." (let ((dt (plist-get info :html-doctype))) (or (cdr (assoc dt org-html-doctype-alist)) dt))) (defun org-html--make-attribute-string (attributes) "Return a list of attributes, as a string. -ATTRIBUTES is a plist where values are either strings or nil. An -attributes with a nil value will be omitted from the result." +ATTRIBUTES is a plist where values are either strings or nil. An +attribute with a nil value will be omitted from the result." (let (output) (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) (cond ((null item) (pop output)) @@ -1345,15 +1595,13 @@ attributes with a nil value will be omitted from the result." INFO is a plist used as a communication channel. When optional arguments CAPTION and LABEL are given, use them for caption and \"id\" attribute." - (let ((html5-fancy (and (org-html-html5-p info) - (plist-get info :html-html5-fancy)))) - (format (if html5-fancy "\n%s%s\n" - "\n%s%s\n") + (let ((html5-fancy (org-html--html5-fancy-p info))) + (format (if html5-fancy "\n\n%s%s\n" + "\n\n%s%s\n") ;; ID. - (if (not (org-string-nw-p label)) "" - (format " id=\"%s\"" (org-export-solidify-link-text label))) + (if (org-string-nw-p label) (format " id=\"%s\"" label) "") ;; Contents. - (format "\n

    %s

    " contents) + (if html5-fancy contents (format "

    %s

    " contents)) ;; Caption. (if (not (org-string-nw-p caption)) "" (format (if html5-fancy "\n
    %s
    " @@ -1366,17 +1614,42 @@ SOURCE is a string specifying the location of the image. ATTRIBUTES is a plist, as returned by `org-export-read-attribute'. INFO is a plist used as a communication channel." - (org-html-close-tag - "img" - (org-html--make-attribute-string - (org-combine-plists - (list :src source - :alt (if (string-match-p "^ltxpng/" source) - (org-html-encode-plain-text - (org-find-text-property-in-string 'org-latex-src source)) - (file-name-nondirectory source))) - attributes)) - info)) + (if (string= "svg" (file-name-extension source)) + (org-html--svg-image source attributes info) + (org-html-close-tag + "img" + (org-html--make-attribute-string + (org-combine-plists + (list :src source + :alt (if (string-match-p "^ltxpng/" source) + (org-html-encode-plain-text + (org-find-text-property-in-string 'org-latex-src source)) + (file-name-nondirectory source))) + attributes)) + info))) + +(defun org-html--svg-image (source attributes info) + "Return \"object\" embedding svg file SOURCE with given ATTRIBUTES. +INFO is a plist used as a communication channel. + +The special attribute \"fallback\" can be used to specify a +fallback image file to use if the object embedding is not +supported. CSS class \"org-svg\" is assigned as the class of the +object unless a different class is specified with an attribute." + (let ((fallback (plist-get attributes :fallback)) + (attrs (org-html--make-attribute-string + (org-combine-plists + ;; Remove fallback attribute, which is not meant to + ;; appear directly in the attributes string, and + ;; provide a default class if none is set. + '(:class "org-svg") attributes '(:fallback nil))))) + (format "\n%s" + source + attrs + (if fallback + (org-html-close-tag + "img" (format "src=\"%s\" %s" fallback attrs) info) + "Sorry, your browser does not support SVG.")))) (defun org-html--textarea-block (element) "Transcode ELEMENT into a textarea block. @@ -1388,7 +1661,7 @@ ELEMENT is either a src block or an example block." (or (plist-get attr :height) (org-count-lines code)) code))) -(defun org-html--has-caption-p (element &optional info) +(defun org-html--has-caption-p (element &optional _info) "Non-nil when ELEMENT has a caption affiliated keyword. INFO is a plist used as a communication channel. This function is meant to be used as a predicate for `org-export-get-ordinal' or @@ -1435,7 +1708,7 @@ produce code that uses these same face definitions." (when (and (symbolp f) (or (not i) (not (listp i)))) (insert (org-add-props (copy-sequence "1") nil 'face f)))) (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") + (pop-to-buffer-same-window "*html*") (goto-char (point-min)) (if (re-search-forward "%s %s\n" - (format org-html-footnote-format - (let* ((id (format "fn.%s" n)) - (href (format " href=\"#fnr.%s\"" n)) - (attributes (concat " class=\"footnum\"" href))) - (org-html--anchor id n attributes))) - def))) + (replace-regexp-in-string "[^a-zA-Z0-9_]" "_" kwd nil t)) (defun org-html-footnote-section (info) "Format the footnote section. INFO is a plist used as a communication channel." - (let* ((fn-alist (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) + (let* ((fn-alist (org-export-collect-footnote-definitions info)) (fn-alist - (loop for (n type raw) in fn-alist collect - (cons n (if (eq (org-element-type raw) 'org-data) - (org-trim (org-export-data raw info)) - (format "

    %s

    " - (org-trim (org-export-data raw info)))))))) + (cl-loop for (n _type raw) in fn-alist collect + (cons n (if (eq (org-element-type raw) 'org-data) + (org-trim (org-export-data raw info)) + (format "
    %s
    " + (org-trim (org-export-data raw info)))))))) (when fn-alist - (org-html-format-footnotes-section + (format + (plist-get info :html-footnotes-section) (org-html--translate "Footnotes" info) (format "\n%s\n" - (mapconcat 'org-html-format-footnote-definition fn-alist "\n")))))) + (mapconcat + (lambda (fn) + (let ((n (car fn)) (def (cdr fn))) + (format + "
    %s %s
    \n" + (format + (plist-get info :html-footnote-format) + (org-html--anchor + (format "fn.%d" n) + n + (format " class=\"footnum\" href=\"#fnr.%d\"" n) + info)) + def))) + fn-alist + "\n")))))) ;;; Template @@ -1529,37 +1787,52 @@ INFO is a plist used as a communication channel." 'mime-charset)) "iso-8859-1"))) (concat - (format "%s\n" title) (when (plist-get info :time-stamp-file) (format-time-string - (concat "\n"))) + (concat "\n"))) (format (if (org-html-html5-p info) - (org-html-close-tag "meta" " charset=\"%s\"" info) + (org-html-close-tag "meta" "charset=\"%s\"" info) (org-html-close-tag - "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" + "meta" "http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" info)) charset) "\n" - (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) + (let ((viewport-options + (cl-remove-if-not (lambda (cell) (org-string-nw-p (cadr cell))) + (plist-get info :html-viewport)))) + (and viewport-options + (concat + (org-html-close-tag + "meta" + (format "name=\"viewport\" content=\"%s\"" + (mapconcat + (lambda (elm) (format "%s=%s" (car elm) (cadr elm))) + viewport-options ", ")) + info) + "\n"))) + (format "%s\n" title) + (org-html-close-tag "meta" "name=\"generator\" content=\"Org mode\"" info) "\n" (and (org-string-nw-p author) (concat (org-html-close-tag "meta" - (format " name=\"author\" content=\"%s\"" + (format "name=\"author\" content=\"%s\"" (funcall protect-string author)) info) "\n")) (and (org-string-nw-p description) (concat (org-html-close-tag "meta" - (format " name=\"description\" content=\"%s\"\n" + (format "name=\"description\" content=\"%s\"\n" (funcall protect-string description)) info) "\n")) (and (org-string-nw-p keywords) (concat (org-html-close-tag "meta" - (format " name=\"keywords\" content=\"%s\"" + (format "name=\"keywords\" content=\"%s\"" (funcall protect-string keywords)) info) "\n"))))) @@ -1576,7 +1849,7 @@ INFO is a plist used as a communication channel." (when (and (plist-get info :html-htmlized-css-url) (eq org-html-htmlize-output-type 'css)) (org-html-close-tag "link" - (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" + (format "rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" (plist-get info :html-htmlized-css-url)) info)) (when (plist-get info :html-head-include-scripts) org-html-scripts)))) @@ -1587,55 +1860,43 @@ INFO is a plist used as a communication channel." (when (and (memq (plist-get info :with-latex) '(mathjax t)) (org-element-map (plist-get info :parse-tree) '(latex-fragment latex-environment) 'identity info t)) - (let ((template org-html-mathjax-template) - (options org-html-mathjax-options) - (in-buffer (or (plist-get info :html-mathjax) "")) - name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (if (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\%s" e e)) - (split-string (plist-get info :email) ",+ *") - ", ")) - (?c . ,(plist-get info :creator)) - (?C . ,(let ((file (plist-get info :input-file))) - (format-time-string org-html-metadata-timestamp-format - (if file (nth 5 (file-attributes file)))))) - (?v . ,(or org-html-validation-link "")))) + "Return format specification for preamble and postamble. +INFO is a plist used as a communication channel." + (let ((timestamp-format (plist-get info :html-metadata-timestamp-format))) + `((?t . ,(org-export-data (plist-get info :title) info)) + (?s . ,(org-export-data (plist-get info :subtitle) info)) + (?d . ,(org-export-data (org-export-get-date info timestamp-format) + info)) + (?T . ,(format-time-string timestamp-format)) + (?a . ,(org-export-data (plist-get info :author) info)) + (?e . ,(mapconcat + (lambda (e) (format "%s" e e)) + (split-string (plist-get info :email) ",+ *") + ", ")) + (?c . ,(plist-get info :creator)) + (?C . ,(let ((file (plist-get info :input-file))) + (format-time-string timestamp-format + (and file (nth 5 (file-attributes file)))))) + (?v . ,(or (plist-get info :html-validation-link) ""))))) (defun org-html--build-pre/postamble (type info) "Return document preamble or postamble as a string, or nil. -TYPE is either 'preamble or 'postamble, INFO is a plist used as a +TYPE is either `preamble' or `postamble', INFO is a plist used as a communication channel." (let ((section (plist-get info (intern (format ":html-%s" type)))) (spec (org-html-format-spec info))) @@ -1649,7 +1910,6 @@ communication channel." (author (cdr (assq ?a spec))) (email (cdr (assq ?e spec))) (creator (cdr (assq ?c spec))) - (timestamp (cdr (assq ?T spec))) (validation-link (cdr (assq ?v spec)))) (concat (when (and (plist-get info :with-date) @@ -1671,30 +1931,34 @@ communication channel." (format "

    %s: %s

    \n" (org-html--translate "Created" info) - (format-time-string org-html-metadata-timestamp-format))) + (format-time-string + (plist-get info :html-metadata-timestamp-format)))) (when (plist-get info :with-creator) (format "

    %s

    \n" creator)) (format "

    %s

    \n" validation-link)))) (t (format-spec - (or (cadr (assoc + (or (cadr (assoc-string (plist-get info :language) (eval (intern - (format "org-html-%s-format" type))))) + (format "org-html-%s-format" type))) + t)) (cadr - (assoc + (assoc-string "en" (eval - (intern (format "org-html-%s-format" type)))))) + (intern (format "org-html-%s-format" type))) + t))) spec)))))) - (when (org-string-nw-p section-contents) - (concat - (format "<%s id=\"%s\" class=\"%s\">\n" - (nth 1 (assq type org-html-divs)) - (nth 2 (assq type org-html-divs)) - org-html--pre/postamble-class) - (org-element-normalize-string section-contents) - (format "\n" (nth 1 (assq type org-html-divs))))))))) + (let ((div (assq type (plist-get info :html-divs)))) + (when (org-string-nw-p section-contents) + (concat + (format "<%s id=\"%s\" class=\"%s\">\n" + (nth 1 div) + (nth 2 div) + org-html--pre/postamble-class) + (org-element-normalize-string section-contents) + (format "\n" (nth 1 div))))))))) (defun org-html-inner-template (contents info) "Return body of document string after HTML conversion. @@ -1715,27 +1979,28 @@ CONTENTS is the transcoded contents string. INFO is a plist holding export options." (concat (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info)) - (let ((decl (or (and (stringp org-html-xml-declaration) - org-html-xml-declaration) - (cdr (assoc (plist-get info :html-extension) - org-html-xml-declaration)) - (cdr (assoc "html" org-html-xml-declaration)) - - ""))) - (when (not (or (eq nil decl) (string= "" decl))) + (let* ((xml-declaration (plist-get info :html-xml-declaration)) + (decl (or (and (stringp xml-declaration) xml-declaration) + (cdr (assoc (plist-get info :html-extension) + xml-declaration)) + (cdr (assoc "html" xml-declaration)) + ""))) + (when (not (or (not decl) (string= "" decl))) (format "%s\n" (format decl - (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system 'mime-charset)) - "iso-8859-1")))))) + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")))))) (org-html-doctype info) "\n" (concat "\n") "\n" (org-html--build-meta-info info) @@ -1746,21 +2011,34 @@ holding export options." (let ((link-up (org-trim (plist-get info :html-link-up))) (link-home (org-trim (plist-get info :html-link-home)))) (unless (and (string= link-up "") (string= link-home "")) - (format org-html-home/up-format + (format (plist-get info :html-home/up-format) (or link-up link-home) (or link-home link-up)))) ;; Preamble. (org-html--build-pre/postamble 'preamble info) ;; Document contents. - (format "<%s id=\"%s\">\n" - (nth 1 (assq 'content org-html-divs)) - (nth 2 (assq 'content org-html-divs))) + (let ((div (assq 'content (plist-get info :html-divs)))) + (format "<%s id=\"%s\">\n" (nth 1 div) (nth 2 div))) ;; Document title. - (let ((title (plist-get info :title))) - (format "

    %s

    \n" (org-export-data (or title "") info))) + (when (plist-get info :with-title) + (let ((title (plist-get info :title)) + (subtitle (plist-get info :subtitle)) + (html5-fancy (org-html--html5-fancy-p info))) + (when title + (format + (if html5-fancy + "
    \n

    %s

    \n%s
    " + "

    %s%s

    \n") + (org-export-data title info) + (if subtitle + (format + (if html5-fancy + "

    %s

    \n" + "\n
    \n%s\n") + (org-export-data subtitle info)) + ""))))) contents - (format "\n" - (nth 1 (assq 'content org-html-divs))) + (format "\n" (nth 1 (assq 'content (plist-get info :html-divs)))) ;; Postamble. (org-html--build-pre/postamble 'postamble info) ;; Closing document. @@ -1773,9 +2051,9 @@ INFO is a plist used as a communication channel." ;;;; Anchor -(defun org-html--anchor (&optional id desc attributes) +(defun org-html--anchor (id desc attributes info) "Format a HTML anchor." - (let* ((name (and org-html-allow-name-attribute-in-anchors id)) + (let* ((name (and (plist-get info :html-allow-name-attribute-in-anchors) id)) (attributes (concat (and id (format " id=\"%s\"" id)) (and name (format " name=\"%s\"" name)) attributes))) @@ -1783,43 +2061,38 @@ INFO is a plist used as a communication channel." ;;;; Todo -(defun org-html--todo (todo) +(defun org-html--todo (todo info) "Format TODO keywords into HTML." (when todo (format "%s" (if (member todo org-done-keywords) "done" "todo") - org-html-todo-kwd-class-prefix (org-html-fix-class-name todo) + (or (plist-get info :html-todo-kwd-class-prefix) "") + (org-html-fix-class-name todo) todo))) +;;;; Priority + +(defun org-html--priority (priority _info) + "Format a priority into HTML. +PRIORITY is the character code of the priority or nil. INFO is +a plist containing export options." + (and priority (format "[%c]" priority))) + ;;;; Tags -(defun org-html--tags (tags) - "Format TAGS into HTML." +(defun org-html--tags (tags info) + "Format TAGS into HTML. +INFO is a plist containing export options." (when tags (format "%s" (mapconcat (lambda (tag) (format "%s" - (concat org-html-tag-class-prefix + (concat (plist-get info :html-tag-class-prefix) (org-html-fix-class-name tag)) tag)) tags " ")))) -;;;; Headline - -(defun* org-html-format-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - "Format a headline in HTML." - (let ((section-number - (when section-number - (format "%s " - level section-number))) - (todo (org-html--todo todo)) - (tags (org-html--tags tags))) - (concat section-number todo (and todo " ") text - (and tags "   ") tags))) - ;;;; Src Code (defun org-html-fontify-code (code lang) @@ -1838,6 +2111,10 @@ is the language used for CODE, as a string, or nil." (message "Cannot fontify src block (htmlize.el >= 1.34 required)") ;; Simple transcoding. (org-html-encode-plain-text code)) + ;; Case 3: plain text explicitly set + ((not org-html-htmlize-output-type) + ;; Simple transcoding. + (org-html-encode-plain-text code)) (t ;; Map language (setq lang (or (assoc-default lang org-src-lang-modes) lang)) @@ -1850,25 +2127,30 @@ is the language used for CODE, as a string, or nil." ;; Case 2: Default. Fontify code. (t ;; htmlize - (setq code (with-temp-buffer - ;; Switch to language-specific mode. - (funcall lang-mode) - (insert code) - ;; Fontify buffer. - (org-font-lock-ensure) - ;; Remove formatting on newline characters. - (save-excursion - (let ((beg (point-min)) - (end (point-max))) - (goto-char beg) - (while (progn (end-of-line) (< (point) end)) - (put-text-property (point) (1+ (point)) 'face nil) - (forward-char 1)))) - (org-src-mode) - (set-buffer-modified-p nil) - ;; Htmlize region. - (org-html-htmlize-region-for-paste - (point-min) (point-max)))) + (setq code + (let ((output-type org-html-htmlize-output-type) + (font-prefix org-html-htmlize-font-prefix)) + (with-temp-buffer + ;; Switch to language-specific mode. + (funcall lang-mode) + (insert code) + ;; Fontify buffer. + (org-font-lock-ensure) + ;; Remove formatting on newline characters. + (save-excursion + (let ((beg (point-min)) + (end (point-max))) + (goto-char beg) + (while (progn (end-of-line) (< (point) end)) + (put-text-property (point) (1+ (point)) 'face nil) + (forward-char 1)))) + (org-src-mode) + (set-buffer-modified-p nil) + ;; Htmlize region. + (let ((org-html-htmlize-output-type output-type) + (org-html-htmlize-font-prefix font-prefix)) + (org-html-htmlize-region-for-paste + (point-min) (point-max)))))) ;; Strip any enclosing 
     tags.
 	  (let* ((beg (and (string-match "\\`]*>\n*" code) (match-end 0)))
 		 (end (and beg (string-match "\\'" code))))
@@ -1921,38 +2203,39 @@ a plist used as a communication channel."
 	 ;; Does the src block contain labels?
 	 (retain-labels (org-element-property :retain-labels element))
 	 ;; Does it have line numbers?
-	 (num-start (case (org-element-property :number-lines element)
-		      (continued (org-export-get-loc element info))
-		      (new 0))))
+	 (num-start (org-export-get-loc element info)))
     (org-html-do-format-code code lang refs retain-labels num-start)))
 
 
 ;;; Tables of Contents
 
-(defun org-html-toc (depth info)
+(defun org-html-toc (depth info &optional scope)
   "Build a table of contents.
-DEPTH is an integer specifying the depth of the table.  INFO is a
-plist used as a communication channel.  Return the table of
-contents as a string, or nil if it is empty."
+DEPTH is an integer specifying the depth of the table.  INFO is
+a plist used as a communication channel.  Optional argument SCOPE
+is an element defining the scope of the table.  Return the table
+of contents as a string, or nil if it is empty."
   (let ((toc-entries
 	 (mapcar (lambda (headline)
 		   (cons (org-html--format-toc-headline headline info)
 			 (org-export-get-relative-level headline info)))
-		 (org-export-collect-headlines info depth)))
-	(outer-tag (if (and (org-html-html5-p info)
-			    (plist-get info :html-html5-fancy))
-		       "nav"
-		     "div")))
+		 (org-export-collect-headlines info depth scope))))
     (when toc-entries
-      (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
-	      (format "%s\n"
-		      org-html-toplevel-hlevel
-		      (org-html--translate "Table of Contents" info)
-		      org-html-toplevel-hlevel)
-	      "
    "
-	      (org-html--toc-text toc-entries)
-	      "
    \n"
-	      (format "\n" outer-tag)))))
+      (let ((toc (concat "
    "
+			 (org-html--toc-text toc-entries)
+			 "
    \n")))
+	(if scope toc
+	  (let ((outer-tag (if (org-html--html5-fancy-p info)
+			       "nav"
+			     "div")))
+	    (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+		    (let ((top-level (plist-get info :html-toplevel-hlevel)))
+		      (format "%s\n"
+			      top-level
+			      (org-html--translate "Table of Contents" info)
+			      top-level))
+		    toc
+		    (format "\n" outer-tag))))))))
 
 (defun org-html--toc-text (toc-entries)
   "Return innards of a table of contents, as a string.
@@ -1967,8 +2250,7 @@ and value is its relative level, as an integer."
 	      (level (cdr entry)))
 	  (concat
 	   (let* ((cnt (- level prev-level))
-		  (times (if (> cnt 0) (1- cnt) (- cnt)))
-		  rtn)
+		  (times (if (> cnt 0) (1- cnt) (- cnt))))
 	     (setq prev-level level)
 	     (concat
 	      (org-html--make-string
@@ -2005,21 +2287,15 @@ INFO is a plist used as a communication channel."
 		    (org-export-get-tags headline info))))
     (format "%s"
 	    ;; Label.
-	    (org-export-solidify-link-text
-	     (or (org-element-property :CUSTOM_ID headline)
-		 (concat "sec-"
-			 (mapconcat #'number-to-string headline-number "-"))))
+	    (or (org-element-property :CUSTOM_ID headline)
+		(org-export-get-reference headline info))
 	    ;; Body.
 	    (concat
 	     (and (not (org-export-low-level-p headline info))
 		  (org-export-numbered-headline-p headline info)
 		  (concat (mapconcat #'number-to-string headline-number ".")
 			  ". "))
-	     (apply (if (not (eq org-html-format-headline-function 'ignore))
-			(lambda (todo todo-type priority text tags &rest ignore)
-			  (funcall org-html-format-headline-function
-				   todo todo-type priority text tags))
-		      #'org-html-format-headline)
+	     (apply (plist-get info :html-format-headline-function)
 		    todo todo-type priority text tags :section-number nil)))))
 
 (defun org-html-list-of-listings (info)
@@ -2029,17 +2305,19 @@ of listings as a string, or nil if it is empty."
   (let ((lol-entries (org-export-collect-listings info)))
     (when lol-entries
       (concat "
    \n"
-	      (format "%s\n"
-		      org-html-toplevel-hlevel
-		      (org-html--translate "List of Listings" info)
-		      org-html-toplevel-hlevel)
+	      (let ((top-level (plist-get info :html-toplevel-hlevel)))
+		(format "%s\n"
+			top-level
+			(org-html--translate "List of Listings" info)
+			top-level))
 	      "
    \n
      \n"
 	      (let ((count 0)
 		    (initial-fmt (format "%s"
 					 (org-html--translate "Listing %d:" info))))
 		(mapconcat
 		 (lambda (entry)
-		   (let ((label (org-element-property :name entry))
+		   (let ((label (and (org-element-property :name entry)
+				     (org-export-get-reference entry info)))
 			 (title (org-trim
 				 (org-export-data
 				  (or (org-export-get-caption entry t)
@@ -2048,10 +2326,12 @@ of listings as a string, or nil if it is empty."
 		     (concat
 		      "
    • "
 		      (if (not label)
-			  (concat (format initial-fmt (incf count)) " " title)
+			  (concat (format initial-fmt (cl-incf count))
+				  " "
+				  title)
 			(format "%s %s"
-				(org-export-solidify-link-text label)
-				(format initial-fmt (incf count))
+				label
+				(format initial-fmt (cl-incf count))
 				title))
 		      "
      • ")))
 		 lol-entries "\n"))
@@ -2064,17 +2344,19 @@ of tables as a string, or nil if it is empty."
   (let ((lol-entries (org-export-collect-tables info)))
     (when lol-entries
       (concat "
      \n"
-	      (format "%s\n"
-		      org-html-toplevel-hlevel
-		      (org-html--translate "List of Tables" info)
-		      org-html-toplevel-hlevel)
+	      (let ((top-level (plist-get info :html-toplevel-hlevel)))
+		(format "%s\n"
+			top-level
+			(org-html--translate "List of Tables" info)
+			top-level))
 	      "
      \n
        \n"
 	      (let ((count 0)
 		    (initial-fmt (format "%s"
 					 (org-html--translate "Table %d:" info))))
 		(mapconcat
 		 (lambda (entry)
-		   (let ((label (org-element-property :name entry))
+		   (let ((label (and (org-element-property :name entry)
+				     (org-export-get-reference entry info)))
 			 (title (org-trim
 				 (org-export-data
 				  (or (org-export-get-caption entry t)
@@ -2083,10 +2365,12 @@ of tables as a string, or nil if it is empty."
 		     (concat
 		      "
      • "
 		      (if (not label)
-			  (concat (format initial-fmt (incf count)) " " title)
+			  (concat (format initial-fmt (cl-incf count))
+				  " "
+				  title)
 			(format "%s %s"
-				(org-export-solidify-link-text label)
-				(format initial-fmt (incf count))
+				label
+				(format initial-fmt (cl-incf count))
 				title))
 		      "
        • ")))
 		 lol-entries "\n"))
@@ -2097,24 +2381,24 @@ of tables as a string, or nil if it is empty."
 
 ;;;; Bold
 
-(defun org-html-bold (bold contents info)
+(defun org-html-bold (_bold contents info)
   "Transcode BOLD from Org to HTML.
 CONTENTS is the text with bold markup.  INFO is a plist holding
 contextual information."
-  (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s")
+  (format (or (cdr (assq 'bold (plist-get info :html-text-markup-alist))) "%s")
 	  contents))
 
 ;;;; Center Block
 
-(defun org-html-center-block (center-block contents info)
+(defun org-html-center-block (_center-block contents _info)
   "Transcode a CENTER-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information."
-  (format "
        \n%s
        " contents))
+  (format "
        \n%s
        " contents))
 
 ;;;; Clock
 
-(defun org-html-clock (clock contents info)
+(defun org-html-clock (clock _contents _info)
   "Transcode a CLOCK element from Org to HTML.
 CONTENTS is nil.  INFO is a plist used as a communication
 channel."
@@ -2124,19 +2408,17 @@ channel."
 
 
        "
 	  org-clock-string
-	  (org-translate-time
-	   (org-element-property :raw-value
-				 (org-element-property :value clock)))
+	  (org-timestamp-translate (org-element-property :value clock))
 	  (let ((time (org-element-property :duration clock)))
 	    (and time (format " (%s)" time)))))
 
 ;;;; Code
 
-(defun org-html-code (code contents info)
+(defun org-html-code (code _contents info)
   "Transcode CODE from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
-  (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s")
+  (format (or (cdr (assq 'code (plist-get info :html-text-markup-alist))) "%s")
 	  (org-html-encode-plain-text (org-element-property :value code))))
 
 ;;;; Drawer
@@ -2145,17 +2427,13 @@ information."
   "Transcode a DRAWER element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information."
-  (if (functionp org-html-format-drawer-function)
-      (funcall org-html-format-drawer-function
-	       (org-element-property :drawer-name drawer)
-	       contents)
-    ;; If there's no user defined function: simply
-    ;; display contents of the drawer.
-    contents))
+  (funcall (plist-get info :html-format-drawer-function)
+	   (org-element-property :drawer-name drawer)
+	   contents))
 
 ;;;; Dynamic Block
 
-(defun org-html-dynamic-block (dynamic-block contents info)
+(defun org-html-dynamic-block (_dynamic-block contents _info)
   "Transcode a DYNAMIC-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information.  See `org-export-data'."
@@ -2163,7 +2441,7 @@ holding contextual information.  See `org-export-data'."
 
 ;;;; Entity
 
-(defun org-html-entity (entity contents info)
+(defun org-html-entity (entity _contents _info)
   "Transcode an ENTITY object from Org to HTML.
 CONTENTS are the definition itself.  INFO is a plist holding
 contextual information."
@@ -2171,18 +2449,25 @@ contextual information."
 
 ;;;; Example Block
 
-(defun org-html-example-block (example-block contents info)
+(defun org-html-example-block (example-block _contents info)
   "Transcode a EXAMPLE-BLOCK element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
-  (if (org-export-read-attribute :attr_html example-block :textarea)
-      (org-html--textarea-block example-block)
-    (format "
        \n%s
        "
-	    (org-html-format-code example-block info))))
+  (let ((attributes (org-export-read-attribute :attr_html example-block)))
+    (if (plist-get attributes :textarea)
+	(org-html--textarea-block example-block)
+      (format "
        \n%s
        "
+	      (let* ((name (org-element-property :name example-block))
+		     (a (org-html--make-attribute-string
+			 (if (or (not name) (plist-member attributes :id))
+			     attributes
+			   (plist-put attributes :id name)))))
+		(if (org-string-nw-p a) (concat " " a) ""))
+	      (org-html-format-code example-block info)))))
 
 ;;;; Export Snippet
 
-(defun org-html-export-snippet (export-snippet contents info)
+(defun org-html-export-snippet (export-snippet _contents _info)
   "Transcode a EXPORT-SNIPPET object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
@@ -2191,7 +2476,7 @@ information."
 
 ;;;; Export Block
 
-(defun org-html-export-block (export-block contents info)
+(defun org-html-export-block (export-block _contents _info)
   "Transcode a EXPORT-BLOCK element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (when (string= (org-element-property :type export-block) "HTML")
@@ -2199,7 +2484,7 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 
 ;;;; Fixed Width
 
-(defun org-html-fixed-width (fixed-width contents info)
+(defun org-html-fixed-width (fixed-width _contents _info)
   "Transcode a FIXED-WIDTH element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (format "
        \n%s
        "
@@ -2209,135 +2494,116 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 
 ;;;; Footnote Reference
 
-(defun org-html-footnote-reference (footnote-reference contents info)
+(defun org-html-footnote-reference (footnote-reference _contents info)
   "Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (concat
    ;; Insert separator between two footnotes in a row.
    (let ((prev (org-export-get-previous-element footnote-reference info)))
      (when (eq (org-element-type prev) 'footnote-reference)
-       org-html-footnote-separator))
-   (cond
-    ((not (org-export-footnote-first-reference-p footnote-reference info))
-     (org-html-format-footnote-reference
-      (org-export-get-footnote-number footnote-reference info)
-      "IGNORED" 100))
-    ;; Inline definitions are secondary strings.
-    ((eq (org-element-property :type footnote-reference) 'inline)
-     (org-html-format-footnote-reference
-      (org-export-get-footnote-number footnote-reference info)
-      "IGNORED" 1))
-    ;; Non-inline footnotes definitions are full Org data.
-    (t (org-html-format-footnote-reference
-	(org-export-get-footnote-number footnote-reference info)
-	"IGNORED" 1)))))
+       (plist-get info :html-footnote-separator)))
+   (let* ((n (org-export-get-footnote-number footnote-reference info))
+	  (id (format "fnr.%d%s"
+		      n
+		      (if (org-export-footnote-first-reference-p
+			   footnote-reference info)
+			  ""
+			".100"))))
+     (format
+      (plist-get info :html-footnote-format)
+      (org-html--anchor
+       id n (format " class=\"footref\" href=\"#fn.%d\"" n) info)))))
 
 ;;;; Headline
 
-(defun org-html-format-headline--wrap
-  (headline info &optional format-function &rest extra-keys)
-  "Transcode a HEADLINE element from Org to HTML.
-CONTENTS holds the contents of the headline.  INFO is a plist
-holding contextual information."
-  (let* ((level (+ (org-export-get-relative-level headline info)
-		   (1- org-html-toplevel-hlevel)))
-	 (headline-number (org-export-get-headline-number headline info))
-	 (section-number (and (not (org-export-low-level-p headline info))
-			      (org-export-numbered-headline-p headline info)
-			      (mapconcat 'number-to-string
-					 headline-number ".")))
-	 (todo (and (plist-get info :with-todo-keywords)
-		    (let ((todo (org-element-property :todo-keyword headline)))
-		      (and todo (org-export-data todo info)))))
-	 (todo-type (and todo (org-element-property :todo-type headline)))
-	 (priority (and (plist-get info :with-priority)
-			(org-element-property :priority headline)))
-	 (text (org-export-data (org-element-property :title headline) info))
-	 (tags (and (plist-get info :with-tags)
-		    (org-export-get-tags headline info)))
-	 (headline-label (or (org-element-property :CUSTOM_ID headline)
-			     (concat "sec-" (mapconcat 'number-to-string
-						       headline-number "-"))))
-	 (format-function
-	  (cond ((functionp format-function) format-function)
-		((not (eq org-html-format-headline-function 'ignore))
-		 (lambda (todo todo-type priority text tags &rest ignore)
-		   (funcall org-html-format-headline-function
-			    todo todo-type priority text tags)))
-		(t 'org-html-format-headline))))
-    (apply format-function
-	   todo todo-type  priority text tags
-	   :headline-label headline-label :level level
-	   :section-number section-number extra-keys)))
-
 (defun org-html-headline (headline contents info)
   "Transcode a HEADLINE element from Org to HTML.
 CONTENTS holds the contents of the headline.  INFO is a plist
 holding contextual information."
   (unless (org-element-property :footnote-section-p headline)
-    (let* ((contents (or contents ""))
-	   (numberedp (org-export-numbered-headline-p headline info))
-	   (level (org-export-get-relative-level headline info))
-	   (text (org-export-data (org-element-property :title headline) info))
-	   (todo (and (plist-get info :with-todo-keywords)
-		      (let ((todo (org-element-property :todo-keyword headline)))
-			(and todo (org-export-data todo info)))))
-	   (todo-type (and todo (org-element-property :todo-type headline)))
-	   (tags (and (plist-get info :with-tags)
-		      (org-export-get-tags headline info)))
-	   (priority (and (plist-get info :with-priority)
-			  (org-element-property :priority headline)))
-	   (section-number (mapconcat #'number-to-string
-				      (org-export-get-headline-number
-				       headline info) "-"))
-	   (ids (delq 'nil
-		      (list (org-element-property :CUSTOM_ID headline)
-			    (concat "sec-" section-number)
-			    (org-element-property :ID headline))))
-	   (preferred-id (car ids))
-	   (extra-ids (mapconcat
-		       (lambda (id)
-			 (org-html--anchor
-			  (org-export-solidify-link-text
-			   (if (org-uuidgen-p id) (concat "ID-" id) id))))
-		       (cdr ids) ""))
-	   ;; Create the headline text.
-	   (full-text (org-html-format-headline--wrap headline info)))
+    (let* ((numberedp (org-export-numbered-headline-p headline info))
+           (numbers (org-export-get-headline-number headline info))
+           (level (+ (org-export-get-relative-level headline info)
+                     (1- (plist-get info :html-toplevel-hlevel))))
+           (todo (and (plist-get info :with-todo-keywords)
+                      (let ((todo (org-element-property :todo-keyword headline)))
+                        (and todo (org-export-data todo info)))))
+           (todo-type (and todo (org-element-property :todo-type headline)))
+           (priority (and (plist-get info :with-priority)
+                          (org-element-property :priority headline)))
+           (text (org-export-data (org-element-property :title headline) info))
+           (tags (and (plist-get info :with-tags)
+                      (org-export-get-tags headline info)))
+           (full-text (funcall (plist-get info :html-format-headline-function)
+                               todo todo-type priority text tags info))
+           (contents (or contents ""))
+	   (ids (delq nil
+                      (list (org-element-property :CUSTOM_ID headline)
+                            (org-export-get-reference headline info)
+                            (org-element-property :ID headline))))
+           (preferred-id (car ids))
+           (extra-ids
+	    (mapconcat
+	     (lambda (id)
+	       (org-html--anchor
+		(if (org-uuidgen-p id) (concat "ID-" id) id)
+		nil nil info))
+	     (cdr ids) "")))
       (if (org-export-low-level-p headline info)
-	  ;; This is a deep sub-tree: export it as a list item.
-	  (let* ((type (if numberedp 'ordered 'unordered))
-		 (itemized-body
-		  (org-html-format-list-item
-		   contents type nil info nil
-		   (concat (org-html--anchor preferred-id) extra-ids
-			   full-text))))
-	    (concat
-	     (and (org-export-first-sibling-p headline info)
-		  (org-html-begin-plain-list type))
-	     itemized-body
-	     (and (org-export-last-sibling-p headline info)
-		  (org-html-end-plain-list type))))
-	;; Standard headline.  Export it as a section.
-	(let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline))
-	      (level1 (+ level (1- org-html-toplevel-hlevel)))
-	      (first-content (car (org-element-contents headline))))
-	  (format "<%s id=\"%s\" class=\"%s\">%s%s\n"
-		  (org-html--container headline info)
-		  (format "outline-container-%s"
-			  (or (org-element-property :CUSTOM_ID headline)
-			      (concat "sec-" section-number)))
-		  (concat (format "outline-%d" level1) (and extra-class " ")
-			  extra-class)
-		  (format "\n%s%s\n"
-			  level1 preferred-id extra-ids full-text level1)
-		  ;; When there is no section, pretend there is an
-		  ;; empty one to get the correct 
        %s%s\n"
+                  (org-html--container headline info)
+                  (concat "outline-container-"
+			  (org-export-get-reference headline info))
+                  (concat (format "outline-%d" level)
+                          (and extra-class " ")
+                          extra-class)
+                  (format "\n%s%s\n"
+                          level
+                          preferred-id
+                          extra-ids
+                          (concat
+                           (and numberedp
+                                (format
+                                 "%s "
+                                 level
+                                 (mapconcat #'number-to-string numbers ".")))
+                           full-text)
+                          level)
+                  ;; When there is no section, pretend there is an
+                  ;; empty one to get the correct 
        %s" lang label code)))
 
 ;;;; Inlinetask
 
-(defun org-html-format-section (text class &optional id)
-  "Format a section with TEXT into a HTML div with CLASS and ID."
-  (let ((extra (concat (when id (format " id=\"%s\"" id)))))
-    (concat (format "
        \n" class extra) text "
        \n")))
-
 (defun org-html-inlinetask (inlinetask contents info)
   "Transcode an INLINETASK element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information."
-  (cond
-   ;; If `org-html-format-inlinetask-function' is not 'ignore, call it
-   ;; with appropriate arguments.
-   ((not (eq org-html-format-inlinetask-function 'ignore))
-    (let ((format-function
-	   (function*
-	    (lambda (todo todo-type priority text tags
-		     &key contents &allow-other-keys)
-	      (funcall org-html-format-inlinetask-function
-		       todo todo-type priority text tags contents)))))
-      (org-html-format-headline--wrap
-       inlinetask info format-function :contents contents)))
-   ;; Otherwise, use a default template.
-   (t (format "
        \n%s%s\n%s
        "
-	      (org-html-format-headline--wrap inlinetask info)
-	      (org-html-close-tag "br" nil info)
-	      contents))))
+  (let* ((todo (and (plist-get info :with-todo-keywords)
+		    (let ((todo (org-element-property :todo-keyword inlinetask)))
+		      (and todo (org-export-data todo info)))))
+	 (todo-type (and todo (org-element-property :todo-type inlinetask)))
+	 (priority (and (plist-get info :with-priority)
+			(org-element-property :priority inlinetask)))
+	 (text (org-export-data (org-element-property :title inlinetask) info))
+	 (tags (and (plist-get info :with-tags)
+		    (org-export-get-tags inlinetask info))))
+    (funcall (plist-get info :html-format-inlinetask-function)
+	     todo todo-type priority text tags contents info)))
+
+(defun org-html-format-inlinetask-default-function
+  (todo todo-type priority text tags contents info)
+  "Default format function for a inlinetasks.
+See `org-html-format-inlinetask-function' for details."
+  (format "
        \n%s%s\n%s
        "
+	  (org-html-format-headline-default-function
+	   todo todo-type priority text tags info)
+	  (org-html-close-tag "br" nil info)
+	  contents))
 
 ;;;; Italic
 
-(defun org-html-italic (italic contents info)
+(defun org-html-italic (_italic contents info)
   "Transcode ITALIC from Org to HTML.
 CONTENTS is the text with italic markup.  INFO is a plist holding
 contextual information."
-  (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents))
+  (format
+   (or (cdr (assq 'italic (plist-get info :html-text-markup-alist))) "%s")
+   contents))
 
 ;;;; Item
 
-(defun org-html-checkbox (checkbox)
-  "Format CHECKBOX into HTML."
-  (case checkbox (on "[X]")
-	(off "[ ]")
-	(trans "[-]")
-	(t "")))
+(defun org-html-checkbox (checkbox info)
+  "Format CHECKBOX into HTML.
+INFO is a plist holding contextual information.  See
+`org-html-checkbox-type' for customization options."
+  (cdr (assq checkbox
+	     (cdr (assq (plist-get info :html-checkbox-type)
+			org-html-checkbox-types)))))
 
 (defun org-html-format-list-item (contents type checkbox info
-					     &optional term-counter-id
-					     headline)
+					   &optional term-counter-id
+					   headline)
   "Format a list item into HTML."
-  (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
+  (let ((class (if checkbox
+		   (format " class=\"%s\""
+			   (symbol-name checkbox)) ""))
+	(checkbox (concat (org-html-checkbox checkbox info)
+			  (and checkbox " ")))
 	(br (org-html-close-tag "br" nil info)))
     (concat
-     (case type
-       (ordered
+     (pcase type
+       (`ordered
 	(let* ((counter term-counter-id)
 	       (extra (if counter (format " value=\"%s\"" counter) "")))
 	  (concat
-	   (format "" extra)
+	   (format "" class extra)
 	   (when headline (concat headline br)))))
-       (unordered
+       (`unordered
 	(let* ((id term-counter-id)
 	       (extra (if id (format " id=\"%s\"" id) "")))
 	  (concat
-	   (format "" extra)
+	   (format "" class extra)
 	   (when headline (concat headline br)))))
-       (descriptive
+       (`descriptive
 	(let* ((term term-counter-id))
 	  (setq term (or term "(no term)"))
 	  ;; Check-boxes in descriptive lists are associated to tag.
-	  (concat (format "
         %s 
        "
-			  (concat checkbox term))
+	  (concat (format "%s"
+			  class (concat checkbox term))
 		  "
        "))))
      (unless (eq type 'descriptive) checkbox)
-     contents
-     (case type
-       (ordered "")
-       (unordered "")
-       (descriptive "
        ")))))
+     (and contents (org-trim contents))
+     (pcase type
+       (`ordered "")
+       (`unordered "")
+       (`descriptive "
    • ")))))
 
 (defun org-html-item (item contents info)
   "Transcode an ITEM element from Org to HTML.
@@ -2457,7 +2735,7 @@ contextual information."
 
 ;;;; Keyword
 
-(defun org-html-keyword (keyword contents info)
+(defun org-html-keyword (keyword _contents info)
   "Transcode a KEYWORD element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (let ((key (org-element-property :key keyword))
@@ -2465,13 +2743,13 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
     (cond
      ((string= key "HTML") value)
      ((string= key "TOC")
-      (let ((value (downcase value)))
+      (let ((case-fold-search t))
 	(cond
 	 ((string-match "\\" value)
-	  (let ((depth (or (and (string-match "[0-9]+" value)
-				(string-to-number (match-string 0 value)))
-			   (plist-get info :with-toc))))
-	    (org-html-toc depth info)))
+	  (let ((depth (and (string-match "\\<[0-9]+\\>" value)
+			    (string-to-number (match-string 0 value))))
+		(localp (string-match-p "\\" value)))
+	    (org-html-toc depth info (and localp keyword))))
 	 ((string= "listings" value) (org-html-list-of-listings info))
 	 ((string= "tables" value) (org-html-list-of-tables info))))))))
 
@@ -2479,10 +2757,11 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 
 (defun org-html-format-latex (latex-frag processing-type info)
   "Format a LaTeX fragment LATEX-FRAG into HTML.
-PROCESSING-TYPE designates the tool used for conversion.  It is
-a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil
-and t.  See `org-html-with-latex' for more information.  INFO is
-a plist containing export properties."
+PROCESSING-TYPE designates the tool used for conversion.  It can
+be `mathjax', `verbatim', nil, t or symbols in
+`org-preview-latex-process-alist', e.g., `dvipng', `dvisvgm' or
+`imagemagick'.  See `org-html-with-latex' for more information.
+INFO is a plist containing export properties."
   (let ((cache-relpath "") (cache-dir ""))
     (unless (eq processing-type 'mathjax)
       (let ((bfn (or (buffer-file-name)
@@ -2497,7 +2776,7 @@ a plist containing export properties."
 			     "\n")
 			    "\n")))))
 	(setq cache-relpath
-	      (concat "ltxpng/"
+	      (concat (file-name-as-directory org-preview-latex-image-directory)
 		      (file-name-sans-extension
 		       (file-name-nondirectory bfn)))
 	      cache-dir (file-name-directory bfn))
@@ -2507,51 +2786,51 @@ a plist containing export properties."
 	(setq latex-frag (concat latex-header latex-frag))))
     (with-temp-buffer
       (insert latex-frag)
-      (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..."
-			nil nil processing-type)
+      (org-format-latex cache-relpath nil nil cache-dir nil
+			"Creating LaTeX Image..." nil processing-type)
       (buffer-string))))
 
-(defun org-html-latex-environment (latex-environment contents info)
+(defun org-html-latex-environment (latex-environment _contents info)
   "Transcode a LATEX-ENVIRONMENT element from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (let ((processing-type (plist-get info :with-latex))
 	(latex-frag (org-remove-indentation
 		     (org-element-property :value latex-environment)))
 	(attributes (org-export-read-attribute :attr_html latex-environment)))
-    (case processing-type
-      ((t mathjax)
-       (org-html-format-latex latex-frag 'mathjax info))
-      ((dvipng imagemagick)
-       (let ((formula-link
-	      (org-html-format-latex latex-frag processing-type info)))
-	 (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
-	   ;; Do not provide a caption or a name to be consistent with
-	   ;; `mathjax' handling.
-	   (org-html--wrap-image
-	    (org-html--format-image
-	     (match-string 1 formula-link) attributes info) info))))
-      (t latex-frag))))
+    (cond
+     ((memq processing-type '(t mathjax))
+      (org-html-format-latex latex-frag 'mathjax info))
+     ((assq processing-type org-preview-latex-process-alist)
+      (let ((formula-link
+	     (org-html-format-latex latex-frag processing-type info)))
+	(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+	  ;; Do not provide a caption or a name to be consistent with
+	  ;; `mathjax' handling.
+	  (org-html--wrap-image
+	   (org-html--format-image
+	    (match-string 1 formula-link) attributes info) info))))
+     (t latex-frag))))
 
 ;;;; Latex Fragment
 
-(defun org-html-latex-fragment (latex-fragment contents info)
+(defun org-html-latex-fragment (latex-fragment _contents info)
   "Transcode a LATEX-FRAGMENT object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (let ((latex-frag (org-element-property :value latex-fragment))
 	(processing-type (plist-get info :with-latex)))
-    (case processing-type
-      ((t mathjax)
-       (org-html-format-latex latex-frag 'mathjax info))
-      ((dvipng imagemagick)
-       (let ((formula-link
-	      (org-html-format-latex latex-frag processing-type info)))
-	 (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
-	   (org-html--format-image (match-string 1 formula-link) nil info))))
-      (t latex-frag))))
+    (cond
+     ((memq processing-type '(t mathjax))
+      (org-html-format-latex latex-frag 'mathjax info))
+     ((assq processing-type org-preview-latex-process-alist)
+      (let ((formula-link
+	     (org-html-format-latex latex-frag processing-type info)))
+	(when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+	  (org-html--format-image (match-string 1 formula-link) nil info))))
+     (t latex-frag))))
 
 ;;;; Line Break
 
-(defun org-html-line-break (line-break contents info)
+(defun org-html-line-break (_line-break _contents info)
   "Transcode a LINE-BREAK object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (concat (org-html-close-tag "br" nil info) "\n"))
@@ -2565,19 +2844,20 @@ inline image when it has no description and targets an image
 file (see `org-html-inline-image-rules' for more information), or
 if its description is a single link targeting an image file."
   (if (not (org-element-contents link))
-      (org-export-inline-image-p link org-html-inline-image-rules)
+      (org-export-inline-image-p
+       link (plist-get info :html-inline-image-rules))
     (not
      (let ((link-count 0))
        (org-element-map (org-element-contents link)
 	   (cons 'plain-text org-element-all-objects)
 	 (lambda (obj)
-	   (case (org-element-type obj)
-	     (plain-text (org-string-nw-p obj))
-	     (link (if (= link-count 1) t
-		     (incf link-count)
-		     (not (org-export-inline-image-p
-			   obj org-html-inline-image-rules))))
-	     (otherwise t)))
+	   (pcase (org-element-type obj)
+	     (`plain-text (org-string-nw-p obj))
+	     (`link (if (= link-count 1) t
+		      (cl-incf link-count)
+		      (not (org-export-inline-image-p
+			    obj (plist-get info :html-inline-image-rules)))))
+	     (_ t)))
          info t)))))
 
 (defvar org-html-standalone-image-predicate)
@@ -2599,9 +2879,9 @@ further.  For example, to check for only captioned standalone
 images, set it to:
 
   (lambda (paragraph) (org-element-property :caption paragraph))"
-  (let ((paragraph (case (org-element-type element)
-		     (paragraph element)
-		     (link (org-export-get-parent element)))))
+  (let ((paragraph (pcase (org-element-type element)
+		     (`paragraph element)
+		     (`link (org-export-get-parent element)))))
     (and (eq (org-element-type paragraph) 'paragraph)
 	 (or (not (fboundp 'org-html-standalone-image-predicate))
 	     (funcall org-html-standalone-image-predicate paragraph))
@@ -2609,19 +2889,18 @@ images, set it to:
 	   (let ((link-count 0))
 	     (org-element-map (org-element-contents paragraph)
 		 (cons 'plain-text org-element-all-objects)
-	       #'(lambda (obj)
-		   (when (case (org-element-type obj)
-			   (plain-text (org-string-nw-p obj))
-			   (link (or (> (incf link-count) 1)
-				     (not (org-html-inline-image-p obj info))))
-			   (otherwise t))
-		     (throw 'exit nil)))
+	       (lambda (obj)
+		 (when (pcase (org-element-type obj)
+			 (`plain-text (org-string-nw-p obj))
+			 (`link (or (> (cl-incf link-count) 1)
+				    (not (org-html-inline-image-p obj info))))
+			 (_ t))
+		   (throw 'exit nil)))
 	       info nil 'link)
 	     (= link-count 1))))))
 
 (defun org-html-link (link desc info)
   "Transcode a LINK object from Org to HTML.
-
 DESC is the description part of the link, or the empty string.
 INFO is a plist holding contextual information.  See
 `org-export-data'."
@@ -2629,56 +2908,49 @@ INFO is a plist holding contextual information.  See
 		 (org-trim (plist-get info :html-link-home))))
 	 (use-abs-url (plist-get info :html-link-use-abs-url))
 	 (link-org-files-as-html-maybe
-	  (function
-	   (lambda (raw-path info)
-	     "Treat links to `file.org' as links to `file.html', if needed.
-           See `org-html-link-org-files-as-html'."
-	     (cond
-	      ((and org-html-link-org-files-as-html
-		    (string= ".org"
-			     (downcase (file-name-extension raw-path "."))))
-	       (concat (file-name-sans-extension raw-path) "."
-		       (plist-get info :html-extension)))
-	      (t raw-path)))))
+	  (lambda (raw-path info)
+	    ;; Treat links to `file.org' as links to `file.html', if
+	    ;; needed.  See `org-html-link-org-files-as-html'.
+	    (cond
+	     ((and (plist-get info :html-link-org-files-as-html)
+		   (string= ".org"
+			    (downcase (file-name-extension raw-path "."))))
+	      (concat (file-name-sans-extension raw-path) "."
+		      (plist-get info :html-extension)))
+	     (t raw-path))))
 	 (type (org-element-property :type link))
 	 (raw-path (org-element-property :path link))
 	 ;; Ensure DESC really exists, or set it to nil.
 	 (desc (org-string-nw-p desc))
 	 (path
 	  (cond
-	   ((member type '("http" "https" "ftp" "mailto"))
-	    (org-link-escape
-	     (org-link-unescape
-	      (concat type ":" raw-path)) org-link-escape-chars-browser))
+	   ((member type '("http" "https" "ftp" "mailto" "news"))
+	    (url-encode-url (org-link-unescape (concat type ":" raw-path))))
 	   ((string= type "file")
 	    ;; Treat links to ".org" files as ".html", if needed.
 	    (setq raw-path
 		  (funcall link-org-files-as-html-maybe raw-path info))
 	    ;; If file path is absolute, prepend it with protocol
-	    ;; component - "file:".
+	    ;; component - "file://".
 	    (cond
 	     ((file-name-absolute-p raw-path)
-	      (setq raw-path (concat "file:" raw-path)))
+	      (setq raw-path (org-export-file-uri raw-path)))
 	     ((and home use-abs-url)
 	      (setq raw-path (concat (file-name-as-directory home) raw-path))))
 	    ;; Add search option, if any.  A search option can be
-	    ;; relative to a custom-id or a headline title.  Any other
-	    ;; option is ignored.
+	    ;; relative to a custom-id, a headline title, a name or
+	    ;; a target.
 	    (let ((option (org-element-property :search-option link)))
 	      (cond ((not option) raw-path)
-		    ((eq (aref option 0) ?#) (concat raw-path option))
-		    ;; External fuzzy link: try to resolve it if path
-		    ;; belongs to current project, if any.
-		    ((eq (aref option 0) ?*)
-		     (concat
-		      raw-path
-		      (let ((numbers
-			     (org-publish-resolve-external-fuzzy-link
-			      (org-element-property :path link) option)))
-			(and numbers (concat "#sec-"
-					     (mapconcat 'number-to-string
-							numbers "-"))))))
-		    (t raw-path))))
+		    ;; Since HTML back-end use custom-id value as-is,
+		    ;; resolving is them is trivial.
+		    ((eq (string-to-char option) ?#) (concat raw-path option))
+		    (t
+		     (concat raw-path
+			     "#"
+			     (org-publish-resolve-external-link
+			      option
+			      (org-element-property :path link)))))))
 	   (t raw-path)))
 	 ;; Extract attributes from parent's paragraph.  HACK: Only do
 	 ;; this for the first link in parent (inner image link for
@@ -2695,12 +2967,14 @@ INFO is a plist holding contextual information.  See
 		 (org-export-read-attribute :attr_html parent))))
 	 (attributes
 	  (let ((attr (org-html--make-attribute-string attributes-plist)))
-	    (if (org-string-nw-p attr) (concat " " attr) "")))
-	 protocol)
+	    (if (org-string-nw-p attr) (concat " " attr) ""))))
     (cond
+     ;; Link type is handled by a special function.
+     ((org-export-custom-protocol-maybe link desc 'html))
      ;; Image file.
-     ((and org-html-inline-images
-	   (org-export-inline-image-p link org-html-inline-image-rules))
+     ((and (plist-get info :html-inline-images)
+	   (org-export-inline-image-p
+	    link (plist-get info :html-inline-image-rules)))
       (org-html--format-image path attributes-plist info))
      ;; Radio target: Transcode target's contents and use them as
      ;; link's description.
@@ -2708,18 +2982,18 @@ INFO is a plist holding contextual information.  See
       (let ((destination (org-export-resolve-radio-link link info)))
 	(if (not destination) desc
 	  (format "%s"
-		  (org-export-solidify-link-text
-		   (org-element-property :value destination))
-		  attributes desc))))
+		  (org-export-get-reference destination info)
+		  attributes
+		  desc))))
      ;; Links pointing to a headline: Find destination and build
      ;; appropriate referencing command.
      ((member type '("custom-id" "fuzzy" "id"))
       (let ((destination (if (string= type "fuzzy")
 			     (org-export-resolve-fuzzy-link link info)
 			   (org-export-resolve-id-link link info))))
-	(case (org-element-type destination)
+	(pcase (org-element-type destination)
 	  ;; ID link points to an external file.
-	  (plain-text
+	  (`plain-text
 	   (let ((fragment (concat "ID-" path))
 		 ;; Treat links to ".org" files as ".html", if needed.
 		 (path (funcall link-org-files-as-html-maybe
@@ -2727,86 +3001,87 @@ INFO is a plist holding contextual information.  See
 	     (format "%s"
 		     path fragment attributes (or desc destination))))
 	  ;; Fuzzy link points nowhere.
-	  ((nil)
+	  (`nil
 	   (format "%s"
 		   (or desc
 		       (org-export-data
 			(org-element-property :raw-link link) info))))
 	  ;; Link points to a headline.
-	  (headline
-	   (let ((href
-		  ;; What href to use?
-		  (cond
-		   ;; Case 1: Headline is linked via it's CUSTOM_ID
-		   ;; property.  Use CUSTOM_ID.
-		   ((string= type "custom-id")
-		    (org-element-property :CUSTOM_ID destination))
-		   ;; Case 2: Headline is linked via it's ID property
-		   ;; or through other means.  Use the default href.
-		   ((member type '("id" "fuzzy"))
-		    (format "sec-%s"
-			    (mapconcat 'number-to-string
-				       (org-export-get-headline-number
-					destination info) "-")))
-		   (t (error "Shouldn't reach here"))))
+	  (`headline
+	   (let ((href (or (org-element-property :CUSTOM_ID destination)
+			   (org-export-get-reference destination info)))
 		 ;; What description to use?
 		 (desc
 		  ;; Case 1: Headline is numbered and LINK has no
 		  ;; description.  Display section number.
 		  (if (and (org-export-numbered-headline-p destination info)
 			   (not desc))
-		      (mapconcat 'number-to-string
+		      (mapconcat #'number-to-string
 				 (org-export-get-headline-number
 				  destination info) ".")
 		    ;; Case 2: Either the headline is un-numbered or
 		    ;; LINK has a custom description.  Display LINK's
 		    ;; description or headline's title.
-		    (or desc (org-export-data (org-element-property
-					       :title destination) info)))))
-	     (format "%s"
-		     (org-export-solidify-link-text href) attributes desc)))
+		    (or desc
+			(org-export-data
+			 (org-element-property :title destination) info)))))
+	     (format "%s" href attributes desc)))
 	  ;; Fuzzy link points to a target or an element.
-	  (t
-	   (let* ((path (org-export-solidify-link-text path))
-		  (org-html-standalone-image-predicate 'org-html--has-caption-p)
+	  (_
+	   (let* ((ref (org-export-get-reference destination info))
+		  (org-html-standalone-image-predicate
+		   #'org-html--has-caption-p)
 		  (number (cond
 			   (desc nil)
 			   ((org-html-standalone-image-p destination info)
 			    (org-export-get-ordinal
 			     (org-element-map destination 'link
-			       'identity info t)
+			       #'identity info t)
 			     info 'link 'org-html-standalone-image-p))
 			   (t (org-export-get-ordinal
 			       destination info nil 'org-html--has-caption-p))))
 		  (desc (cond (desc)
 			      ((not number) "No description for this link")
 			      ((numberp number) (number-to-string number))
-			      (t (mapconcat 'number-to-string number ".")))))
-	     (format "%s" path attributes desc))))))
+			      (t (mapconcat #'number-to-string number ".")))))
+	     (format "%s" ref attributes desc))))))
      ;; Coderef: replace link with the reference name or the
      ;; equivalent line number.
      ((string= type "coderef")
-      (let ((fragment (concat "coderef-" path)))
-	(format "%s"
+      (let ((fragment (concat "coderef-" (org-html-encode-plain-text path))))
+	(format "%s"
 		fragment
-		(org-trim
-		 (format (concat "class=\"coderef\""
-				 " onmouseover=\"CodeHighlightOn(this, '%s');\""
-				 " onmouseout=\"CodeHighlightOff(this, '%s');\"")
-			 fragment fragment))
+		(format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \
+'%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
+			fragment fragment)
 		attributes
 		(format (org-export-get-coderef-format path desc)
 			(org-export-resolve-coderef path info)))))
-     ;; Link type is handled by a special function.
-     ((functionp (setq protocol (nth 2 (assoc type org-link-protocols))))
-      (funcall protocol (org-link-unescape path) desc 'html))
      ;; External link with a description part.
-     ((and path desc) (format "%s" path attributes desc))
+     ((and path desc) (format "%s"
+			      (org-html-encode-plain-text path)
+			      attributes
+			      desc))
      ;; External link without a description part.
-     (path (format "%s" path attributes path))
+     (path (let ((path (org-html-encode-plain-text path)))
+	     (format "%s"
+		     path
+		     attributes
+		     (org-link-unescape path))))
      ;; No path, only description.  Try to do something useful.
      (t (format "%s" desc)))))
 
+;;;; Node Property
+
+(defun org-html-node-property (node-property _contents _info)
+  "Transcode a NODE-PROPERTY element from Org to HTML.
+CONTENTS is nil.  INFO is a plist holding contextual
+information."
+  (format "%s:%s"
+          (org-element-property :key node-property)
+          (let ((value (org-element-property :value node-property)))
+            (if value (concat " " value) ""))))
+
 ;;;; Paragraph
 
 (defun org-html-paragraph (paragraph contents info)
@@ -2815,13 +3090,19 @@ CONTENTS is the contents of the paragraph, as a string.  INFO is
 the plist used as a communication channel."
   (let* ((parent (org-export-get-parent paragraph))
 	 (parent-type (org-element-type parent))
-	 (style '((footnote-definition " class=\"footpara\"")))
-	 (extra (or (cadr (assoc parent-type style)) "")))
+	 (style '((footnote-definition " class=\"footpara\"")
+		  (org-data " class=\"footpara\"")))
+	 (attributes (org-html--make-attribute-string
+		      (org-export-read-attribute :attr_html paragraph)))
+	 (extra (or (cadr (assq parent-type style)) "")))
     (cond
-     ((and (eq (org-element-type parent) 'item)
-	   (= (org-element-property :begin paragraph)
-	      (org-element-property :contents-begin parent)))
-      ;; Leading paragraph in a list item have no tags.
+     ((and (eq parent-type 'item)
+	   (not (org-export-get-previous-element paragraph info))
+	   (let ((followers (org-export-get-next-element paragraph info 2)))
+	     (and (not (cdr followers))
+		  (memq (org-element-type (car followers)) '(nil plain-list)))))
+      ;; First paragraph in an item has no tag if it is alone or
+      ;; followed, at most, by a sub-list.
       contents)
      ((org-html-standalone-image-p paragraph info)
       ;; Standalone image.
@@ -2829,20 +3110,24 @@ the plist used as a communication channel."
 	     (let ((raw (org-export-data
 			 (org-export-get-caption paragraph) info))
 		   (org-html-standalone-image-predicate
-		    'org-html--has-caption-p))
+		    #'org-html--has-caption-p))
 	       (if (not (org-string-nw-p raw)) raw
-		 (concat
-                  ""
-		  (format (org-html--translate "Figure %d:" info)
-			  (org-export-get-ordinal
-			   (org-element-map paragraph 'link
-			     'identity info t)
-			   info nil 'org-html-standalone-image-p))
-		  " " raw))))
-	    (label (org-element-property :name paragraph)))
+		 (concat ""
+			 (format (org-html--translate "Figure %d:" info)
+				 (org-export-get-ordinal
+				  (org-element-map paragraph 'link
+				    #'identity info t)
+				  info nil #'org-html-standalone-image-p))
+			 " "
+			 raw))))
+	    (label (and (org-element-property :name paragraph)
+			(org-export-get-reference paragraph info))))
 	(org-html--wrap-image contents info caption label)))
      ;; Regular paragraph.
-     (t (format "\n%s
    " extra contents)))))
+     (t (format "\n%s
    "
+		(if (org-string-nw-p attributes)
+		    (concat " " attributes) "")
+		extra contents)))))
 
 ;;;; Plain List
 
@@ -2852,26 +3137,25 @@ the plist used as a communication channel."
   "Insert the beginning of the HTML list depending on TYPE.
 When ARG1 is a string, use it as the start parameter for ordered
 lists."
-  (case type
-    (ordered
+  (pcase type
+    (`ordered
      (format "
      "
 	     (if arg1 (format " start=\"%d\"" arg1) "")))
-    (unordered "
        ")
-    (descriptive "
        ")))
+    (`unordered "
          ")
+    (`descriptive "
          ")))
 
 (defun org-html-end-plain-list (type)
   "Insert the end of the HTML list depending on TYPE."
-  (case type
-    (ordered "
    ")
-    (unordered "")
-    (descriptive "")))
+  (pcase type
+    (`ordered "")
+    (`unordered "")
+    (`descriptive "")))
 
-(defun org-html-plain-list (plain-list contents info)
+(defun org-html-plain-list (plain-list contents _info)
   "Transcode a PLAIN-LIST element from Org to HTML.
 CONTENTS is the contents of the list.  INFO is a plist holding
 contextual information."
-  (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item
-	 (type (org-element-property :type plain-list)))
+  (let ((type (org-element-property :type plain-list)))
     (format "%s\n%s%s"
 	    (org-html-begin-plain-list type)
 	    contents (org-html-end-plain-list type))))
@@ -2880,22 +3164,16 @@ contextual information."
 
 (defun org-html-convert-special-strings (string)
   "Convert special characters in STRING to HTML."
-  (let ((all org-html-special-string-regexps)
-	e a re rpl start)
-    (while (setq a (pop all))
-      (setq re (car a) rpl (cdr a) start 0)
-      (while (string-match re string start)
-	(setq string (replace-match rpl t nil string))))
-    string))
+  (dolist (a org-html-special-string-regexps string)
+    (let ((re (car a))
+	  (rpl (cdr a)))
+      (setq string (replace-regexp-in-string re rpl string t)))))
 
 (defun org-html-encode-plain-text (text)
   "Convert plain text characters from TEXT to HTML equivalent.
 Possible conversions are set in `org-html-protect-char-alist'."
-  (mapc
-   (lambda (pair)
-     (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t)))
-   org-html-protect-char-alist)
-  text)
+  (dolist (pair org-html-protect-char-alist text)
+    (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))))
 
 (defun org-html-plain-text (text info)
   "Transcode a TEXT string from Org to HTML.
@@ -2923,60 +3201,52 @@ contextual information."
 
 ;; Planning
 
-(defun org-html-planning (planning contents info)
+(defun org-html-planning (planning _contents info)
   "Transcode a PLANNING element from Org to HTML.
 CONTENTS is nil.  INFO is a plist used as a communication
 channel."
-  (let ((span-fmt "%s %s"))
-    (format
-     "
    %s
    "
-     (mapconcat
-      'identity
-      (delq nil
-	    (list
-	     (let ((closed (org-element-property :closed planning)))
-	       (when closed
-		 (format span-fmt org-closed-string
-			 (org-translate-time
-			  (org-element-property :raw-value closed)))))
-	     (let ((deadline (org-element-property :deadline planning)))
-	       (when deadline
-		 (format span-fmt org-deadline-string
-			 (org-translate-time
-			  (org-element-property :raw-value deadline)))))
-	     (let ((scheduled (org-element-property :scheduled planning)))
-	       (when scheduled
-		 (format span-fmt org-scheduled-string
-			 (org-translate-time
-			  (org-element-property :raw-value scheduled)))))))
-      " "))))
+  (format
+   "
    %s
    "
+   (org-trim
+    (mapconcat
+     (lambda (pair)
+       (let ((timestamp (cdr pair)))
+	 (when timestamp
+	   (let ((string (car pair)))
+	     (format "%s \
+%s "
+		     string
+		     (org-html-plain-text (org-timestamp-translate timestamp)
+					  info))))))
+     `((,org-closed-string . ,(org-element-property :closed planning))
+       (,org-deadline-string . ,(org-element-property :deadline planning))
+       (,org-scheduled-string . ,(org-element-property :scheduled planning)))
+     ""))))
 
 ;;;; Property Drawer
 
-(defun org-html-property-drawer (property-drawer contents info)
+(defun org-html-property-drawer (_property-drawer contents _info)
   "Transcode a PROPERTY-DRAWER element from Org to HTML.
-CONTENTS is nil.  INFO is a plist holding contextual
-information."
-  ;; The property drawer isn't exported but we want separating blank
-  ;; lines nonetheless.
-  "")
+CONTENTS holds the contents of the drawer.  INFO is a plist
+holding contextual information."
+  (and (org-string-nw-p contents)
+       (format "
    \n%s
    " contents)))
 
 ;;;; Quote Block
 
-(defun org-html-quote-block (quote-block contents info)
+(defun org-html-quote-block (quote-block contents _info)
   "Transcode a QUOTE-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information."
-  (format "
    \n%s
    " contents))
-
-;;;; Quote Section
-
-(defun org-html-quote-section (quote-section contents info)
-  "Transcode a QUOTE-SECTION element from Org to HTML.
-CONTENTS is nil.  INFO is a plist holding contextual information."
-  (let ((value (org-remove-indentation
-		(org-element-property :value quote-section))))
-    (when value (format "
    \n%s
    " value))))
+  (format "\n%s"
+	  (let* ((name (org-element-property :name quote-block))
+		 (attributes (org-export-read-attribute :attr_html quote-block))
+		 (a (org-html--make-attribute-string
+		     (if (or (not name) (plist-member attributes :id))
+			 attributes
+		       (plist-put attributes :id name)))))
+	    (if (org-string-nw-p a) (concat " " a) ""))
+	  contents))
 
 ;;;; Section
 
@@ -2989,16 +3259,19 @@ holding contextual information."
     (if (not parent) contents
       ;; Get div's class and id references.
       (let* ((class-num (+ (org-export-get-relative-level parent info)
-			   (1- org-html-toplevel-hlevel)))
+			   (1- (plist-get info :html-toplevel-hlevel))))
 	     (section-number
-	      (mapconcat
-	       'number-to-string
-	       (org-export-get-headline-number parent info) "-")))
+	      (and (org-export-numbered-headline-p parent info)
+		   (mapconcat
+		    #'number-to-string
+		    (org-export-get-headline-number parent info) "-"))))
         ;; Build return value.
 	(format "
    \n%s
    "
 		class-num
-		(or (org-element-property :CUSTOM_ID parent) section-number)
-		contents)))))
+		(or (org-element-property :CUSTOM_ID parent)
+		    section-number
+		    (org-export-get-reference parent info))
+		(or contents ""))))))
 
 ;;;; Radio Target
 
@@ -3006,9 +3279,8 @@ holding contextual information."
   "Transcode a RADIO-TARGET object from Org to HTML.
 TEXT is the text of the target.  INFO is a plist holding
 contextual information."
-  (let ((id (org-export-solidify-link-text
-	     (org-element-property :value radio-target))))
-    (org-html--anchor id text)))
+  (let ((ref (org-export-get-reference radio-target info)))
+    (org-html--anchor ref text nil info)))
 
 ;;;; Special Block
 
@@ -3016,52 +3288,61 @@ contextual information."
   "Transcode a SPECIAL-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the block.  INFO is a plist
 holding contextual information."
-  (let* ((block-type (downcase
-		      (org-element-property :type special-block)))
-	 (contents (or contents ""))
-	 (html5-fancy (and (org-html-html5-p info)
-			   (plist-get info :html-html5-fancy)
-			   (member block-type org-html-html5-elements)))
-	 (attributes (org-export-read-attribute :attr_html special-block)))
+  (let* ((block-type (org-element-property :type special-block))
+         (html5-fancy (and (org-html--html5-fancy-p info)
+                           (member block-type org-html-html5-elements)))
+         (attributes (org-export-read-attribute :attr_html special-block)))
     (unless html5-fancy
       (let ((class (plist-get attributes :class)))
-	(setq attributes (plist-put attributes :class
-				    (if class (concat class " " block-type)
-				      block-type)))))
-    (setq attributes (org-html--make-attribute-string attributes))
-    (when (not (equal attributes ""))
-      (setq attributes (concat " " attributes)))
-    (if html5-fancy
-	(format "<%s%s>\n%s" block-type attributes
-		contents block-type)
-      (format "\n%s\n" attributes contents))))
+        (setq attributes (plist-put attributes :class
+                                    (if class (concat class " " block-type)
+                                      block-type)))))
+    (let* ((contents (or contents ""))
+	   (name (org-element-property :name special-block))
+	   (a (org-html--make-attribute-string
+	       (if (or (not name) (plist-member attributes :id))
+		   attributes
+		 (plist-put attributes :id name))))
+	   (str (if (org-string-nw-p a) (concat " " a) "")))
+      (if html5-fancy
+	  (format "<%s%s>\n%s" block-type str contents block-type)
+	(format "\n%s\n" str contents)))))
 
 ;;;; Src Block
 
-(defun org-html-src-block (src-block contents info)
+(defun org-html-src-block (src-block _contents info)
   "Transcode a SRC-BLOCK element from Org to HTML.
 CONTENTS holds the contents of the item.  INFO is a plist holding
 contextual information."
   (if (org-export-read-attribute :attr_html src-block :textarea)
       (org-html--textarea-block src-block)
     (let ((lang (org-element-property :language src-block))
-	  (caption (org-export-get-caption src-block))
 	  (code (org-html-format-code src-block info))
-	  (label (let ((lbl (org-element-property :name src-block)))
-		   (if (not lbl) ""
-		     (format " id=\"%s\""
-			     (org-export-solidify-link-text lbl))))))
+	  (label (let ((lbl (and (org-element-property :name src-block)
+				 (org-export-get-reference src-block info))))
+		   (if lbl (format " id=\"%s\"" lbl) ""))))
       (if (not lang) (format "
    \n%s
    " label code)
-	(format
-	 "
    \n%s%s\n
    "
-	 (if (not caption) ""
-	   (format ""
-		   (org-export-data caption info)))
-	 (format "\n
    %s
    " lang label code))))))
+	(format "
    \n%s%s\n
    "
+		;; Build caption.
+		(let ((caption (org-export-get-caption src-block)))
+		  (if (not caption) ""
+		    (let ((listing-number
+			   (format
+			    "%s "
+			    (format
+			     (org-html--translate "Listing %d:" info)
+			     (org-export-get-ordinal
+			      src-block info nil #'org-html--has-caption-p)))))
+		      (format ""
+			      listing-number
+			      (org-trim (org-export-data caption info))))))
+		;; Contents.
+		(format "
    %s
    "
+			lang label code))))))
 
 ;;;; Statistics Cookie
 
-(defun org-html-statistics-cookie (statistics-cookie contents info)
+(defun org-html-statistics-cookie (statistics-cookie _contents _info)
   "Transcode a STATISTICS-COOKIE object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual information."
   (let ((cookie-value (org-element-property :value statistics-cookie)))
@@ -3069,16 +3350,18 @@ CONTENTS is nil.  INFO is a plist holding contextual information."
 
 ;;;; Strike-Through
 
-(defun org-html-strike-through (strike-through contents info)
+(defun org-html-strike-through (_strike-through contents info)
   "Transcode STRIKE-THROUGH from Org to HTML.
 CONTENTS is the text with strike-through markup.  INFO is a plist
 holding contextual information."
-  (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s")
-	  contents))
+  (format
+   (or (cdr (assq 'strike-through (plist-get info :html-text-markup-alist)))
+       "%s")
+   contents))
 
 ;;;; Subscript
 
-(defun org-html-subscript (subscript contents info)
+(defun org-html-subscript (_subscript contents _info)
   "Transcode a SUBSCRIPT object from Org to HTML.
 CONTENTS is the contents of the object.  INFO is a plist holding
 contextual information."
@@ -3086,7 +3369,7 @@ contextual information."
 
 ;;;; Superscript
 
-(defun org-html-superscript (superscript contents info)
+(defun org-html-superscript (_superscript contents _info)
   "Transcode a SUPERSCRIPT object from Org to HTML.
 CONTENTS is the contents of the object.  INFO is a plist holding
 contextual information."
@@ -3101,24 +3384,30 @@ channel."
   (let* ((table-row (org-export-get-parent table-cell))
 	 (table (org-export-get-parent-table table-cell))
 	 (cell-attrs
-	  (if (not org-html-table-align-individual-fields) ""
+	  (if (not (plist-get info :html-table-align-individual-fields)) ""
 	    (format (if (and (boundp 'org-html-format-table-no-css)
 			     org-html-format-table-no-css)
-			" align=\"%s\"" " class=\"%s\"")
+			" align=\"%s\"" " class=\"org-%s\"")
 		    (org-export-table-cell-alignment table-cell info)))))
     (when (or (not contents) (string= "" (org-trim contents)))
       (setq contents " "))
     (cond
      ((and (org-export-table-has-header-p table info)
 	   (= 1 (org-export-table-row-group table-row info)))
-      (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs)
-	      contents (cdr org-html-table-header-tags)))
-     ((and org-html-table-use-header-tags-for-first-column
+      (let ((header-tags (plist-get info :html-table-header-tags)))
+	(concat "\n" (format (car header-tags) "col" cell-attrs)
+		contents
+		(cdr header-tags))))
+     ((and (plist-get info :html-table-use-header-tags-for-first-column)
 	   (zerop (cdr (org-export-table-cell-address table-cell info))))
-      (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs)
-	      contents (cdr org-html-table-header-tags)))
-     (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs)
-		contents (cdr org-html-table-data-tags))))))
+      (let ((header-tags (plist-get info :html-table-header-tags)))
+	(concat "\n" (format (car header-tags) "row" cell-attrs)
+		contents
+		(cdr header-tags))))
+     (t (let ((data-tags (plist-get info :html-table-data-tags)))
+	  (concat "\n" (format (car data-tags) cell-attrs)
+		  contents
+		  (cdr data-tags)))))))
 
 ;;;; Table Row
 
@@ -3129,40 +3418,45 @@ communication channel."
   ;; Rules are ignored since table separators are deduced from
   ;; borders of the current row.
   (when (eq (org-element-property :type table-row) 'standard)
-    (let* ((rowgroup-number (org-export-table-row-group table-row info))
-	   (row-number (org-export-table-row-number table-row info))
-	   (start-rowgroup-p
+    (let* ((group (org-export-table-row-group table-row info))
+	   (number (org-export-table-row-number table-row info))
+	   (start-group-p
 	    (org-export-table-row-starts-rowgroup-p table-row info))
-	   (end-rowgroup-p
+	   (end-group-p
 	    (org-export-table-row-ends-rowgroup-p table-row info))
-	   ;; `top-row-p' and `end-rowgroup-p' are not used directly
-	   ;; but should be set so that `org-html-table-row-tags' can
-	   ;; use them (see the docstring of this variable.)
-	   (top-row-p (and (equal start-rowgroup-p '(top))
-			   (equal end-rowgroup-p '(below top))))
-	   (bottom-row-p (and (equal start-rowgroup-p '(above))
-			      (equal end-rowgroup-p '(bottom above))))
-	   (rowgroup-tags
+	   (topp (and (equal start-group-p '(top))
+		      (equal end-group-p '(below top))))
+	   (bottomp (and (equal start-group-p '(above))
+			 (equal end-group-p '(bottom above))))
+           (row-open-tag
+            (pcase (plist-get info :html-table-row-open-tag)
+              ((and accessor (pred functionp))
+               (funcall accessor
+			number group start-group-p end-group-p topp bottomp))
+	      (accessor accessor)))
+           (row-close-tag
+            (pcase (plist-get info :html-table-row-close-tag)
+              ((and accessor (pred functionp))
+               (funcall accessor
+			number group start-group-p end-group-p topp bottomp))
+	      (accessor accessor)))
+	   (group-tags
 	    (cond
-	     ;; Case 1: Row belongs to second or subsequent rowgroups.
-	     ((not (= 1 rowgroup-number))
-	      '("" . "\n"))
-	     ;; Case 2: Row is from first rowgroup.  Table has >=1 rowgroups.
+	     ;; Row belongs to second or subsequent groups.
+	     ((not (= 1 group)) '("" . "\n"))
+	     ;; Row is from first group.  Table has >=1 groups.
 	     ((org-export-table-has-header-p
 	       (org-export-get-parent-table table-row) info)
 	      '("" . "\n"))
-	     ;; Case 2: Row is from first and only row group.
+	     ;; Row is from first and only group.
 	     (t '("" . "\n")))))
-      (concat
-       ;; Begin a rowgroup?
-       (when start-rowgroup-p (car rowgroup-tags))
-       ;; Actual table row
-       (concat "\n" (eval (car org-html-table-row-tags))
-	       contents
-	       "\n"
-	       (eval (cdr org-html-table-row-tags)))
-       ;; End a rowgroup?
-       (when end-rowgroup-p (cdr rowgroup-tags))))))
+      (concat (and start-group-p (car group-tags))
+	      (concat "\n"
+		      row-open-tag
+		      contents
+		      "\n"
+		      row-close-tag)
+	      (and end-group-p (cdr group-tags))))))
 
 ;;;; Table
 
@@ -3178,7 +3472,7 @@ INFO is a plist used as a communication channel."
     (if (not special-column-p) (org-element-contents table-row)
       (cdr (org-element-contents table-row)))))
 
-(defun org-html-table--table.el-table (table info)
+(defun org-html-table--table.el-table (table _info)
   "Format table.el tables into HTML.
 INFO is a plist used as a communication channel."
   (when (eq (org-element-property :type table) 'table.el)
@@ -3199,134 +3493,123 @@ INFO is a plist used as a communication channel."
   "Transcode a TABLE element from Org to HTML.
 CONTENTS is the contents of the table.  INFO is a plist holding
 contextual information."
-  (case (org-element-property :type table)
-    ;; Case 1: table.el table.  Convert it using appropriate tools.
-    (table.el (org-html-table--table.el-table table info))
-    ;; Case 2: Standard table.
-    (t
-     (let* ((label (org-element-property :name table))
-	    (caption (org-export-get-caption table))
-	    (number (org-export-get-ordinal
-		     table info nil 'org-html--has-caption-p))
-	    (attributes
-	     (org-html--make-attribute-string
-	      (org-combine-plists
-	       (and label (list :id (org-export-solidify-link-text label)))
-	       (and (not (org-html-html5-p info))
-		    (plist-get info :html-table-attributes))
-	       (org-export-read-attribute :attr_html table))))
-	    (alignspec
-	     (if (and (boundp 'org-html-format-table-no-css)
-		      org-html-format-table-no-css)
-		 "align=\"%s\"" "class=\"%s\""))
-	    (table-column-specs
-	     (function
-	      (lambda (table info)
-		(mapconcat
-		 (lambda (table-cell)
-		   (let ((alignment (org-export-table-cell-alignment
-				     table-cell info)))
-		     (concat
-		      ;; Begin a colgroup?
-		      (when (org-export-table-cell-starts-colgroup-p
-			     table-cell info)
-			"\n")
-		      ;; Add a column.  Also specify it's alignment.
-		      (format "\n%s"
-			      (org-html-close-tag
-			       "col" (concat " " (format alignspec alignment)) info))
-		      ;; End a colgroup?
-		      (when (org-export-table-cell-ends-colgroup-p
-			     table-cell info)
-			"\n"))))
-		 (org-html-table-first-row-data-cells table info) "\n")))))
-       (format "\n%s\n%s\n%s"
-	       (if (equal attributes "") "" (concat " " attributes))
-	       (if (not caption) ""
-		 (format (if org-html-table-caption-above
-			     "%s"
-			   "%s")
-			 (concat
-			  ""
-                          (format (org-html--translate "Table %d:" info) number)
-			  " " (org-export-data caption info))))
-	       (funcall table-column-specs table info)
-	       contents)))))
+  (if (eq (org-element-property :type table) 'table.el)
+      ;; "table.el" table.  Convert it using appropriate tools.
+      (org-html-table--table.el-table table info)
+    ;; Standard table.
+    (let* ((caption (org-export-get-caption table))
+	   (number (org-export-get-ordinal
+		    table info nil #'org-html--has-caption-p))
+	   (attributes
+	    (org-html--make-attribute-string
+	     (org-combine-plists
+	      (and (org-element-property :name table)
+		   (list :id (org-export-get-reference table info)))
+	      (and (not (org-html-html5-p info))
+		   (plist-get info :html-table-attributes))
+	      (org-export-read-attribute :attr_html table))))
+	   (alignspec
+	    (if (bound-and-true-p org-html-format-table-no-css)
+		"align=\"%s\""
+	      "class=\"org-%s\""))
+	   (table-column-specs
+	    (lambda (table info)
+	      (mapconcat
+	       (lambda (table-cell)
+		 (let ((alignment (org-export-table-cell-alignment
+				   table-cell info)))
+		   (concat
+		    ;; Begin a colgroup?
+		    (when (org-export-table-cell-starts-colgroup-p
+			   table-cell info)
+		      "\n")
+		    ;; Add a column.  Also specify its alignment.
+		    (format "\n%s"
+			    (org-html-close-tag
+			     "col" (concat " " (format alignspec alignment)) info))
+		    ;; End a colgroup?
+		    (when (org-export-table-cell-ends-colgroup-p
+			   table-cell info)
+		      "\n"))))
+	       (org-html-table-first-row-data-cells table info) "\n"))))
+      (format "\n%s\n%s\n%s"
+	      (if (equal attributes "") "" (concat " " attributes))
+	      (if (not caption) ""
+		(format (if (plist-get info :html-table-caption-above)
+			    "%s"
+			  "%s")
+			(concat
+			 ""
+			 (format (org-html--translate "Table %d:" info) number)
+			 " " (org-export-data caption info))))
+	      (funcall table-column-specs table info)
+	      contents))))
 
 ;;;; Target
 
-(defun org-html-target (target contents info)
+(defun org-html-target (target _contents info)
   "Transcode a TARGET object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
-  (let ((id (org-export-solidify-link-text
-	     (org-element-property :value target))))
-    (org-html--anchor id)))
+  (let ((ref (org-export-get-reference target info)))
+    (org-html--anchor ref nil nil info)))
 
 ;;;; Timestamp
 
-(defun org-html-timestamp (timestamp contents info)
+(defun org-html-timestamp (timestamp _contents info)
   "Transcode a TIMESTAMP object from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
-  (let ((value (org-html-plain-text
-		(org-timestamp-translate timestamp) info)))
+  (let ((value (org-html-plain-text (org-timestamp-translate timestamp) info)))
     (format "%s"
 	    (replace-regexp-in-string "--" "–" value))))
 
 ;;;; Underline
 
-(defun org-html-underline (underline contents info)
+(defun org-html-underline (_underline contents info)
   "Transcode UNDERLINE from Org to HTML.
 CONTENTS is the text with underline markup.  INFO is a plist
 holding contextual information."
-  (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s")
+  (format (or (cdr (assq 'underline (plist-get info :html-text-markup-alist)))
+	      "%s")
 	  contents))
 
 ;;;; Verbatim
 
-(defun org-html-verbatim (verbatim contents info)
+(defun org-html-verbatim (verbatim _contents info)
   "Transcode VERBATIM from Org to HTML.
 CONTENTS is nil.  INFO is a plist holding contextual
 information."
-  (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s")
+  (format (or (cdr (assq 'verbatim (plist-get info :html-text-markup-alist))) "%s")
 	  (org-html-encode-plain-text (org-element-property :value verbatim))))
 
 ;;;; Verse Block
 
-(defun org-html-verse-block (verse-block contents info)
+(defun org-html-verse-block (_verse-block contents info)
   "Transcode a VERSE-BLOCK element from Org to HTML.
 CONTENTS is verse block contents.  INFO is a plist holding
 contextual information."
-  ;; Replace each newline character with line break.  Also replace
-  ;; each blank line with a line break.
-  (setq contents (replace-regexp-in-string
-		  "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info))
-		  (replace-regexp-in-string
-		   "\\(\\\\\\\\\\)?[ \t]*\n"
-		   (format "%s\n" (org-html-close-tag "br" nil info)) contents)))
-  ;; Replace each white space at beginning of a line with a
-  ;; non-breaking space.
-  (while (string-match "^[ \t]+" contents)
-    (let* ((num-ws (length (match-string 0 contents)))
-	   (ws (let (out) (dotimes (i num-ws out)
-			    (setq out (concat out " "))))))
-      (setq contents (replace-match ws nil t contents))))
-  (format "
    \n%s
    " contents))
+  (format "
    \n%s
    "
+	  ;; Replace leading white spaces with non-breaking spaces.
+	  (replace-regexp-in-string
+	   "^[ \t]+" (lambda (m) (org-html--make-string (length m) " "))
+	   ;; Replace each newline character with line break.  Also
+	   ;; remove any trailing "br" close-tag so as to avoid
+	   ;; duplicates.
+	   (let* ((br (org-html-close-tag "br" nil info))
+		  (re (format "\\(?:%s\\)?[ \t]*\n" (regexp-quote br))))
+	     (replace-regexp-in-string re (concat br "\n") contents)))))
 
 
 ;;; Filter Functions
 
-(defun org-html-final-function (contents backend info)
+(defun org-html-final-function (contents _backend info)
   "Filter to indent the HTML and convert HTML entities."
   (with-temp-buffer
     (insert contents)
     (set-auto-mode t)
-    (if org-html-indent
+    (if (plist-get info :html-indent)
 	(indent-region (point-min) (point-max)))
-    (when org-html-use-unicode-chars
-      (require 'mm-url)
-      (mm-url-decode-entities))
     (buffer-substring-no-properties (point-min) (point-max))))
 
 
@@ -3370,10 +3653,10 @@ is non-nil."
 
 ;;;###autoload
 (defun org-html-convert-region-to-html ()
-  "Assume the current region has org-mode syntax, and convert it to HTML.
+  "Assume the current region has Org syntax, and convert it to HTML.
 This can be used in any buffer.  For example, you can write an
-itemized list in org-mode syntax in an HTML buffer and use this
-command to convert it."
+itemized list in Org syntax in an HTML buffer and use this command
+to convert it."
   (interactive)
   (org-export-replace-region-by 'html))
 
@@ -3407,7 +3690,9 @@ file-local settings.
 
 Return output file's name."
   (interactive)
-  (let* ((extension (concat "." org-html-extension))
+  (let* ((extension (concat "." (or (plist-get ext-plist :html-extension)
+				    org-html-extension
+				    "html")))
 	 (file (org-export-output-file-name extension subtreep))
 	 (org-export-coding-system org-html-coding-system))
     (org-export-to-file 'html file
@@ -3424,7 +3709,8 @@ publishing directory.
 Return output file name."
   (org-publish-org-to 'html filename
 		      (concat "." (or (plist-get plist :html-extension)
-				      org-html-extension "html"))
+				      org-html-extension
+				      "html"))
 		      plist pub-dir))
 
 
diff --git a/lisp/org/ox-icalendar.el b/lisp/org/ox-icalendar.el
index fe6d08a85b..9ccbb27244 100644
--- a/lisp/org/ox-icalendar.el
+++ b/lisp/org/ox-icalendar.el
@@ -1,4 +1,4 @@
-;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine
+;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2004-2017 Free Software Foundation, Inc.
 
@@ -31,7 +31,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 (require 'ox-ascii)
 (declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
 
@@ -46,7 +46,7 @@
 
 (defcustom org-icalendar-combined-agenda-file "~/org.ics"
   "The file name for the iCalendar file covering all agenda files.
-This file is created with the command \\[org-icalendar-combine-agenda-files].
+This file is created with the command `\\[org-icalendar-combine-agenda-files]'.
 The file name should be absolute.  It will be overwritten without warning."
   :group 'org-export-icalendar
   :type 'file)
@@ -77,7 +77,7 @@ for timed events.  If non-zero, alarms are created.
 (defcustom org-icalendar-exclude-tags nil
   "Tags that exclude a tree from export.
 This variable allows specifying different exclude tags from other
-back-ends.  It can also be set with the ICAL_EXCLUDE_TAGS
+back-ends.  It can also be set with the ICALENDAR_EXCLUDE_TAGS
 keyword."
   :group 'org-export-icalendar
   :type '(repeat (string :tag "Tag")))
@@ -85,10 +85,11 @@ keyword."
 (defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
   "Contexts where iCalendar export should use a deadline time stamp.
 
-This is a list with several symbols in it.  Valid symbol are:
+This is a list with possibly several symbols in it.  Valid symbols are:
+
 `event-if-todo'       Deadlines in TODO entries become calendar events.
 `event-if-not-todo'   Deadlines in non-TODO entries become calendar events.
-`todo-due'            Use deadlines in TODO entries as due-dates"
+`todo-due'            Use deadlines in TODO entries as due-dates."
   :group 'org-export-icalendar
   :type '(set :greedy t
 	      (const :tag "Deadlines in non-TODO entries become events"
@@ -101,7 +102,8 @@ This is a list with several symbols in it.  Valid symbol are:
 (defcustom org-icalendar-use-scheduled '(todo-start)
   "Contexts where iCalendar export should use a scheduling time stamp.
 
-This is a list with several symbols in it.  Valid symbol are:
+This is a list with possibly several symbols in it.  Valid symbols are:
+
 `event-if-todo'       Scheduling time stamps in TODO entries become an event.
 `event-if-not-todo'   Scheduling time stamps in non-TODO entries become an event.
 `todo-start'          Scheduling time stamps in TODO entries become start date.
@@ -256,11 +258,18 @@ re-read the iCalendar file.")
   '((:exclude-tags
      "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split)
     (:with-timestamps nil "<" org-icalendar-with-timestamps)
-    (:with-vtodo nil nil org-icalendar-include-todo)
-    ;; The following property will be non-nil when export has been
-    ;; started from org-agenda-mode.  In this case, any entry without
-    ;; a non-nil "ICALENDAR_MARK" property will be ignored.
-    (:icalendar-agenda-view nil nil nil))
+    ;; Other variables.
+    (:icalendar-alarm-time nil nil org-icalendar-alarm-time)
+    (:icalendar-categories nil nil org-icalendar-categories)
+    (:icalendar-date-time-format nil nil org-icalendar-date-time-format)
+    (:icalendar-include-bbdb-anniversaries nil nil org-icalendar-include-bbdb-anniversaries)
+    (:icalendar-include-body nil nil org-icalendar-include-body)
+    (:icalendar-include-sexps nil nil org-icalendar-include-sexps)
+    (:icalendar-include-todo nil nil org-icalendar-include-todo)
+    (:icalendar-store-UID nil nil org-icalendar-store-UID)
+    (:icalendar-timezone nil nil org-icalendar-timezone)
+    (:icalendar-use-deadline nil nil org-icalendar-use-deadline)
+    (:icalendar-use-scheduled nil nil org-icalendar-use-scheduled))
   :filters-alist
   '((:filter-headline . org-icalendar-clear-blank-lines))
   :menu-entry
@@ -275,22 +284,18 @@ re-read the iCalendar file.")
 
 ;;; Internal Functions
 
-(defun org-icalendar-create-uid (file &optional bell h-markers)
+(defun org-icalendar-create-uid (file &optional bell)
   "Set ID property on headlines missing it in FILE.
 When optional argument BELL is non-nil, inform the user with
-a message if the file was modified.  With optional argument
-H-MARKERS non-nil, it is a list of markers for the headlines
-which will be updated."
-  (let ((pt (if h-markers (goto-char (car h-markers)) (point-min)))
-	modified-flag)
+a message if the file was modified."
+  (let (modified-flag)
     (org-map-entries
      (lambda ()
        (let ((entry (org-element-at-point)))
-	 (unless (or (< (point) pt) (org-element-property :ID entry))
+	 (unless (org-element-property :ID entry)
 	   (org-id-get-create)
 	   (setq modified-flag t)
-	   (forward-line))
-	 (when h-markers (setq org-map-continue-from (pop h-markers)))))
+	   (forward-line))))
      nil nil 'comment)
     (when (and bell modified-flag)
       (message "ID properties created in file \"%s\"" file)
@@ -318,19 +323,17 @@ A headline is blocked when either
    ;; Check :ORDERED: node property.
    (catch 'blockedp
      (let ((current headline))
-       (mapc (lambda (parent)
-	       (cond
-		((not (org-element-property :todo-keyword parent))
-		 (throw 'blockedp nil))
-		((org-not-nil (org-element-property :ORDERED parent))
-		 (let ((sibling current))
-		   (while (setq sibling (org-export-get-previous-element
-					 sibling info))
-		     (when (eq (org-element-property :todo-type sibling) 'todo)
-		       (throw 'blockedp t)))))
-		(t (setq current parent))))
-	     (org-export-get-genealogy headline))
-       nil))))
+       (dolist (parent (org-element-lineage headline))
+	 (cond
+	  ((not (org-element-property :todo-keyword parent))
+	   (throw 'blockedp nil))
+	  ((org-not-nil (org-element-property :ORDERED parent))
+	   (let ((sibling current))
+	     (while (setq sibling (org-export-get-previous-element
+				   sibling info))
+	       (when (eq (org-element-property :todo-type sibling) 'todo)
+		 (throw 'blockedp t)))))
+	  (t (setq current parent))))))))
 
 (defun org-icalendar-use-UTC-date-time-p ()
   "Non-nil when `org-icalendar-date-time-format' requires UTC time."
@@ -393,8 +396,8 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
       ;; Convert timestamp into internal time in order to use
       ;; `format-time-string' and fix any mistake (i.e. MI >= 60).
       (encode-time 0 mi h d m y)
-      (not (not (or utc (and with-time-p
-                             (org-icalendar-use-UTC-date-time-p)))))))))
+      (and (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p)))
+	   t)))))
 
 (defun org-icalendar-dtstamp ()
   "Return DTSTAMP property, as a string."
@@ -405,27 +408,25 @@ Universal Time, ignoring `org-icalendar-date-time-format'."
 ENTRY is a headline or an inlinetask element.  INFO is a plist
 used as a communication channel."
   (mapconcat
-   'identity
+   #'identity
    (org-uniquify
     (let (categories)
-      (mapc (lambda (type)
-	      (case type
-		(category
-		 (push (org-export-get-category entry info) categories))
-		(todo-state
-		 (let ((todo (org-element-property :todo-keyword entry)))
-		   (and todo (push todo categories))))
-		(local-tags
-		 (setq categories
-		       (append (nreverse (org-export-get-tags entry info))
-			       categories)))
-		(all-tags
-		 (setq categories
-		       (append (nreverse (org-export-get-tags entry info nil t))
-			       categories)))))
-	    org-icalendar-categories)
-      ;; Return list of categories, following specified order.
-      (nreverse categories))) ","))
+      (dolist (type org-icalendar-categories (nreverse categories))
+	(cl-case type
+	  (category
+	   (push (org-export-get-category entry info) categories))
+	  (todo-state
+	   (let ((todo (org-element-property :todo-keyword entry)))
+	     (and todo (push todo categories))))
+	  (local-tags
+	   (setq categories
+		 (append (nreverse (org-export-get-tags entry info))
+			 categories)))
+	  (all-tags
+	   (setq categories
+		 (append (nreverse (org-export-get-tags entry info nil t))
+			 categories)))))))
+   ","))
 
 (defun org-icalendar-transcode-diary-sexp (sexp uid summary)
   "Transcode a diary sexp into iCalendar format.
@@ -457,7 +458,7 @@ or subject for the event."
    (mapconcat
     (lambda (line)
       ;; Limit each line to a maximum of 75 characters.  If it is
-      ;; longer, fold it by using "\n " as a continuation marker.
+      ;; longer, fold it by using "\r\n " as a continuation marker.
       (let ((len (length line)))
 	(if (<= len 75) line
 	  (let ((folded-line (substring line 0 75))
@@ -467,17 +468,17 @@ or subject for the event."
 	    ;; line, real contents must be split at 74 chars.
 	    (while (< (setq chunk-end (+ chunk-start 74)) len)
 	      (setq folded-line
-		    (concat folded-line "\n "
+		    (concat folded-line "\r\n "
 			    (substring line chunk-start chunk-end))
 		    chunk-start chunk-end))
-	    (concat folded-line "\n " (substring line chunk-start))))))
-    (org-split-string s "\n") "\n")))
+	    (concat folded-line "\r\n " (substring line chunk-start))))))
+    (org-split-string s "\n") "\r\n")))
 
 
 
 ;;; Filters
 
-(defun org-icalendar-clear-blank-lines (headline back-end info)
+(defun org-icalendar-clear-blank-lines (headline _back-end _info)
   "Remove blank lines in HEADLINE export.
 HEADLINE is a string representing a transcoded headline.
 BACK-END and INFO are ignored."
@@ -522,99 +523,97 @@ inlinetask within the section."
 		     (cons 'org-data
 			   (cons nil (org-element-contents first))))))))
       (concat
-       (unless (and (plist-get info :icalendar-agenda-view)
-		    (not (org-element-property :ICALENDAR-MARK entry)))
-	 (let ((todo-type (org-element-property :todo-type entry))
-	       (uid (or (org-element-property :ID entry) (org-id-new)))
-	       (summary (org-icalendar-cleanup-string
-			 (or (org-element-property :SUMMARY entry)
-			     (org-export-data
-			      (org-element-property :title entry) info))))
-	       (loc (org-icalendar-cleanup-string
-		     (org-element-property :LOCATION entry)))
-	       ;; Build description of the entry from associated
-	       ;; section (headline) or contents (inlinetask).
-	       (desc
-		(org-icalendar-cleanup-string
-		 (or (org-element-property :DESCRIPTION entry)
-		     (let ((contents (org-export-data inside info)))
-		       (cond
-			((not (org-string-nw-p contents)) nil)
-			((wholenump org-icalendar-include-body)
-			 (let ((contents (org-trim contents)))
-			   (substring
-			    contents 0 (min (length contents)
-					    org-icalendar-include-body))))
-			(org-icalendar-include-body (org-trim contents)))))))
-	       (cat (org-icalendar-get-categories entry info)))
-	   (concat
-	    ;; Events: Delegate to `org-icalendar--vevent' to
-	    ;; generate "VEVENT" component from scheduled, deadline,
-	    ;; or any timestamp in the entry.
-	    (let ((deadline (org-element-property :deadline entry)))
-	      (and deadline
-		   (memq (if todo-type 'event-if-todo 'event-if-not-todo)
-			 org-icalendar-use-deadline)
-		   (org-icalendar--vevent
-		    entry deadline (concat "DL-" uid)
-		    (concat "DL: " summary) loc desc cat)))
-	    (let ((scheduled (org-element-property :scheduled entry)))
-	      (and scheduled
-		   (memq (if todo-type 'event-if-todo 'event-if-not-todo)
-			 org-icalendar-use-scheduled)
-		   (org-icalendar--vevent
-		    entry scheduled (concat "SC-" uid)
-		    (concat "S: " summary) loc desc cat)))
-	    ;; When collecting plain timestamps from a headline and
-	    ;; its title, skip inlinetasks since collection will
-	    ;; happen once ENTRY is one of them.
+       (let ((todo-type (org-element-property :todo-type entry))
+	     (uid (or (org-element-property :ID entry) (org-id-new)))
+	     (summary (org-icalendar-cleanup-string
+		       (or (org-element-property :SUMMARY entry)
+			   (org-export-data
+			    (org-element-property :title entry) info))))
+	     (loc (org-icalendar-cleanup-string
+		   (org-element-property :LOCATION entry)))
+	     ;; Build description of the entry from associated section
+	     ;; (headline) or contents (inlinetask).
+	     (desc
+	      (org-icalendar-cleanup-string
+	       (or (org-element-property :DESCRIPTION entry)
+		   (let ((contents (org-export-data inside info)))
+		     (cond
+		      ((not (org-string-nw-p contents)) nil)
+		      ((wholenump org-icalendar-include-body)
+		       (let ((contents (org-trim contents)))
+			 (substring
+			  contents 0 (min (length contents)
+					  org-icalendar-include-body))))
+		      (org-icalendar-include-body (org-trim contents)))))))
+	     (cat (org-icalendar-get-categories entry info)))
+	 (concat
+	  ;; Events: Delegate to `org-icalendar--vevent' to generate
+	  ;; "VEVENT" component from scheduled, deadline, or any
+	  ;; timestamp in the entry.
+	  (let ((deadline (org-element-property :deadline entry)))
+	    (and deadline
+		 (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+		       org-icalendar-use-deadline)
+		 (org-icalendar--vevent
+		  entry deadline (concat "DL-" uid)
+		  (concat "DL: " summary) loc desc cat)))
+	  (let ((scheduled (org-element-property :scheduled entry)))
+	    (and scheduled
+		 (memq (if todo-type 'event-if-todo 'event-if-not-todo)
+		       org-icalendar-use-scheduled)
+		 (org-icalendar--vevent
+		  entry scheduled (concat "SC-" uid)
+		  (concat "S: " summary) loc desc cat)))
+	  ;; When collecting plain timestamps from a headline and its
+	  ;; title, skip inlinetasks since collection will happen once
+	  ;; ENTRY is one of them.
+	  (let ((counter 0))
+	    (mapconcat
+	     #'identity
+	     (org-element-map (cons (org-element-property :title entry)
+				    (org-element-contents inside))
+		 'timestamp
+	       (lambda (ts)
+		 (when (let ((type (org-element-property :type ts)))
+			 (cl-case (plist-get info :with-timestamps)
+			   (active (memq type '(active active-range)))
+			   (inactive (memq type '(inactive inactive-range)))
+			   ((t) t)))
+		   (let ((uid (format "TS%d-%s" (cl-incf counter) uid)))
+		     (org-icalendar--vevent
+		      entry ts uid summary loc desc cat))))
+	       info nil (and (eq type 'headline) 'inlinetask))
+	     ""))
+	  ;; Task: First check if it is appropriate to export it.  If
+	  ;; so, call `org-icalendar--vtodo' to transcode it into
+	  ;; a "VTODO" component.
+	  (when (and todo-type
+		     (cl-case (plist-get info :icalendar-include-todo)
+		       (all t)
+		       (unblocked
+			(and (eq type 'headline)
+			     (not (org-icalendar-blocked-headline-p
+				   entry info))))
+		       ((t) (eq todo-type 'todo))))
+	    (org-icalendar--vtodo entry uid summary loc desc cat))
+	  ;; Diary-sexp: Collect every diary-sexp element within ENTRY
+	  ;; and its title, and transcode them.  If ENTRY is
+	  ;; a headline, skip inlinetasks: they will be handled
+	  ;; separately.
+	  (when org-icalendar-include-sexps
 	    (let ((counter 0))
-	      (mapconcat
-	       #'identity
-	       (org-element-map (cons (org-element-property :title entry)
-				      (org-element-contents inside))
-		   'timestamp
-		 (lambda (ts)
-		   (when (let ((type (org-element-property :type ts)))
-			   (case (plist-get info :with-timestamps)
-			     (active (memq type '(active active-range)))
-			     (inactive (memq type '(inactive inactive-range)))
-			     ((t) t)))
-		     (let ((uid (format "TS%d-%s" (incf counter) uid)))
-		       (org-icalendar--vevent
-			entry ts uid summary loc desc cat))))
-		 info nil (and (eq type 'headline) 'inlinetask))
-	       ""))
-	    ;; Task: First check if it is appropriate to export it.
-	    ;; If so, call `org-icalendar--vtodo' to transcode it
-	    ;; into a "VTODO" component.
-	    (when (and todo-type
-		       (case (plist-get info :with-vtodo)
-			 (all t)
-			 (unblocked
-			  (and (eq type 'headline)
-			       (not (org-icalendar-blocked-headline-p
-				     entry info))))
-			 ((t) (eq todo-type 'todo))))
-	      (org-icalendar--vtodo entry uid summary loc desc cat))
-	    ;; Diary-sexp: Collect every diary-sexp element within
-	    ;; ENTRY and its title, and transcode them.  If ENTRY is
-	    ;; a headline, skip inlinetasks: they will be handled
-	    ;; separately.
-	    (when org-icalendar-include-sexps
-	      (let ((counter 0))
-		(mapconcat #'identity
-			   (org-element-map
-			       (cons (org-element-property :title entry)
-				     (org-element-contents inside))
-			       'diary-sexp
-			     (lambda (sexp)
-			       (org-icalendar-transcode-diary-sexp
-				(org-element-property :value sexp)
-				(format "DS%d-%s" (incf counter) uid)
-				summary))
-			     info nil (and (eq type 'headline) 'inlinetask))
-			   ""))))))
+	      (mapconcat #'identity
+			 (org-element-map
+			     (cons (org-element-property :title entry)
+				   (org-element-contents inside))
+			     'diary-sexp
+			   (lambda (sexp)
+			     (org-icalendar-transcode-diary-sexp
+			      (org-element-property :value sexp)
+			      (format "DS%d-%s" (cl-incf counter) uid)
+			      summary))
+			   info nil (and (eq type 'headline) 'inlinetask))
+			 "")))))
        ;; If ENTRY is a headline, call current function on every
        ;; inlinetask within it.  In agenda export, this is independent
        ;; from the mark (or lack thereof) on the entry.
@@ -627,7 +626,7 @@ inlinetask within the section."
        contents))))
 
 (defun org-icalendar--vevent
-  (entry timestamp uid summary location description categories)
+    (entry timestamp uid summary location description categories)
   "Create a VEVENT component.
 
 ENTRY is either a headline or an inlinetask element.  TIMESTAMP
@@ -651,7 +650,7 @@ Return VEVENT component as a string."
 	     ;; RRULE.
 	     (when (org-element-property :repeater-type timestamp)
 	       (format "RRULE:FREQ=%s;INTERVAL=%d\n"
-		       (case (org-element-property :repeater-unit timestamp)
+		       (cl-case (org-element-property :repeater-unit timestamp)
 			 (hour "HOURLY") (day "DAILY") (week "WEEKLY")
 			 (month "MONTHLY") (year "YEARLY"))
 		       (org-element-property :repeater-value timestamp)))
@@ -821,7 +820,8 @@ Return ICS file name."
   ;; links will not be collected at the end of sections.
   (let ((outfile (org-export-output-file-name ".ics" subtreep)))
     (org-export-to-file 'icalendar outfile
-      async subtreep visible-only body-only '(:ascii-charset utf-8)
+      async subtreep visible-only body-only
+      '(:ascii-charset utf-8 :ascii-links-to-notes nil)
       (lambda (file)
 	(run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
 
@@ -835,27 +835,23 @@ external process."
       ;; Asynchronous export is not interactive, so we will not call
       ;; `org-check-agenda-file'.  Instead we remove any non-existent
       ;; agenda file from the list.
-      (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+      (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
 	(org-export-async-start
 	    (lambda (results)
-	      (mapc (lambda (f) (org-export-add-to-stack f 'icalendar))
-		    results))
+	      (dolist (f results) (org-export-add-to-stack f 'icalendar)))
 	  `(let (output-files)
-	     (mapc (lambda (file)
-		     (with-current-buffer (org-get-agenda-file-buffer file)
-		       (push (expand-file-name (org-icalendar-export-to-ics))
-			     output-files)))
-		   ',files)
-	     output-files)))
+	     (dolist (file ',files outputfiles)
+	       (with-current-buffer (org-get-agenda-file-buffer file)
+		 (push (expand-file-name (org-icalendar-export-to-ics))
+		       output-files))))))
     (let ((files (org-agenda-files t)))
       (org-agenda-prepare-buffers files)
       (unwind-protect
-	  (mapc (lambda (file)
-		  (catch 'nextfile
-		    (org-check-agenda-file file)
-		    (with-current-buffer (org-get-agenda-file-buffer file)
-		      (org-icalendar-export-to-ics))))
-		files)
+	  (dolist (file files)
+	    (catch 'nextfile
+	      (org-check-agenda-file file)
+	      (with-current-buffer (org-get-agenda-file-buffer file)
+		(org-icalendar-export-to-ics))))
 	(org-release-buffers org-agenda-new-buffers)))))
 
 ;;;###autoload
@@ -870,56 +866,52 @@ The file is stored under the name chosen in
 `org-icalendar-combined-agenda-file'."
   (interactive)
   (if async
-      (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t))))
+      (let ((files (cl-remove-if-not #'file-exists-p (org-agenda-files t))))
 	(org-export-async-start
-	    (lambda (dummy)
+	    (lambda (_)
 	      (org-export-add-to-stack
 	       (expand-file-name org-icalendar-combined-agenda-file)
 	       'icalendar))
-	  `(apply 'org-icalendar--combine-files nil ',files)))
-    (apply 'org-icalendar--combine-files nil (org-agenda-files t))))
+	  `(apply #'org-icalendar--combine-files ',files)))
+    (apply #'org-icalendar--combine-files (org-agenda-files t))))
 
 (defun org-icalendar-export-current-agenda (file)
   "Export current agenda view to an iCalendar FILE.
 This function assumes major mode for current buffer is
 `org-agenda-mode'."
-  (let (org-export-babel-evaluate ; Don't evaluate Babel block
-	(org-icalendar-combined-agenda-file file)
-	(marker-list
-	 ;; Collect the markers pointing to entries in the current
-	 ;; agenda buffer.
-	 (let (markers)
-	   (save-excursion
-	     (goto-char (point-min))
-	     (while (not (eobp))
-	       (let ((m (or (org-get-at-bol 'org-hd-marker)
-			    (org-get-at-bol 'org-marker))))
-		 (and m (push m markers)))
-	       (beginning-of-line 2)))
-	   (nreverse markers))))
-    (apply 'org-icalendar--combine-files
-	   ;; Build restriction alist.
-	   (let (restriction)
-	     ;; Sort markers in each association within RESTRICTION.
-	     (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x)
-		     (dolist (m marker-list restriction)
-		       (let* ((pos (marker-position m))
-			      (file (buffer-file-name
-				     (org-base-buffer (marker-buffer m))))
-			      (file-markers (assoc file restriction)))
-			 ;; Add POS in FILE association if one exists
-			 ;; or create a new association for FILE.
-			 (if file-markers (push pos (cdr file-markers))
-			   (push (list file pos) restriction))))))
-	   (org-agenda-files nil 'ifmode))))
-
-(defun org-icalendar--combine-files (restriction &rest files)
+  (let* ((org-export-babel-evaluate)	; Don't evaluate Babel block.
+	 (contents
+	  (org-export-string-as
+	   (with-output-to-string
+	     (save-excursion
+	       (let ((p (point-min)))
+		 (while (setq p (next-single-property-change p 'org-hd-marker))
+		   (let ((m (get-text-property p 'org-hd-marker)))
+		     (when m
+		       (with-current-buffer (marker-buffer m)
+			 (org-with-wide-buffer
+			  (goto-char (marker-position m))
+			  (princ
+			   (org-element-normalize-string
+			    (buffer-substring
+			     (point) (progn (outline-next-heading) (point)))))))))
+		   (forward-line)))))
+	   'icalendar t
+	   '(:ascii-charset utf-8 :ascii-links-to-notes nil
+			    :icalendar-include-todo all))))
+    (with-temp-file file
+      (insert
+       (org-icalendar--vcalendar
+	org-icalendar-combined-name
+	user-full-name
+	(or (org-string-nw-p org-icalendar-timezone) (cadr (current-time-zone)))
+	org-icalendar-combined-description
+	contents)))
+    (run-hook-with-args 'org-icalendar-after-save-hook file)))
+
+(defun org-icalendar--combine-files (&rest files)
   "Combine entries from multiple files into an iCalendar file.
-RESTRICTION, when non-nil, is an alist where key is a file name
-and value a list of buffer positions pointing to entries that
-should appear in the calendar.  It only makes sense if the
-function was called from an agenda buffer.  FILES is a list of
-files to build the calendar from."
+FILES is a list of files to build the calendar from."
   (org-agenda-prepare-buffers files)
   (unwind-protect
       (progn
@@ -943,29 +935,12 @@ files to build the calendar from."
 		(catch 'nextfile
 		  (org-check-agenda-file file)
 		  (with-current-buffer (org-get-agenda-file-buffer file)
-		    (let ((marks (cdr (assoc (expand-file-name file)
-					     restriction))))
-		      ;; Create ID if necessary.
-		      (when org-icalendar-store-UID
-			(org-icalendar-create-uid file t marks))
-		      (unless (and restriction (not marks))
-			;; Add a hook adding :ICALENDAR_MARK: property
-			;; to each entry appearing in agenda view.
-			;; Use `apply-partially' because the function
-			;; still has to accept one argument.
-			(let ((org-export-before-processing-hook
-			       (cons (apply-partially
-				      (lambda (m-list dummy)
-					(mapc (lambda (m)
-						(org-entry-put
-						 m "ICALENDAR-MARK" "t"))
-					      m-list))
-				      (sort marks '>))
-				     org-export-before-processing-hook)))
-			  (org-export-as
-			   'icalendar nil nil t
-			   (list :ascii-charset 'utf-8
-				 :icalendar-agenda-view restriction))))))))
+		    ;; Create ID if necessary.
+		    (when org-icalendar-store-UID
+		      (org-icalendar-create-uid file t))
+		    (org-export-as
+		     'icalendar nil nil t
+		     '(:ascii-charset utf-8 :ascii-links-to-notes nil)))))
 	      files "")
 	     ;; BBDB anniversaries.
 	     (when (and org-icalendar-include-bbdb-anniversaries
diff --git a/lisp/org/ox-latex.el b/lisp/org/ox-latex.el
index 3eee86a3ae..f11a8a63a2 100644
--- a/lisp/org/ox-latex.el
+++ b/lisp/org/ox-latex.el
@@ -1,4 +1,4 @@
-;;; ox-latex.el --- LaTeX Back-End for Org Export Engine
+;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
 
@@ -26,7 +26,7 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
 (require 'ox)
 (require 'ox-publish)
 
@@ -43,8 +43,6 @@
     (center-block . org-latex-center-block)
     (clock . org-latex-clock)
     (code . org-latex-code)
-    (comment . (lambda (&rest args) ""))
-    (comment-block . (lambda (&rest args) ""))
     (drawer . org-latex-drawer)
     (dynamic-block . org-latex-dynamic-block)
     (entity . org-latex-entity)
@@ -65,13 +63,13 @@
     (latex-fragment . org-latex-latex-fragment)
     (line-break . org-latex-line-break)
     (link . org-latex-link)
+    (node-property . org-latex-node-property)
     (paragraph . org-latex-paragraph)
     (plain-list . org-latex-plain-list)
     (plain-text . org-latex-plain-text)
     (planning . org-latex-planning)
-    (property-drawer . (lambda (&rest args) ""))
+    (property-drawer . org-latex-property-drawer)
     (quote-block . org-latex-quote-block)
-    (quote-section . org-latex-quote-section)
     (radio-target . org-latex-radio-target)
     (section . org-latex-section)
     (special-block . org-latex-special-block)
@@ -88,8 +86,10 @@
     (timestamp . org-latex-timestamp)
     (underline . org-latex-underline)
     (verbatim . org-latex-verbatim)
-    (verse-block . org-latex-verse-block))
-  :export-block '("LATEX" "TEX")
+    (verse-block . org-latex-verse-block)
+    ;; Pseudo objects and elements.
+    (latex-math-block . org-latex-math-block)
+    (latex-matrices . org-latex-matrices))
   :menu-entry
   '(?l "Export to LaTeX"
        ((?L "As LaTeX buffer" org-latex-export-as-latex)
@@ -99,13 +99,57 @@
 	    (lambda (a s v b)
 	      (if a (org-latex-export-to-pdf t s v b)
 		(org-open-file (org-latex-export-to-pdf nil s v b)))))))
-  :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
-		   (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
-		   (:latex-header "LATEX_HEADER" nil nil newline)
-		   (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
-		   (:latex-hyperref-p nil "texht" org-latex-with-hyperref t)
-		   ;; Redefine regular options.
-		   (:date "DATE" nil "\\today" t)))
+  :filters-alist '((:filter-options . org-latex-math-block-options-filter)
+		   (:filter-paragraph . org-latex-clean-invalid-line-breaks)
+		   (:filter-parse-tree org-latex-math-block-tree-filter
+				       org-latex-matrices-tree-filter)
+		   (:filter-verse-block . org-latex-clean-invalid-line-breaks))
+  :options-alist
+  '((:latex-class "LATEX_CLASS" nil org-latex-default-class t)
+    (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t)
+    (:latex-header "LATEX_HEADER" nil nil newline)
+    (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline)
+    (:description "DESCRIPTION" nil nil parse)
+    (:keywords "KEYWORDS" nil nil parse)
+    (:subtitle "SUBTITLE" nil nil parse)
+    ;; Other variables.
+    (:latex-active-timestamp-format nil nil org-latex-active-timestamp-format)
+    (:latex-caption-above nil nil org-latex-caption-above)
+    (:latex-classes nil nil org-latex-classes)
+    (:latex-default-figure-position nil nil org-latex-default-figure-position)
+    (:latex-default-table-environment nil nil org-latex-default-table-environment)
+    (:latex-default-table-mode nil nil org-latex-default-table-mode)
+    (:latex-diary-timestamp-format nil nil org-latex-diary-timestamp-format)
+    (:latex-footnote-defined-format nil nil org-latex-footnote-defined-format)
+    (:latex-footnote-separator nil nil org-latex-footnote-separator)
+    (:latex-format-drawer-function nil nil org-latex-format-drawer-function)
+    (:latex-format-headline-function nil nil org-latex-format-headline-function)
+    (:latex-format-inlinetask-function nil nil org-latex-format-inlinetask-function)
+    (:latex-hyperref-template nil nil org-latex-hyperref-template t)
+    (:latex-image-default-height nil nil org-latex-image-default-height)
+    (:latex-image-default-option nil nil org-latex-image-default-option)
+    (:latex-image-default-width nil nil org-latex-image-default-width)
+    (:latex-images-centered nil nil org-latex-images-centered)
+    (:latex-inactive-timestamp-format nil nil org-latex-inactive-timestamp-format)
+    (:latex-inline-image-rules nil nil org-latex-inline-image-rules)
+    (:latex-link-with-unknown-path-format nil nil org-latex-link-with-unknown-path-format)
+    (:latex-listings nil nil org-latex-listings)
+    (:latex-listings-langs nil nil org-latex-listings-langs)
+    (:latex-listings-options nil nil org-latex-listings-options)
+    (:latex-minted-langs nil nil org-latex-minted-langs)
+    (:latex-minted-options nil nil org-latex-minted-options)
+    (:latex-prefer-user-labels nil nil org-latex-prefer-user-labels)
+    (:latex-subtitle-format nil nil org-latex-subtitle-format)
+    (:latex-subtitle-separate nil nil org-latex-subtitle-separate)
+    (:latex-table-scientific-notation nil nil org-latex-table-scientific-notation)
+    (:latex-tables-booktabs nil nil org-latex-tables-booktabs)
+    (:latex-tables-centered nil nil org-latex-tables-centered)
+    (:latex-text-markup-alist nil nil org-latex-text-markup-alist)
+    (:latex-title-command nil nil org-latex-title-command)
+    (:latex-toc-command nil nil org-latex-toc-command)
+    (:latex-compiler "LATEX_COMPILER" nil org-latex-compiler)
+    ;; Redefine regular options.
+    (:date "DATE" nil "\\today" parse)))
 
 
 
@@ -164,11 +208,112 @@
     ("uk" . "ukrainian"))
   "Alist between language code and corresponding Babel option.")
 
+(defconst org-latex-polyglossia-language-alist
+  '(("am" "amharic")
+    ("ast" "asturian")
+    ("ar" "arabic")
+    ("bo" "tibetan")
+    ("bn" "bengali")
+    ("bg" "bulgarian")
+    ("br" "breton")
+    ("bt-br" "brazilian")
+    ("ca" "catalan")
+    ("cop" "coptic")
+    ("cs" "czech")
+    ("cy" "welsh")
+    ("da" "danish")
+    ("de" "german" "german")
+    ("de-at" "german" "austrian")
+    ("de-de" "german" "german")
+    ("dv" "divehi")
+    ("el" "greek")
+    ("en" "english" "usmax")
+    ("en-au" "english" "australian")
+    ("en-gb" "english" "uk")
+    ("en-nz" "english" "newzealand")
+    ("en-us" "english" "usmax")
+    ("eo" "esperanto")
+    ("es" "spanish")
+    ("et" "estonian")
+    ("eu" "basque")
+    ("fa" "farsi")
+    ("fi" "finnish")
+    ("fr" "french")
+    ("fu" "friulan")
+    ("ga" "irish")
+    ("gd" "scottish")
+    ("gl" "galician")
+    ("he" "hebrew")
+    ("hi" "hindi")
+    ("hr" "croatian")
+    ("hu" "magyar")
+    ("hy" "armenian")
+    ("id" "bahasai")
+    ("ia" "interlingua")
+    ("is" "icelandic")
+    ("it" "italian")
+    ("kn" "kannada")
+    ("la" "latin" "modern")
+    ("la-modern" "latin" "modern")
+    ("la-classic" "latin" "classic")
+    ("la-medieval" "latin" "medieval")
+    ("lo" "lao")
+    ("lt" "lithuanian")
+    ("lv" "latvian")
+    ("mr" "maranthi")
+    ("ml" "malayalam")
+    ("nl" "dutch")
+    ("nb" "norsk")
+    ("nn" "nynorsk")
+    ("nko" "nko")
+    ("no" "norsk")
+    ("oc" "occitan")
+    ("pl" "polish")
+    ("pms" "piedmontese")
+    ("pt" "portuges")
+    ("rm" "romansh")
+    ("ro" "romanian")
+    ("ru" "russian")
+    ("sa" "sanskrit")
+    ("hsb" "usorbian")
+    ("dsb" "lsorbian")
+    ("sk" "slovak")
+    ("sl" "slovenian")
+    ("se" "samin")
+    ("sq" "albanian")
+    ("sr" "serbian")
+    ("sv" "swedish")
+    ("syr" "syriac")
+    ("ta" "tamil")
+    ("te" "telugu")
+    ("th" "thai")
+    ("tk" "turkmen")
+    ("tr" "turkish")
+    ("uk" "ukrainian")
+    ("ur" "urdu")
+    ("vi" "vietnamese"))
+  "Alist between language code and corresponding Polyglossia option")
+
+
+
 (defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr")
-					    ("qbordermatrix" . "\\cr")
-					    ("kbordermatrix" . "\\\\"))
+					  ("qbordermatrix" . "\\cr")
+					  ("kbordermatrix" . "\\\\"))
   "Alist between matrix macros and their row ending.")
 
+(defconst org-latex-math-environments-re
+  (format
+   "\\`[ \t]*\\\\begin{%s\\*?}"
+   (regexp-opt
+	   '("equation" "eqnarray" "math" "displaymath"
+	     "align"  "gather" "multline" "flalign"  "alignat"
+	     "xalignat" "xxalignat"
+	     "subequations"
+	     ;; breqn
+	     "dmath" "dseries" "dgroup" "darray"
+	     ;; empheq
+	     "empheq")))
+  "Regexp of LaTeX math environments.")
 
 
 ;;; User Configurable Variables
@@ -178,6 +323,79 @@
   :tag "Org Export LaTeX"
   :group 'org-export)
 
+;;;; Generic
+
+(defcustom org-latex-caption-above '(table)
+  "When non-nil, place caption string at the beginning of elements.
+Otherwise, place it near the end.  When value is a list of
+symbols, put caption above selected elements only.  Allowed
+symbols are: `image', `table', `src-block' and `special-block'."
+  :group 'org-export-latex
+  :version "26.1"
+  :package-version '(Org . "8.3")
+  :type '(choice
+	  (const :tag "For all elements" t)
+	  (const :tag "For no element" nil)
+	  (set :tag "For the following elements only" :greedy t
+	       (const :tag "Images" image)
+	       (const :tag "Tables" table)
+	       (const :tag "Source code" src-block)
+	       (const :tag "Special blocks" special-block))))
+
+(defcustom org-latex-prefer-user-labels nil
+   "Use user-provided labels instead of internal ones when non-nil.
+
+When this variable is non-nil, Org will use the value of
+CUSTOM_ID property, NAME keyword or Org target as the key for the
+\\label commands generated.
+
+By default, Org generates its own internal labels during LaTeX
+export.  This process ensures that the \\label keys are unique
+and valid, but it means the keys are not available in advance of
+the export process.
+
+Setting this variable gives you control over how Org generates
+labels during LaTeX export, so that you may know their keys in
+advance.  One reason to do this is that it allows you to refer to
+various elements using a single label both in Org's link syntax
+and in embedded LaTeX code.
+
+For example, when this variable is non-nil, a headline like this:
+
+  ** Some section
+     :PROPERTIES:
+     :CUSTOM_ID: sec:foo
+     :END:
+  This is section [[#sec:foo]].
+  #+BEGIN_EXPORT latex
+  And this is still section \\ref{sec:foo}.
+  #+END_EXPORT
+
+will be exported to LaTeX as:
+
+  \\subsection{Some section}
+  \\label{sec:foo}
+  This is section \\ref{sec:foo}.
+  And this is still section \\ref{sec:foo}.
+
+Note, however, that setting this variable introduces a limitation
+on the possible values for CUSTOM_ID and NAME.  When this
+variable is non-nil, Org passes their value to \\label unchanged.
+You are responsible for ensuring that the value is a valid LaTeX
+\\label key, and that no other \\label commands with the same key
+appear elsewhere in your document.  (Keys may contain letters,
+numbers, and the following punctuation: '_' '.'  '-' ':'.)  There
+are no such limitations on CUSTOM_ID and NAME when this variable
+is nil.
+
+For headlines that do not define the CUSTOM_ID property or
+elements without a NAME, Org will continue to use its default
+labeling scheme to generate labels and resolve links into proper
+references."
+  :group 'org-export-latex
+  :type 'boolean
+  :version "26.1"
+  :package-version '(Org . "8.3"))
 
 ;;;; Preamble
 
@@ -264,11 +482,15 @@ AUTO will automatically be replaced with a coding system derived
 from `buffer-file-coding-system'.  See also the variable
 `org-latex-inputenc-alist' for a way to influence this mechanism.
 
-Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
-AUTO will be replaced with the language related to the language
-code specified by `org-export-default-language', which see.  Note
-that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
-are permitted.
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\"
+or \"\\usepackage[AUTO]{polyglossia}\", AUTO will be replaced
+with the language related to the language code specified by
+`org-export-default-language'.  Note that constructions such as
+\"\\usepackage[french,AUTO,english]{babel}\" are permitted.  For
+Polyglossia the language will be set via the macros
+\"\\setmainlanguage\" and \"\\setotherlanguage\".  See also
+`org-latex-guess-babel-language' and
+`org-latex-guess-polyglossia-language'.
 
 The sectioning structure
 ------------------------
@@ -328,11 +550,42 @@ are written as utf8 files."
 
 (defcustom org-latex-title-command "\\maketitle"
   "The command used to insert the title just after \\begin{document}.
-If this string contains the formatting specification \"%s\" then
-it will be used as a formatting string, passing the title as an
-argument."
+
+This format string may contain these elements:
+
+  %a for AUTHOR keyword
+  %t for TITLE keyword
+  %s for SUBTITLE keyword
+  %k for KEYWORDS line
+  %d for DESCRIPTION line
+  %c for CREATOR line
+  %l for Language keyword
+  %L for capitalized language keyword
+  %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+Setting :latex-title-command in publishing projects will take
+precedence over this variable."
   :group 'org-export-latex
-  :type 'string)
+  :type '(string :tag "Format string"))
+
+(defcustom org-latex-subtitle-format "\\\\\\medskip\n\\large %s"
+  "Format string used for transcoded subtitle.
+The format string should have at most one \"%s\"-expression,
+which is replaced with the subtitle."
+  :group 'org-export-latex
+  :version "26.1"
+  :package-version '(Org . "8.3")
+  :type '(string :tag "Format string"))
+
+(defcustom org-latex-subtitle-separate nil
+  "Non-nil means the subtitle is not typeset as part of title."
+  :group 'org-export-latex
+  :version "26.1"
+  :package-version '(Org . "8.3")
+  :type 'boolean)
 
 (defcustom org-latex-toc-command "\\tableofcontents\n\n"
   "LaTeX command to set the table of contents, list of figures, etc.
@@ -341,10 +594,36 @@ the toc:nil option, not to those generated with #+TOC keyword."
   :group 'org-export-latex
   :type 'string)
 
-(defcustom org-latex-with-hyperref t
-  "Toggle insertion of \\hypersetup{...} in the preamble."
+(defcustom org-latex-hyperref-template
+  "\\hypersetup{\n pdfauthor={%a},\n pdftitle={%t},\n pdfkeywords={%k},
+ pdfsubject={%d},\n pdfcreator={%c}, \n pdflang={%L}}\n"
+  "Template for hyperref package options.
+
+This format string may contain these elements:
+
+  %a for AUTHOR keyword
+  %t for TITLE keyword
+  %s for SUBTITLE keyword
+  %k for KEYWORDS line
+  %d for DESCRIPTION line
+  %c for CREATOR line
+  %l for Language keyword
+  %L for capitalized language keyword
+  %D for DATE keyword
+
+If you need to use a \"%\" character, you need to escape it
+like that: \"%%\".
+
+As a special case, a nil value prevents template from being
+inserted.
+
+Setting :latex-hyperref-template in publishing projects will take
+precedence over this variable."
   :group 'org-export-latex
-  :type 'boolean)
+  :version "26.1"
+  :package-version '(Org . "8.3")
+  :type '(choice (const :tag "No template" nil)
+		 (string :tag "Format string")))
 
 ;;;; Headline
 
@@ -352,17 +631,15 @@ the toc:nil option, not to those generated with #+TOC keyword."
   'org-latex-format-headline-default-function
   "Function for formatting the headline's text.
 
-This function will be called with 5 arguments:
-TODO      the todo keyword (string or nil).
+This function will be called with six arguments:
+TODO      the todo keyword (string or nil)
 TODO-TYPE the type of todo (symbol: `todo', `done', nil)
 PRIORITY  the priority of the headline (integer or nil)
-TEXT      the main headline text (string).
-TAGS      the tags as a list of strings (list of strings or nil).
-
-The function result will be used in the section format string.
+TEXT      the main headline text (string)
+TAGS      the tags (list of strings or nil)
+INFO      the export options (plist)
 
-Use `org-latex-format-headline-default-function' by default,
-which format headlines like for Org version prior to 8.0."
+The function result will be used in the section format string."
   :group 'org-export-latex
   :version "24.4"
   :package-version '(Org . "8.0")
@@ -376,6 +653,16 @@ which format headlines like for Org version prior to 8.0."
   :group 'org-export-latex
   :type 'string)
 
+(defcustom org-latex-footnote-defined-format "\\textsuperscript{\\ref{%s}}"
+  "Format string used to format reference to footnote already defined.
+%s will be replaced by the label of the referred footnote."
+  :group 'org-export-latex
+  :type '(choice
+	  (const :tag "Use plain superscript (default)" "\\textsuperscript{\\ref{%s}}")
+	  (const :tag "Use Memoir/KOMA-Script footref" "\\footref{%s}")
+	  (string :tag "Other format string"))
+  :version "26.1"
+  :package-version '(Org . "9.0"))
 
 ;;;; Timestamps
 
@@ -397,6 +684,14 @@ which format headlines like for Org version prior to 8.0."
 
 ;;;; Links
 
+(defcustom org-latex-images-centered t
+  "When non-nil, images are centered."
+  :group 'org-export-latex
+  :version "26.1"
+  :package-version '(Org . "9.0")
+  :type 'boolean
+  :safe #'booleanp)
+
 (defcustom org-latex-image-default-option ""
   "Default option for images."
   :group 'org-export-latex
@@ -422,10 +717,13 @@ environment."
   :package-version '(Org . "8.0")
   :type 'string)
 
-(defcustom org-latex-default-figure-position "htb"
-  "Default position for latex figures."
+(defcustom org-latex-default-figure-position "htbp"
+  "Default position for LaTeX figures."
   :group 'org-export-latex
-  :type 'string)
+  :type 'string
+  :version "26.1"
+  :package-version '(Org . "9.0")
+  :safe #'stringp)
 
 (defcustom org-latex-inline-image-rules
   '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
@@ -489,12 +787,14 @@ When modifying this variable, it may be useful to change
   :type '(choice (const :tag "Table" table)
 		 (const :tag "Matrix" math)
 		 (const :tag "Inline matrix" inline-math)
-		 (const :tag "Verbatim" verbatim)))
+		 (const :tag "Verbatim" verbatim))
+  :safe (lambda (s) (memq s '(table math inline-math verbatim))))
 
 (defcustom org-latex-tables-centered t
   "When non-nil, tables are exported in a center environment."
   :group 'org-export-latex
-  :type 'boolean)
+  :type 'boolean
+  :safe #'booleanp)
 
 (defcustom org-latex-tables-booktabs nil
   "When non-nil, display tables in a formal \"booktabs\" style.
@@ -505,13 +805,8 @@ attributes."
   :group 'org-export-latex
   :version "24.4"
   :package-version '(Org . "8.0")
-  :type 'boolean)
-
-(defcustom org-latex-table-caption-above t
-  "When non-nil, place caption string at the beginning of the table.
-Otherwise, place it near the end."
-  :group 'org-export-latex
-  :type 'boolean)
+  :type 'boolean
+  :safe #'booleanp)
 
 (defcustom org-latex-table-scientific-notation "%s\\,(%s)"
   "Format string to display numbers in scientific notation.
@@ -526,11 +821,10 @@ When nil, no transformation is made."
 	  (string :tag "Format string")
 	  (const :tag "No formatting" nil)))
 
-
 ;;;; Text markup
 
 (defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}")
-					 (code . verb)
+					 (code . protectedtexttt)
 					 (italic . "\\emph{%s}")
 					 (strike-through . "\\sout{%s}")
 					 (underline . "\\uline{%s}")
@@ -550,14 +844,15 @@ to typeset and try to protect special characters.
 If no association can be found for a given markup, text will be
 returned as-is."
   :group 'org-export-latex
+  :version "26.1"
+  :package-version '(Org . "8.3")
   :type 'alist
   :options '(bold code italic strike-through underline verbatim))
 
 
 ;;;; Drawers
 
-(defcustom org-latex-format-drawer-function
-  (lambda (name contents) contents)
+(defcustom org-latex-format-drawer-function (lambda (_ contents) contents)
   "Function called to format a drawer in LaTeX code.
 
 The function must accept two parameters:
@@ -575,44 +870,24 @@ The default function simply returns the value of CONTENTS."
 
 ;;;; Inlinetasks
 
-(defcustom org-latex-format-inlinetask-function 'ignore
+(defcustom org-latex-format-inlinetask-function
+  'org-latex-format-inlinetask-default-function
   "Function called to format an inlinetask in LaTeX code.
 
-The function must accept six parameters:
-  TODO      the todo keyword, as a string
-  TODO-TYPE the todo type, a symbol among `todo', `done' and nil.
-  PRIORITY  the inlinetask priority, as a string
-  NAME      the inlinetask name, as a string.
-  TAGS      the inlinetask tags, as a list of strings.
-  CONTENTS  the contents of the inlinetask, as a string.
-
-The function should return the string to be exported.
+The function must accept seven parameters:
+  TODO      the todo keyword (string or nil)
+  TODO-TYPE the todo type (symbol: `todo', `done', nil)
+  PRIORITY  the inlinetask priority (integer or nil)
+  NAME      the inlinetask name (string)
+  TAGS      the inlinetask tags (list of strings or nil)
+  CONTENTS  the contents of the inlinetask (string or nil)
+  INFO      the export options (plist)
 
-For example, the variable could be set to the following function
-in order to mimic default behavior:
-
-\(defun org-latex-format-inlinetask (todo type priority name tags contents)
-\"Format an inline task element for LaTeX export.\"
-  (let ((full-title
-	 (concat
-	  (when todo
-            (format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo))
-	  (when priority (format \"\\\\framebox{\\\\#%c} \" priority))
-	  title
-	  (when tags
-            (format \"\\\\hfill{}\\\\textsc{:%s:}\"
-                    (mapconcat \\='identity tags \":\")))))
-    (format (concat \"\\\\begin{center}\\n\"
-		    \"\\\\fbox{\\n\"
-		    \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\"
-		    \"%s\\n\\n\"
-		    \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\"
-		    \"%s\"
-		    \"\\\\end{minipage}}\"
-		    \"\\\\end{center}\")
-	    full-title contents))"
+The function should return the string to be exported."
   :group 'org-export-latex
-  :type 'function)
+  :type 'function
+  :version "26.1"
+  :package-version '(Org . "8.3"))
 
 
 ;; Src blocks
@@ -640,7 +915,7 @@ the minted package to `org-latex-packages-alist', for example
 using customize, or with
 
   (require \\='ox-latex)
-  (add-to-list \\='org-latex-packages-alist \\='(\"\" \"minted\"))
+  (add-to-list \\='org-latex-packages-alist \\='(\"newfloat\" \"minted\"))
 
 In addition, it is necessary to install pygments
 \(http://pygments.org), and to configure the variable
@@ -656,7 +931,8 @@ into previewing problems, please consult
   :type '(choice
 	  (const :tag "Use listings" t)
 	  (const :tag "Use minted" minted)
-	  (const :tag "Export verbatim" nil)))
+	  (const :tag "Export verbatim" nil))
+  :safe (lambda (s) (memq s '(t nil minted))))
 
 (defcustom org-latex-listings-langs
   '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp")
@@ -668,7 +944,9 @@ into previewing problems, please consult
     (shell-script "bash")
     (gnuplot "Gnuplot")
     (ocaml "Caml") (caml "Caml")
-    (sql "SQL") (sqlite "sql"))
+    (sql "SQL") (sqlite "sql")
+    (makefile "make")
+    (R "r"))
   "Alist mapping languages to their listing language counterpart.
 The key is a symbol, the major mode symbol without the \"-mode\".
 The value is the string that should be inserted as the language
@@ -676,6 +954,8 @@ parameter for the listings package.  If the mode name and the
 listings name are the same, the language does not need an entry
 in this list - but it does not hurt if it is present."
   :group 'org-export-latex
+  :version "24.4"
+  :package-version '(Org . "8.3")
   :type '(repeat
 	  (list
 	   (symbol :tag "Major mode       ")
@@ -697,7 +977,13 @@ will typeset the code in a small size font with underlined, bold
 black keywords.
 
 Note that the same options will be applied to blocks of all
-languages."
+languages.  If you need block-specific options, you may use the
+following syntax:
+
+  #+ATTR_LATEX: :options key1=value1,key2=value2
+  #+BEGIN_SRC 
+  ...
+  #+END_SRC"
   :group 'org-export-latex
   :type '(repeat
 	  (list
@@ -744,41 +1030,132 @@ will result in src blocks being exported with
 \\begin{minted}[bgcolor=bg,frame=lines]{}
 
 as the start of the minted environment. Note that the same
-options will be applied to blocks of all languages."
+options will be applied to blocks of all languages.  If you need
+block-specific options, you may use the following syntax:
+
+  #+ATTR_LATEX: :options key1=value1,key2=value2
+  #+BEGIN_SRC 
+  ...
+  #+END_SRC"
   :group 'org-export-latex
   :type '(repeat
 	  (list
 	   (string :tag "Minted option name ")
 	   (string :tag "Minted option value"))))
 
-(defvar org-latex-custom-lang-environments nil
+(defcustom org-latex-custom-lang-environments nil
   "Alist mapping languages to language-specific LaTeX environments.
 
 It is used during export of src blocks by the listings and minted
-latex packages.  For example,
+latex packages.  The environment may be a simple string, composed of
+only letters and numbers.  In this case, the string is directly the
+name of the latex environment to use.  The environment may also be
+a format string.  In this case the format string will be directly
+exported.  This format string may contain these elements:
+
+  %s for the formatted source
+  %c for the caption
+  %f for the float attribute
+  %l for an appropriate label
+  %o for the LaTeX attributes
+
+For example,
 
   (setq org-latex-custom-lang-environments
-     \\='((python \"pythoncode\")))
+     \\='((python \"pythoncode\")
+       (ocaml \"\\\\begin{listing}
+\\\\begin{minted}[%o]{ocaml}
+%s\\\\end{minted}
+\\\\caption{%c}
+\\\\label{%l}\")))
 
-would have the effect that if org encounters begin_src python
-during latex export it will output
+would have the effect that if Org encounters a Python source block
+during LaTeX export it will produce
 
   \\begin{pythoncode}
   
-  \\end{pythoncode}")
+  \\end{pythoncode}
+
+and if Org encounters an Ocaml source block during LaTeX export it
+will produce
+
+  \\begin{listing}
+  \\begin{minted}[]{ocaml}
+  
+  \\end{minted}
+  \\caption{}
+  \\label{